PostScript-Simple-0.09/0002750000175000017500000000000012410400237013105 5ustar mcnmcnPostScript-Simple-0.09/META.yml0000660000175000017500000000100512410400237014353 0ustar mcnmcn--- abstract: 'Produce PostScript files from Perl' author: - 'Matthew Newton ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PostScript-Simple no_index: directory: - t - inc requires: Test::More: '0.18' version: '0.09' PostScript-Simple-0.09/t/0002750000175000017500000000000012410400237013350 5ustar mcnmcnPostScript-Simple-0.09/t/01base.t0000755000175000017500000000111112410400011014576 0ustar mcnmcn#!/usr/bin/perl -w use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 10; #use Data::Dumper; use PostScript::Simple; ok( $PostScript::Simple::VERSION ); # module loads my $p = new PostScript::Simple(papersize => "A4", colour => 1,); ok( $p ); # object creation ok( $p->{xsize} == 595.27559 ); ok( $p->{ysize} == 841.88976 ); ok( $p->{colour} == 1 ); ok( $p->{eps} == 1 ); ok( $p->{page} == 1 ); ok( $p->{landscape} == 0 ); ok( $p->{units} eq 'bp' ); ok( $p->{papersize} eq 'A4' ); # basic test for default values #print Dumper $p; PostScript-Simple-0.09/t/02text.t0000755000175000017500000000377312410400011014671 0ustar mcnmcn#!/usr/bin/perl use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 2; #use Data::Dumper; use PostScript::Simple; my $s = new PostScript::Simple(xsize => 200, ysize => 250, eps => 1); $s->text( 10, 10, 'Hello World' ); $s->text( {align => "right"}, 10, 10, 'Hello World' ); $s->text( 10, 20, '' ); $s->text( 10, 30, "\000" ); $s->text( 10, 40, undef ); $s->text( 10, 50, 'ONE TWO THREE~~~~' ); $s->text( {align => "center", rotate => 49}, 40, 80, 'ONE TWO THREE~~~~' ); $s->text( 10, 60, join('', map { chr $_ } (0 .. 19)) ); $s->text( 10, 70, join('', map { chr $_ } (20 .. 39)) ); $s->text( 10, 80, join('', map { chr $_ } (120 .. 139)) ); $s->text( 10, 90, join('', map { chr $_ } (140 .. 159)) ); $s->text( 10, 100, '((()))()()()}{}{}][[]]})()})(]' ); my $pages = $s->_buildpage($s->{pspages}[0]); ok( length($pages) eq length(CANNED()) ); ok( $pages eq CANNED() ); #print STDERR "\n>>>$pages<<<\n"; #print Dumper $s; #$s->output('text.eps'); sub CANNED { return 'newpath 10 ubp 10 ubp moveto (Hello World) show stroke newpath 10 ubp 10 ubp moveto (Hello World) dup stringwidth pop neg 0 rmoveto show newpath 10 ubp 20 ubp moveto () show stroke newpath 10 ubp 30 ubp moveto (\000) show stroke (error: text: wrong number of arguments ) print flush newpath 10 ubp 50 ubp moveto (ONE TWO THREE~~~~) show stroke newpath 40 ubp 80 ubp moveto (ONE TWO THREE~~~~) 49 rotate dup stringwidth pop 2 div neg 0 rmoveto show -49 rotate newpath 10 ubp 60 ubp moveto (\000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023) show stroke newpath 10 ubp 70 ubp moveto (\024\025\026\027\030\031\032\033\034\035\036\037 !"#$%&\') show stroke newpath 10 ubp 80 ubp moveto (xyz{|}~\177\200\201\202\203\204\205\206\207\210\211\212\213) show stroke newpath 10 ubp 90 ubp moveto (\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237) show stroke newpath 10 ubp 100 ubp moveto (\(\(\(\)\)\)\(\)\(\)\(\)}{}{}][[]]}\)\(\)}\)\(]) show stroke '; } PostScript-Simple-0.09/t/11file.t0000755000175000017500000002770312410400011014623 0ustar mcnmcn#!/usr/bin/perl -w use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 11; #use Data::Dumper; use PostScript::Simple; my $f = "xtest-b.ps"; my $t = new PostScript::Simple(landscape => 0, eps => 0, papersize => "a4", colour => 1, clip => 0, units => "mm"); ok( $t ); $t->newpage(-1); $t->line(10,10, 10,50); $t->setlinewidth(8); $t->line(90,10, 90,50); $t->linextend(40,90); $t->setcolour("brightred"); $t->circle({filled=>1}, 40, 90, 30); $t->setcolour("darkgreen"); $t->setlinewidth(0.1); for (my $i = 0; $i < 360; $i += 20) { $t->polygon({offset=>[0,0], rotate=>[$i,70,90], filled=>0}, 40,90, 69,92, 75,84); } $t->setlinewidth("thin"); $t->setcolour("darkgreen"); $t->box(20, 10, 80, 20); $t->setcolour("grey30"); $t->box({filled=>1}, 20, 30, 80, 40); $t->setcolour("grey10"); $t->setfont("Bookman", 12); $t->text(5,5, "Matthew"); $t->newpage; $t->line((10, 20), (30, 40)); $t->linextend(60, 50); $t->line(10,12, 20,12); $t->polygon(10,10, 20,10); $t->setcolour("grey90"); $t->polygon({offset=>[5,5], filled=>1}, 10,10, 15,20, 25,20, 30,10, 15,15, 10,10, 0); $t->setcolour("black"); $t->polygon({offset=>[10,10], rotate=>[45,20,20]}, 10,10, 15,20, 25,20, 30,10, 15,15, 10,10, 1); $t->line((0, 100), (100, 0), (255, 0, 0)); $t->newpage(30); for (my $i = 12; $i < 80; $i += 2) { $t->setcolour($i*3, 0, 0); $t->box({filled=>1}, $i - 2, 10, $i, 40); } $t->line((40, 30), (30, 10)); $t->linextend(60, 0); $t->line((0, 100), (100, 0),(0, 255, 0)); $t->output( $f ); #$t->output( "x" ); ok( -e $f ); open( FILE, $f ) or die("Can't open $f: $!"); $/ = undef; my $lines = ; close FILE; ok( $lines =~ m/%%LanguageLevel: 1/s ); ok( $lines =~ m/%%DocumentMedia: A4 595.27559 841.88976 0 \( \) \( \)/s ); ok( $lines =~ m/%%Orientation: Portrait/s ); ok( $lines =~ m/%%Pages: 3/s ); ok( index($lines, "%!PS-Adobe-3.0\n") == 0 ); my ( $prolog ) = ( $lines =~ m/%%BeginResource: PostScript::Simple-REENCODEFONT\n(.*)%%EndResource/s ); #print STDERR "\n>>>$prolog<<<\n"; ok( $prolog ); ok( $prolog eq PROLOG()); my ( $body ) = ( $lines =~ m/%%EndProlog\n(.*)%%EOF/s ); ok( $body ); ok( $body eq BODY()); #print STDERR "\n>>>$body<<<\n"; ### Subs sub PROLOG { return q[/STARTDIFFENC { mark } bind def /ENDDIFFENC { % /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC - counttomark 2 add -1 roll 256 array copy /TempEncode exch def % pointer for sequential encodings /EncodePointer 0 def { % Get the bottom object counttomark -1 roll % Is it a mark? dup type dup /marktype eq { % End of encoding pop pop exit } { /nametype eq { % Insert the name at EncodePointer % and increment the pointer. TempEncode EncodePointer 3 -1 roll put /EncodePointer EncodePointer 1 add def } { % Set the EncodePointer to the number /EncodePointer exch def } ifelse } ifelse } loop TempEncode def } bind def % Define ISO Latin1 encoding if it doesnt exist /ISOLatin1Encoding where { % (ISOLatin1 exists!) = pop } { (ISOLatin1 does not exist, creating...) = /ISOLatin1Encoding StandardEncoding STARTDIFFENC 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ENDDIFFENC } ifelse % Name: Re-encode Font % Description: Creates a new font using the named encoding. /REENCODEFONT { % /Newfont NewEncoding /Oldfont findfont dup length 4 add dict begin { % forall 1 index /FID ne 2 index /UniqueID ne and 2 index /XUID ne and { def } { pop pop } ifelse } forall /Encoding exch def % defs for DPS /BitmapWidths false def /ExactSize 0 def /InBetweenSize 0 def /TransformedChar 0 def currentdict end definefont pop } bind def % Reencode the std fonts: /Courier-iso ISOLatin1Encoding /Courier REENCODEFONT /Courier-Bold-iso ISOLatin1Encoding /Courier-Bold REENCODEFONT /Courier-BoldOblique-iso ISOLatin1Encoding /Courier-BoldOblique REENCODEFONT /Courier-Oblique-iso ISOLatin1Encoding /Courier-Oblique REENCODEFONT /Helvetica-iso ISOLatin1Encoding /Helvetica REENCODEFONT /Helvetica-Bold-iso ISOLatin1Encoding /Helvetica-Bold REENCODEFONT /Helvetica-BoldOblique-iso ISOLatin1Encoding /Helvetica-BoldOblique REENCODEFONT /Helvetica-Oblique-iso ISOLatin1Encoding /Helvetica-Oblique REENCODEFONT /Times-Roman-iso ISOLatin1Encoding /Times-Roman REENCODEFONT /Times-Bold-iso ISOLatin1Encoding /Times-Bold REENCODEFONT /Times-BoldItalic-iso ISOLatin1Encoding /Times-BoldItalic REENCODEFONT /Times-Italic-iso ISOLatin1Encoding /Times-Italic REENCODEFONT /Symbol-iso ISOLatin1Encoding /Symbol REENCODEFONT %%EndResource %%BeginResource: PostScript::Simple-box /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def %%EndResource %%BeginResource: PostScript::Simple-circle /circle {newpath 0 360 arc closepath} bind def %%EndResource %%BeginResource: PostScript::Simple-rotabout /rotabout { 3 copy pop translate rotate exch 0 exch sub exch 0 exch sub translate } def ]; } sub BODY { return q[%%BeginSetup /ubp {} def /umm {72 mul 25.4 div} def ll 2 ge { << /PageSize [ 595.27559 841.88976 ] /ImagingBBox null >> setpagedevice } if %%EndSetup %%Page: -1 1 %%BeginPageSetup /pagelevel save def %%EndPageSetup newpath 10 umm 10 umm moveto 10 umm 50 umm lineto stroke 8 umm setlinewidth newpath 90 umm 10 umm moveto 90 umm 50 umm lineto 40 umm 90 umm lineto stroke 1 0 0 setrgbcolor 40 umm 90 umm 30 umm circle fill 0 0.49804 0 setrgbcolor 0.1 umm setlinewidth newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke gsave 70 umm 90 umm 20 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 40 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 60 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 80 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 100 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 120 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 140 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 160 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 180 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 200 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 220 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 240 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 260 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 280 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 300 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 320 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore gsave 70 umm 90 umm 340 rotabout newpath 40 umm 90 umm moveto 69 umm 92 umm lineto 75 umm 84 umm lineto stroke grestore 0.4 ubp setlinewidth 0 0.49804 0 setrgbcolor 20 umm 10 umm 80 umm 20 umm box stroke 0.29804 0.29804 0.29804 setrgbcolor 20 umm 30 umm 80 umm 40 umm box fill 0.09804 0.09804 0.09804 setrgbcolor /Bookman findfont 12 scalefont setfont newpath 5 umm 5 umm moveto (Matthew) show stroke %%PageTrailer pagelevel restore showpage %%Page: -2 2 %%BeginPageSetup /pagelevel save def %%EndPageSetup newpath 10 umm 20 umm moveto 30 umm 40 umm lineto 60 umm 50 umm lineto stroke newpath 10 umm 12 umm moveto 20 umm 12 umm lineto stroke newpath 10 umm 10 umm moveto 20 umm 10 umm lineto stroke 0.89804 0.89804 0.89804 setrgbcolor gsave 5 umm 5 umm translate newpath 10 umm 10 umm moveto 15 umm 20 umm lineto 25 umm 20 umm lineto 30 umm 10 umm lineto 15 umm 15 umm lineto 10 umm 10 umm lineto fill grestore 0 0 0 setrgbcolor gsave 10 umm 10 umm translate 20 umm 20 umm 45 rotabout newpath 10 umm 10 umm moveto 15 umm 20 umm lineto 25 umm 20 umm lineto 30 umm 10 umm lineto 15 umm 15 umm lineto 10 umm 10 umm lineto stroke grestore 1 0 0 setrgbcolor newpath 0 umm 100 umm moveto 100 umm 0 umm lineto stroke %%PageTrailer pagelevel restore showpage %%Page: 30 3 %%BeginPageSetup /pagelevel save def %%EndPageSetup 0.14118 0 0 setrgbcolor 10 umm 10 umm 12 umm 40 umm box fill 0.16471 0 0 setrgbcolor 12 umm 10 umm 14 umm 40 umm box fill 0.18824 0 0 setrgbcolor 14 umm 10 umm 16 umm 40 umm box fill 0.21176 0 0 setrgbcolor 16 umm 10 umm 18 umm 40 umm box fill 0.23529 0 0 setrgbcolor 18 umm 10 umm 20 umm 40 umm box fill 0.25882 0 0 setrgbcolor 20 umm 10 umm 22 umm 40 umm box fill 0.28235 0 0 setrgbcolor 22 umm 10 umm 24 umm 40 umm box fill 0.30588 0 0 setrgbcolor 24 umm 10 umm 26 umm 40 umm box fill 0.32941 0 0 setrgbcolor 26 umm 10 umm 28 umm 40 umm box fill 0.35294 0 0 setrgbcolor 28 umm 10 umm 30 umm 40 umm box fill 0.37647 0 0 setrgbcolor 30 umm 10 umm 32 umm 40 umm box fill 0.4 0 0 setrgbcolor 32 umm 10 umm 34 umm 40 umm box fill 0.42353 0 0 setrgbcolor 34 umm 10 umm 36 umm 40 umm box fill 0.44706 0 0 setrgbcolor 36 umm 10 umm 38 umm 40 umm box fill 0.47059 0 0 setrgbcolor 38 umm 10 umm 40 umm 40 umm box fill 0.49412 0 0 setrgbcolor 40 umm 10 umm 42 umm 40 umm box fill 0.51765 0 0 setrgbcolor 42 umm 10 umm 44 umm 40 umm box fill 0.54118 0 0 setrgbcolor 44 umm 10 umm 46 umm 40 umm box fill 0.56471 0 0 setrgbcolor 46 umm 10 umm 48 umm 40 umm box fill 0.58824 0 0 setrgbcolor 48 umm 10 umm 50 umm 40 umm box fill 0.61176 0 0 setrgbcolor 50 umm 10 umm 52 umm 40 umm box fill 0.63529 0 0 setrgbcolor 52 umm 10 umm 54 umm 40 umm box fill 0.65882 0 0 setrgbcolor 54 umm 10 umm 56 umm 40 umm box fill 0.68235 0 0 setrgbcolor 56 umm 10 umm 58 umm 40 umm box fill 0.70588 0 0 setrgbcolor 58 umm 10 umm 60 umm 40 umm box fill 0.72941 0 0 setrgbcolor 60 umm 10 umm 62 umm 40 umm box fill 0.75294 0 0 setrgbcolor 62 umm 10 umm 64 umm 40 umm box fill 0.77647 0 0 setrgbcolor 64 umm 10 umm 66 umm 40 umm box fill 0.8 0 0 setrgbcolor 66 umm 10 umm 68 umm 40 umm box fill 0.82353 0 0 setrgbcolor 68 umm 10 umm 70 umm 40 umm box fill 0.84706 0 0 setrgbcolor 70 umm 10 umm 72 umm 40 umm box fill 0.87059 0 0 setrgbcolor 72 umm 10 umm 74 umm 40 umm box fill 0.89412 0 0 setrgbcolor 74 umm 10 umm 76 umm 40 umm box fill 0.91765 0 0 setrgbcolor 76 umm 10 umm 78 umm 40 umm box fill newpath 40 umm 30 umm moveto 30 umm 10 umm lineto 60 umm 0 umm lineto stroke 0 1 0 setrgbcolor newpath 0 umm 100 umm moveto 100 umm 0 umm lineto stroke %%PageTrailer pagelevel restore showpage ]; } PostScript-Simple-0.09/t/10file.t0000755000175000017500000000140112410400011014605 0ustar mcnmcn#!/usr/bin/perl -w use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 6; #use Data::Dumper; use PostScript::Simple; my $f = 'xtest-a.ps'; my $s = new PostScript::Simple(xsize => 50, ysize => 200); $s->box(10, 10, 40, 190); $s->output( $f ); #print STDERR Dumper $s; # check object ok( $s->{psresources}{REENCODEFONT} =~ m|/START| ); ok( index( $s->_buildpage($s->{pspages}[0]), q[10 ubp 10 ubp 40 ubp 190 ubp box stroke]) > -1 ); # check output ok( -e $f ); open( CHK, $f ) or die("Can't open the file $f: $!"); $/ = undef; my $file = ; close CHK; ok( index( $file, '%!PS-Adobe-3.0 EPSF-1.2' ) == 0 ); ok( index( $file, '%%EOF' ) == (length( $file ) - 6) ); ok( index( $file, '10 ubp 10 ubp 40 ubp 190 ubp box stroke' ) > 0 ); PostScript-Simple-0.09/t/03funcs.t0000755000175000017500000002107412410400011015016 0ustar mcnmcn#!/usr/bin/perl use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 51; #use Data::Dumper; use PostScript::Simple; # huge workout of all methods, OK and error conditions my $s = new PostScript::Simple(xsize => 350, ysize => 350, eps => 1, colour => 1); ok( $s ); ok( ! $s->newpage ); eval { $s->output; }; ok( $@ ); ok( $s->setcolour('black') ); ok( $s->setcolour('BLACK') ); ok( ! $s->setcolour('Geddy lee') ); ok( ! $s->setcolour(120, 240) ); ok( $s->setcolour(120, 240, 0) ); ok( $s->setcmykcolour(0.2, 0.4, 0.6, 0.8) ); ok( ! $s->setcmykcolour(0.2, 0.4, 0.6) ); ok( ! $s->setcmykcolour("black") ); ok( $s->setlinewidth(1) ); ok( ! $s->setlinewidth ); ok( $s->line(10,10, 10,20) ); ok( ! $s->line(10,10, 10,20, 50, 50) ); ok( ! $s->line(10,10, 10) ); ok( $s->line(10,10, 10,20, 50, 50, 50) ); ok( $s->line(10,-10, -10,20, 0, 127, 255) ); ok( $s->linextend(100,100) ); ok( ! $s->linextend(100) ); ok( $s->polygon(10,10, 10,20, 110,10, 110,20) ); #ok( $s->polygon(10,10, 10,20, 110,10, 110,20, 1) ); ok( $s->polygon({rotate=>45,filled=>1}, 10,10, 10,20, 110,10, 110,20) ); ok( $s->polygon({rotate=>[45,20,20]}, 10,10, 10,20, 110,10, 110,20) ); ok( $s->polygon({offset=>[10,10]}, 10,10, 10,20, 110,10, 110,20) ); ok( ! $s->polygon(10,10, 10) ); ok( $s->circle( 120, 120, 30 ) ); ok( $s->circle( {filled=>1}, 120, 120, 30 ) ); ok( ! $s->circle( 120 ) ); ok( ! $s->circle ); ok( $s->box(210,210, 220,230) ); ok( $s->box( {filled=>1}, 215,215, 225,235) ); ok( ! $s->box(210,210, 220) ); ok( $s->setfont('Helvetica', 12) ); ok( ! $s->setfont('Helvetica') ); ok( $s->text( 10, 10, 'Hello World' ) ); ok( $s->text( {align=>"left"}, 10, 10, 'Hello World' ) ); ok( $s->text( {rotate=>56}, 10, 10, 'Hello World' ) ); ok( ! $s->text( 10, 10, 'Hello World', 'foo', 'wobble' ) ); ok( ! $s->text( 10, 10 ) ); ok( ! $s->curve(10,310, 10,320, 110,310, 110) ); ok( $s->curve(10,310, 10,320, 110,310, 110,320) ); ok( $s->curvextend(110,330, 210,330, 210,320) ); ok( ! $s->curvextend(110,330, 210,330, 210) ); my $pages = $s->_buildpage($s->{pspages}[0]); #print STDERR "\n>>>" . $pages . "<<<\n"; ok( length($pages) eq length(CANNED()) ); ok( $pages eq CANNED() ); #print STDERR "\n>>>" . $s->{'psfunctions'} . "<<<\n"; ok( length($s->{psresources}{REENCODEFONT}) eq length(REENCODEFONT()) ); ok( $s->{psresources}{REENCODEFONT} eq REENCODEFONT() ); ok( length($s->{psresources}{box}) eq length(RESBOX()) ); ok( $s->{psresources}{box} eq RESBOX() ); ok( scalar keys %{$s->{psresources}} == 4 ); ok( $s->output('x03.eps') ); unlink 'x03.eps'; #print Dumper $s; ### sub REENCODEFONT { return '/STARTDIFFENC { mark } bind def /ENDDIFFENC { % /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC - counttomark 2 add -1 roll 256 array copy /TempEncode exch def % pointer for sequential encodings /EncodePointer 0 def { % Get the bottom object counttomark -1 roll % Is it a mark? dup type dup /marktype eq { % End of encoding pop pop exit } { /nametype eq { % Insert the name at EncodePointer % and increment the pointer. TempEncode EncodePointer 3 -1 roll put /EncodePointer EncodePointer 1 add def } { % Set the EncodePointer to the number /EncodePointer exch def } ifelse } ifelse } loop TempEncode def } bind def % Define ISO Latin1 encoding if it doesnt exist /ISOLatin1Encoding where { % (ISOLatin1 exists!) = pop } { (ISOLatin1 does not exist, creating...) = /ISOLatin1Encoding StandardEncoding STARTDIFFENC 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ENDDIFFENC } ifelse % Name: Re-encode Font % Description: Creates a new font using the named encoding. /REENCODEFONT { % /Newfont NewEncoding /Oldfont findfont dup length 4 add dict begin { % forall 1 index /FID ne 2 index /UniqueID ne and 2 index /XUID ne and { def } { pop pop } ifelse } forall /Encoding exch def % defs for DPS /BitmapWidths false def /ExactSize 0 def /InBetweenSize 0 def /TransformedChar 0 def currentdict end definefont pop } bind def % Reencode the std fonts: /Courier-iso ISOLatin1Encoding /Courier REENCODEFONT /Courier-Bold-iso ISOLatin1Encoding /Courier-Bold REENCODEFONT /Courier-BoldOblique-iso ISOLatin1Encoding /Courier-BoldOblique REENCODEFONT /Courier-Oblique-iso ISOLatin1Encoding /Courier-Oblique REENCODEFONT /Helvetica-iso ISOLatin1Encoding /Helvetica REENCODEFONT /Helvetica-Bold-iso ISOLatin1Encoding /Helvetica-Bold REENCODEFONT /Helvetica-BoldOblique-iso ISOLatin1Encoding /Helvetica-BoldOblique REENCODEFONT /Helvetica-Oblique-iso ISOLatin1Encoding /Helvetica-Oblique REENCODEFONT /Times-Roman-iso ISOLatin1Encoding /Times-Roman REENCODEFONT /Times-Bold-iso ISOLatin1Encoding /Times-Bold REENCODEFONT /Times-BoldItalic-iso ISOLatin1Encoding /Times-BoldItalic REENCODEFONT /Times-Italic-iso ISOLatin1Encoding /Times-Italic REENCODEFONT /Symbol-iso ISOLatin1Encoding /Symbol REENCODEFONT '; } sub RESBOX { return '/box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def '; } sub CANNED { return '(error: Do not use newpage for eps files! ) print flush 0 0 0 setrgbcolor 0 0 0 setrgbcolor (error: bad colour name \'geddy lee\' ) print flush (error: setcolour given invalid arguments: 120, 240, undef ) print flush 0.47059 0.94118 0 setrgbcolor 0.2 0.4 0.6 0.8 setcmykcolor (error: setcmykcolour given incorrect number of arguments ) print flush (error: setcmykcolour given incorrect number of arguments ) print flush 1 ubp setlinewidth (error: setlinewidth not given a width ) print flush newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto stroke (error: wrong number of args for line ) print flush (error: wrong number of args for line ) print flush 0.19608 0.19608 0.19608 setrgbcolor newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto stroke 0 0.49804 1 setrgbcolor newpath 10 ubp -10 ubp moveto -10 ubp 20 ubp lineto 100 ubp 100 ubp lineto stroke (error: wrong number of args for linextend ) print flush newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto 110 ubp 10 ubp lineto 110 ubp 20 ubp lineto stroke gsave 10 ubp 10 ubp 45 rotabout newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto 110 ubp 10 ubp lineto 110 ubp 20 ubp lineto fill grestore gsave 20 ubp 20 ubp 45 rotabout newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto 110 ubp 10 ubp lineto 110 ubp 20 ubp lineto stroke grestore gsave 10 ubp 10 ubp translate newpath 10 ubp 10 ubp moveto 10 ubp 20 ubp lineto 110 ubp 10 ubp lineto 110 ubp 20 ubp lineto stroke grestore (error: bad polygon - not enough points ) print flush 120 ubp 120 ubp 30 ubp circle stroke 120 ubp 120 ubp 30 ubp circle fill (error: circle: wrong number of arguments ) print flush (error: circle: wrong number of arguments ) print flush 210 ubp 210 ubp 220 ubp 230 ubp box stroke 215 ubp 215 ubp 225 ubp 235 ubp box fill (error: box: wrong number of arguments ) print flush /Helvetica findfont 12 scalefont setfont (error: wrong number of arguments for setfont ) print flush newpath 10 ubp 10 ubp moveto (Hello World) show stroke newpath 10 ubp 10 ubp moveto (Hello World) show stroke newpath 10 ubp 10 ubp moveto (Hello World) 56 rotate show stroke -56 rotate (error: text: wrong number of arguments ) print flush (error: text: wrong number of arguments ) print flush (error: bad curve definition, wrong number of args ) print flush newpath 10 ubp 310 ubp moveto 10 ubp 320 ubp 110 ubp 310 ubp 110 ubp 320 ubp curveto 110 ubp 330 ubp 210 ubp 330 ubp 210 ubp 320 ubp curveto stroke (error: bad curvextend definition, wrong number of args ) print flush '; } PostScript-Simple-0.09/t/99cleanup.t0000755000175000017500000000030112410400011015334 0ustar mcnmcn#!/usr/bin/perl -w use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 3; my @files = qw/xtest-a.ps xtest-b.ps xtest-c.ps/; foreach (@files) { unlink $_; ok( ! -e $_ ); } PostScript-Simple-0.09/t/04units.t0000755000175000017500000000250012410400011015034 0ustar mcnmcn#!/usr/bin/perl use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 26; use PostScript::Simple; # test for units my $s = new PostScript::Simple(); my $t = new PostScript::Simple(units => "in", direction => "LeftUp"); my $u = new PostScript::Simple(units => "in", direction => "RightDown"); ok( $s ); ok( $t ); ok( ! keys(%{$s->{usedunits}}) ); ok( $s->_u("4") eq "4 ubp " ); ok( $t->_u("4") eq "4 uin " ); ok( keys(%{$s->{usedunits}}) ); ok( $s->_u("4 bp") eq "4 ubp " ); ok( $s->_u("4.5 in") eq "4.5 uin " ); ok( $s->{usedunits}{bp} eq "/ubp {} def" ); ok( $s->{usedunits}{in} eq "/uin {72 mul} def" ); ok( ! defined($t->{usedunits}{bp}) ); ok( $t->{usedunits}{in} eq "/uin {72 mul} def" ); ok( $s->_u([9.9, "pt"]) eq "9.9 upt "); # check invalid args eval { $s->_u([2]) }; ok( $@ ); eval { $s->_u([2, 5]) }; ok( $@ ); eval { $s->_u([2.78, "mm", 6]) }; ok( $@ ); eval { $s->_u("mm") }; ok( $@ ); eval { $s->_u("6 6") }; ok( $@ ); ok( $s->_ux("5 pc") eq "5 upc " ); ok( $t->_ux("5 pc") eq "-5 upc " ); ok( $t->_uy("5 pc") eq "5 upc " ); ok( $u->_uxy("5.394857 pc", "0.0010") eq "5.394857 upc -0.001 uin " ); ok( $u->_uxy([1010105.394857, "dd"], "0.0010") eq "1010105.394857 udd -0.001 uin " ); ok( keys(%{$s->{usedunits}}) == 4 ); ok( keys(%{$t->{usedunits}}) == 2 ); ok( keys(%{$u->{usedunits}}) == 3 ); PostScript-Simple-0.09/t/12file.t0000755000175000017500000000413112410400011014612 0ustar mcnmcn#!/usr/bin/perl -w use strict; use lib qw(./lib ../lib t/lib); use Test::Simple tests => 3; #use Data::Dumper; use PostScript::Simple; my $f = "xtest-c.ps"; my $p = new PostScript::Simple(papersize => "a4", colour => 1, units => "in", eps => 0, reencode => undef); ok( $p ); # create a new page $p->newpage; # draw some lines and other shapes $p->line(1,1, 1,4); $p->linextend(2,4); $p->box(1.5,1, 2,3.5); $p->circle(2,2, 1); # draw a rotated polygon in a different colour $p->setcolour(0,100,200); $p->polygon({rotate=>45}, 1,1, 1,2, 2,2, 2,1, 1,1); # add some text in red $p->setcolour("red", "blue"); $p->setcolour(255,0,0); $p->setfont("Times-Roman", 20); $p->text({rotate=>-37.5}, 1,1, "Hello"); # write the output to a file $p->output( $f ); ok( -e $f ); open( FILE, $f ) or die("Can't open $f: $!"); my $lines; while () { next if m/^%%/; $lines .= $_; } close FILE; ok( $lines eq CANNED() ); #print STDERR "\n>>>$lines<<<\n"; ### sub CANNED { return q[%!PS-Adobe-3.0 /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /circle {newpath 0 360 arc closepath} bind def /rotabout { 3 copy pop translate rotate exch 0 exch sub exch 0 exch sub translate } def /uin {72 mul} def ll 2 ge { << /PageSize [ 595.27559 841.88976 ] /ImagingBBox null >> setpagedevice } if /pagelevel save def newpath 1 uin 1 uin moveto 1 uin 4 uin lineto 2 uin 4 uin lineto stroke 1.5 uin 1 uin 2 uin 3.5 uin box stroke 2 uin 2 uin 1 uin circle stroke 0 0.39216 0.78431 setrgbcolor gsave 1 uin 1 uin 45 rotabout newpath 1 uin 1 uin moveto 1 uin 2 uin lineto 2 uin 2 uin lineto 2 uin 1 uin lineto 1 uin 1 uin lineto stroke grestore (error: setcolour given invalid arguments: red, blue, undef ) print flush 1 0 0 setrgbcolor /Times-Roman findfont 20 scalefont setfont newpath 1 uin 1 uin moveto (Hello) -37.5 rotate show stroke 37.5 rotate pagelevel restore showpage ]; } PostScript-Simple-0.09/TODO0000644000175000017500000000112112410400011013561 0ustar mcnmcnTO-DO better error reporting (postscript comments still?) check landscape: possible problems with rotation PostScript "compression", i.e. /n {newpath} bind def code compression using single letter dictionary defs (optional?) any postscript optimisation that can be done? postscript font support? define shape functions translate / scale / rotate functions? generate PostScript using a stack, rather than writing to the end of a text variable? could lead to some rather neat stuff (loops etc) (moved to ps:s "next gen") different line styles (dashes) (easy) ttf font support? (get lost!) PostScript-Simple-0.09/MANIFEST0000644000175000017500000000052512410400237014243 0ustar mcnmcnChanges MANIFEST Makefile.PL README TODO examples/example.pl examples/oldexample.pl examples/demo.ps lib/PostScript/Simple.pm lib/PostScript/Simple/EPS.pm t/01base.t t/02text.t t/03funcs.t t/04units.t t/10file.t t/11file.t t/12file.t t/99cleanup.t META.yml META.json Module JSON meta-data (added by MakeMaker) PostScript-Simple-0.09/examples/0002750000175000017500000000000012410400237014723 5ustar mcnmcnPostScript-Simple-0.09/examples/oldexample.pl0000755000175000017500000000701712410400011017413 0ustar mcnmcn#!/usr/bin/perl use lib qw(../lib); use PostScript::Simple; $t = new PostScript::Simple(landscape => 0, eps => 0, papersize => "a4", copies => "5", colour => 1, clip => 0, units => "mm"); $t->newpage(-1); for ($i=50; $i>10; $i-=5) { $t->arc(100,150,$i,(3*$i),180+(3*$i)); } $t->arc({filled=>1}, 100,150,10,0,270); $t->line(10,10, 10,50); $t->setlinewidth(8); $t->line(90,10, 90,50); $t->linextend(40,90); $t->setcolour("brightred"); $t->circle({filled=>1}, 40, 90, 30); $t->setcolour("darkgreen"); $t->setlinewidth(0.1); for ($i=0; $i<360; $i+=20) { $t->polygon({offset=>[0,0], rotate=>[$i,70,90], filled=>0}, 40,90, 69,92, 75,84);#, 70,88, 40,90); } $t->setlinewidth("thin"); $t->setcolour("darkgreen"); $t->box(20, 10, 80, 20); $t->setcolour("grey30"); $t->box({filled=>1}, 20, 30, 80, 40); $t->setcolour("grey10"); $t->setfont("Bookman", 12); $t->text(5,5, "Matthew"); $t->circletext({align=>"inside"},120,50,30,90,"Circular"); $t->circletext(120,50,30,-90,"Circular"); for ($i=0; $i<340; $i+=45) { $t->circletext({align=>"outside"},120,50,20,$i,"Round"); } $t->newpage; $t->line((10, 20), (30, 40)); $t->linextend(60, 50); $t->line(10,12, 20,12); $t->polygon(10,10, 20,10); $t->setcolour("grey90"); $t->polygon({offset=>[5,5], filled=>0}, 10,10, 15,20, 25,20, 30,10, 15,15, 10,10); $t->setcolour("black"); $t->polygon({offset=>[10,10], rotate=>[45,20,20], filled=>1}, 10,10, 15,20, 25,20, 30,10, 15,15, 10,10); $t->line((0, 100), (100, 0), (255, 0, 0)); $t->newpage(30); $s = new PostScript::Simple(xsize => 50, ysize => 200); $s->box(10, 10, 40, 190); $o = 10; for ($i=12; $i<80; $i+=2) { $t->setcolour($i*3, 0, 0); $t->box({filled=>1}, $o, 10, $i, 40); $o = $i; } $t->line((40, 30), (30, 10)); $t->linextend(60, 0); $t->line((0, 100), (100, 0),(0, 255, 0)); $s->output("test-b.eps"); #$t->importeps({stretch=>1}, "test-b.eps", 10, 100, 200, 200); my $ep = new PostScript::Simple::EPS(file => "test-b.eps"); $ep->rotate(30); $t->importeps($ep, 10, 100); $t->setcolour("red"); $t->box(10,150, 50,190); $t->importepsfile({stretch=>1}, "test-b.eps", 10, 150, 50, 190); $t->setcolour("blue"); $t->box(60,150, 100,190); $t->importepsfile({overlap=>1}, "test-b.eps", 60, 150, 100, 190); $t->setcolour("green"); $t->box(110,150, 150,190); $t->importepsfile("test-b.eps", 110, 150, 150, 190); $t->output("test-a.ps"); # create a new PostScript object $p = new PostScript::Simple(papersize => "a4", colour => 1, units => "in"); # draw some lines and other shapes $p->line(1,1, 1,4); $p->linextend(2,4); $p->box(1.5,1, 2,3.5); $p->circle(2,2, 1); # draw a rotated polygon in a different colour $p->setcolour(0,100,200); $p->polygon({rotate=>45}, 1,1, 1,2, 2,2, 2,1, 1,1); # add some text in red $p->setcolour("red"); $p->setfont("Times-Roman", 20); $p->text(1,1, "Hello"); # write the output to a file $p->output("test-c.eps"); # create a new PostScript object $p = new PostScript::Simple(papersize => "a4", eps => 0, colour => 1, coordorigin => "RightTop", direction => "LeftDown", units => "in"); $p->newpage; # draw some lines and other shapes $p->line(1,1, 1,4); $p->linextend(2,4); $p->box(1.5,1, 2,3.5); $p->circle(2,2, 1); # draw a rotated polygon in a different colour $p->setcolour(0,100,200); $p->polygon({rotate=>45}, 1,1, 1,2, 2,2, 2,1, 1,1); # add some text in red $p->setcolour("red"); $p->setfont("Times-Roman", 20); $p->text(1,1, "Hello"); # write the output to a file $p->output("test-d.eps"); PostScript-Simple-0.09/examples/example.pl0000755000175000017500000002077612410400011016723 0ustar mcnmcn#! /usr/bin/perl -w # Examples for PostScript::Simple module # Matthew Newton # 09 November 2003 use strict; use lib qw(../lib); use PostScript::Simple 0.06; my $ps; my $eps; my $directeps; my $y; # First, create an EPS file for use later $ps = new PostScript::Simple(xsize => 100, ysize => 100, colour => 1, eps => 1, reencode => undef); $ps->setlinewidth(5); $ps->box(10, 10, 90, 90); $ps->setlinewidth("thin"); $ps->line(0, 50, 100, 50); $ps->line(50, 0, 50, 100); $ps->line(0, 40, 0, 60); $ps->line(100, 40, 100, 60); $ps->line(40, 0, 60, 0); $ps->line(40, 100, 60, 100); $ps->output("demo-square.eps"); # Let's also create a PostScript::Simple::EPS object directly from it #$directeps = new PostScript::Simple::EPS(source => $ps->get()); $directeps = $ps->geteps(); undef $ps; # Now generate the demo document. Start by creating the A4 document. $ps = new PostScript::Simple(papersize => "a4", units => "mm", colour => 1, eps => 0, reencode => undef); ################################################################################ # PAGE 1 ################################################################################ # Create page (EPS import from a file, demo-square.eps) mynewpage($ps, "EPS import functions (from a file)"); $ps->setfont("Courier", 10); #------------------------------------------------------------------------------- # Red example (left) $ps->setcolour("red"); $ps->box(20, 210, 45, 260); $ps->importepsfile("demo-square.eps", 20, 210, 45, 260); $ps->setcolour("darkred"); $ps->text({rotate => -90}, 14, 270, '$ps->importepsfile("demo-square.eps", 20, 210, 45, 260);'); #------------------------------------------------------------------------------- # Green example (centre) $ps->setcolour("green"); $ps->box(80, 210, 105, 260); $ps->importepsfile({stretch => 1}, "demo-square.eps", 80, 210, 105, 260); $ps->setcolour("darkgreen"); $ps->text({rotate => -90}, 74, 270, '$ps->importepsfile({stretch => 1}, "demo-square.eps", 80, 210, 105, 260);'); #------------------------------------------------------------------------------- # Blue example (right) $ps->setcolour("blue"); $ps->box(140, 210, 165, 260); $ps->importepsfile({overlap => 1}, "demo-square.eps", 140, 210, 165, 260); $ps->setcolour("darkblue"); $ps->text({rotate => -90}, 134, 270, '$ps->importepsfile({overlap => 1}, "demo-square.eps", 140, 210, 165, 260);'); #------------------------------------------------------------------------------- # Purple example (bottom) $ps->setcolour(200, 0, 200); $ps->box(30, 30, 90, 90); $eps = new PostScript::Simple::EPS(file => "demo-square.eps", clip => 1); $eps->scale(60/100); $eps->translate(50, 50); $eps->rotate(20); $eps->translate(-50, -50); $ps->importeps($eps, 30, 30); $ps->setfont("Courier", 10); $y = 90; $ps->text(100, $y-=5, '$eps = new PostScript::Simple::EPS'); $ps->text(110, $y-=5, '(file => "demo-square.eps");'); $ps->text(100, $y-=5, '$eps->scale(60/100);'); $ps->text(100, $y-=5, '$eps->translate(50, 50);'); $ps->text(100, $y-=5, '$eps->rotate(20);'); $ps->text(100, $y-=5, '$eps->translate(-50, -50);'); $ps->text(100, $y-=5, '$ps->importeps($eps, 30, 30);'); ################################################################################ # PAGE 2 ################################################################################ # Create page (using generated EPS object) mynewpage($ps, "EPS import functions (using internal EPS object)"); $ps->setfont("Courier", 10); $ps->setcolour("red"); $ps->box(20, 210, 45, 260); #$ps->importepsfile("demo-square.eps", 20, 210, 45, 260); $directeps->reset(); $directeps->scale(25/$directeps->width()); $ps->importeps($directeps, 20, 210); $ps->setcolour("darkred"); $ps->text({rotate => -60}, 30, 205, '$directeps->reset();'); $ps->text({rotate => -60}, 25, 205, '$directeps->scale(25/$directeps->width());'); $ps->text({rotate => -60}, 20, 205, '$ps->importeps($directeps, 20, 210);'); $ps->setcolour("green"); $ps->box(80, 210, 105, 260); #$ps->importepsfile({stretch => 1}, "demo-square.eps", 80, 210, 105, 260); $directeps->reset(); $directeps->scale(25/$directeps->width(), 50/$directeps->height()); $ps->importeps($directeps, 80, 210); $ps->setcolour("darkgreen"); $ps->text({rotate => -60}, 90, 205, '$directeps->reset();'); $ps->text({rotate => -60}, 85, 205, '$directeps->scale(25/$directeps->width(), 50/$directeps->height());'); $ps->text({rotate => -60}, 80, 205, '$ps->importeps($directeps, 80, 210);'); $ps->setcolour("blue"); $ps->box(140, 210, 165, 260); $directeps->reset(); $directeps->scale(50/$directeps->height()); $ps->importeps($directeps, 140, 210); $ps->setcolour("darkblue"); $ps->text({rotate => -60}, 150, 205, '$directeps->reset();'); $ps->text({rotate => -60}, 145, 205, '$directeps->scale(50/$directeps->height());'); $ps->text({rotate => -60}, 140, 205, '$ps->importeps($directeps, 140, 210);'); $ps->setcolour(200, 0, 200); $ps->box(30, 30, 90, 90); $directeps->reset(); $directeps->translate(50, 50); $directeps->rotate(20); $directeps->translate(-50, -50); $eps = new PostScript::Simple(eps => 1, xsize => 100, ysize => 100); $eps->importeps($directeps, 0, 0); $directeps = $eps->geteps(); $directeps->scale(60/100); $ps->importeps($directeps, 30, 30); $ps->setfont("Courier", 10); $y = 80; $ps->text(100, $y-=5, '$directeps->reset();'); $ps->text(100, $y-=5, '$directeps->translate(50, 50);'); $ps->text(100, $y-=5, '$directeps->rotate(20);'); $ps->text(100, $y-=5, '$directeps->translate(-50, -50);'); $ps->text(100, $y-=5, '# round-about way to set clipping path'); $ps->text(100, $y-=5, '$eps = new PostScript::Simple(eps => 1,'); $ps->text(110, $y-=5, 'xsize => 100, ysize => 100);'); $ps->text(100, $y-=5, '$eps->importeps($directeps, 0, 0);'); $ps->text(100, $y-=5, '$directeps = $eps->geteps();'); $ps->text(100, $y-=5, '$directeps->scale(60/100);'); $ps->text(100, $y-=5, '$ps->importeps($directeps, 30, 30);'); ################################################################################ # PAGE 3 ################################################################################ # Create page (using generated EPS object) mynewpage($ps, "Using different units"); $ps->setfont("Courier", 10); $ps->setcolour("red"); $ps->text(20, 268, '$ps->line(20,265, 190,265); # default units is mm'); $ps->line(20,265, 190,265); $ps->setcolour("blue"); $ps->text(20, 258, '$ps->setlinewidth("5 pt");'); $ps->text(20, 253, '$ps->line(20,255, 190,255);'); $ps->setlinewidth("5 pt"); $ps->line(20,250, 190,250); $ps->setcolour("green"); $ps->text(20, 243, '$ps->setlinewidth([0.25, "in");'); $ps->text(20, 238, '$ps->line(20,232, 190,232);'); $ps->setlinewidth([0.25, "in"]); $ps->line(20,232, 190,232); $ps->setcolour("purple"); $ps->text(20, 224, '$ps->setlinewidth("thin"); # thin is 0.4 pt'); $ps->text(20, 219, '$ps->line(20,216, 190,216);'); $ps->setlinewidth("thin"); $ps->line(20,216, 190,216); $y = 210; for (my $x = 1; $x < 7; $x++) { $ps->setlinewidth([8, "dd"]); $ps->line([$x, "in"],$y, [$x+1, "in"],$y, 255/$x, 128, 128); $ps->setlinewidth("thin"); $ps->line([$x, "in"],212, [$x, "in"],198, 0,0,0); $y -= 2; } $ps->line([7, "in"],212, [7, "in"],198, 0,0,0); $y = 198; $ps->text(20, $y-=5, '$y = 210;'); $ps->text(20, $y-=5, 'for (my $x = 1; $x < 7; $x++) {'); $ps->text(20, $y-=5, ' $ps->setlinewidth([8, "dd"]);'); $ps->text(20, $y-=5, ' $ps->line([$x, "in"],$y, [$x+1, "in"],$y, 255/$x, 128, 128); # also set colour'); $ps->text(20, $y-=5, ' $ps->setlinewidth("thin");'); $ps->text(20, $y-=5, ' $ps->line([$x, "in"],212, [$x, "in"],198, 0,0,0); # set black'); $ps->text(20, $y-=5, ' $y -= 2;'); $ps->text(20, $y-=5, '}'); $ps->text(20, $y-=5, '$ps->line([7, "in"],212, [7, "in"],198, 0,0,0);'); $ps->setlinewidth("15 pt"); $ps->circle(50, "4.5in", "1in"); $ps->setfont("Courier-Bold", 10); $ps->setcolour("yellow"); $ps->circletext({align => "outside"}, 50, "4.5in", "0.96in", 90, '$ps->setlinewidth("10 pt"); $ps->circle(50, "4.5in", "2in");'); $ps->setcolour("darkred"); $ps->setfont("Courier", 8); $ps->circletext({align => "outside"}, 50, "4.5in", "0.78in", 90, '$ps->circletext({align => "outside"}, 50, "4.5in", "0.96in", 90, "...");'); # Write out the document. $ps->output("demo.ps"); sub mynewpage { my $ps = shift; my $title = shift; $ps->newpage; $ps->box(10, 10, 200, 287); $ps->line(10, 277, 200, 277); $ps->setfont("Times-Roman", 14); $ps->text(15, 280, "PostScript::Simple example file: $title"); } PostScript-Simple-0.09/examples/demo.ps0000644000175000017500000006133412410400011016213 0ustar mcnmcn%!PS-Adobe-3.0 %%Title: (demo.ps) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%DocumentMedia: A4 595.27559 841.88976 0 ( ) ( ) %%Orientation: Portrait %%Pages: 3 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /BeginEPSF { /b4_Inc_state save def /dict_count countdictstack def /op_count count 1 sub def userdict begin /showpage { } def 0 setgray 0 setlinecap 1 setlinewidth 0 setlinejoin 10 setmiterlimit [ ] 0 setdash newpath /languagelevel where { pop languagelevel 1 ne { false setstrokeadjust false setoverprint } if } if } bind def /EndEPSF { count op_count sub {pop} repeat countdictstack dict_count sub {end} repeat b4_Inc_state restore } bind def /circle {newpath 0 360 arc closepath} bind def /outsidecircletext { $circtextdict begin /radius exch def /centerangle exch def /ptsize exch def /str exch def /xradius radius ptsize 4 div add def gsave centerangle str findhalfangle add rotate str { /charcode exch def ( ) dup 0 charcode put outsideshowcharandrotate } forall grestore end } def /insidecircletext { $circtextdict begin /radius exch def /centerangle exch def /ptsize exch def /str exch def /xradius radius ptsize 3 div sub def gsave centerangle str findhalfangle sub rotate str { /charcode exch def ( ) dup 0 charcode put insideshowcharandrotate } forall grestore end } def /$circtextdict 16 dict def $circtextdict begin /findhalfangle { stringwidth pop 2 div 2 xradius mul pi mul div 360 mul } def /outsideshowcharandrotate { /char exch def /halfangle char findhalfangle def gsave halfangle neg rotate radius 0 translate -90 rotate char stringwidth pop 2 div neg 0 moveto char show grestore halfangle 2 mul neg rotate } def /insideshowcharandrotate { /char exch def /halfangle char findhalfangle def gsave halfangle rotate radius 0 translate 90 rotate char stringwidth pop 2 div neg 0 moveto char show grestore halfangle 2 mul rotate } def /pi 3.1415926 def end /ubp {} def /udd {72 mul 67.567 div} def /uin {72 mul} def /umm {72 mul 25.4 div} def /upt {72 mul 72.27 div} def %%EndResource %%EndProlog %%BeginSetup ll 2 ge { << /PageSize [ 595.27559 841.88976 ] /ImagingBBox null >> setpagedevice } if %%EndSetup %%Page: 1 1 %%BeginPageSetup /pagelevel save def %%EndPageSetup 10 umm 10 umm 200 umm 287 umm box stroke newpath 10 umm 277 umm moveto 200 umm 277 umm lineto stroke /Times-Roman findfont 14 scalefont setfont newpath 15 umm 280 umm moveto (PostScript::Simple example file: EPS import functions \(from a file\)) show stroke /Courier findfont 10 scalefont setfont 0.8 0 0 setrgbcolor 20 umm 210 umm 45 umm 260 umm box stroke BeginEPSF 20 umm 210 umm translate 1 umm 1 umm scale 0.25 0.25 scale 0 0 translate newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (demo-square.eps) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (demo-square.eps) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0.49804 0 0 setrgbcolor newpath 14 umm 270 umm moveto ($ps->importepsfile\("demo-square.eps", 20, 210, 45, 260\);) -90 rotate show stroke 90 rotate 0 0.8 0 setrgbcolor 80 umm 210 umm 105 umm 260 umm box stroke BeginEPSF 80 umm 210 umm translate 1 umm 1 umm scale 0.25 0.5 scale 0 0 translate newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (demo-square.eps) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (demo-square.eps) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0 0.49804 0 setrgbcolor newpath 74 umm 270 umm moveto ($ps->importepsfile\({stretch => 1}, "demo-square.eps", 80, 210, 105, 260\);) -90 rotate show stroke 90 rotate 0 0 0.8 setrgbcolor 140 umm 210 umm 165 umm 260 umm box stroke BeginEPSF 140 umm 210 umm translate 1 umm 1 umm scale 0.5 0.5 scale 0 0 translate newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (demo-square.eps) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (demo-square.eps) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0 0 0.49804 setrgbcolor newpath 134 umm 270 umm moveto ($ps->importepsfile\({overlap => 1}, "demo-square.eps", 140, 210, 165, 260\);) -90 rotate show stroke 90 rotate 0.78431 0 0.78431 setrgbcolor 30 umm 30 umm 90 umm 90 umm box stroke BeginEPSF 30 umm 30 umm translate 1 umm 1 umm scale 0.6 0.6 scale 50 50 translate 20 rotate -50 -50 translate newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (demo-square.eps) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (demo-square.eps) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF /Courier findfont 10 scalefont setfont newpath 100 umm 85 umm moveto ($eps = new PostScript::Simple::EPS) show stroke newpath 110 umm 80 umm moveto (\(file => "demo-square.eps"\);) show stroke newpath 100 umm 75 umm moveto ($eps->scale\(60/100\);) show stroke newpath 100 umm 70 umm moveto ($eps->translate\(50, 50\);) show stroke newpath 100 umm 65 umm moveto ($eps->rotate\(20\);) show stroke newpath 100 umm 60 umm moveto ($eps->translate\(-50, -50\);) show stroke newpath 100 umm 55 umm moveto ($ps->importeps\($eps, 30, 30\);) show stroke %%PageTrailer pagelevel restore showpage %%Page: 2 2 %%BeginPageSetup /pagelevel save def %%EndPageSetup 10 umm 10 umm 200 umm 287 umm box stroke newpath 10 umm 277 umm moveto 200 umm 277 umm lineto stroke /Times-Roman findfont 14 scalefont setfont newpath 15 umm 280 umm moveto (PostScript::Simple example file: EPS import functions \(using internal EPS object\)) show stroke /Courier findfont 10 scalefont setfont 0.8 0 0 setrgbcolor 20 umm 210 umm 45 umm 260 umm box stroke BeginEPSF 20 umm 210 umm translate 1 umm 1 umm scale 0.25 0.25 scale newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (undef) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (PostScript::Simple generated page) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0.49804 0 0 setrgbcolor newpath 30 umm 205 umm moveto ($directeps->reset\(\);) -60 rotate show stroke 60 rotate newpath 25 umm 205 umm moveto ($directeps->scale\(25/$directeps->width\(\)\);) -60 rotate show stroke 60 rotate newpath 20 umm 205 umm moveto ($ps->importeps\($directeps, 20, 210\);) -60 rotate show stroke 60 rotate 0 0.8 0 setrgbcolor 80 umm 210 umm 105 umm 260 umm box stroke BeginEPSF 80 umm 210 umm translate 1 umm 1 umm scale 0.25 0.5 scale newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (undef) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (PostScript::Simple generated page) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0 0.49804 0 setrgbcolor newpath 90 umm 205 umm moveto ($directeps->reset\(\);) -60 rotate show stroke 60 rotate newpath 85 umm 205 umm moveto ($directeps->scale\(25/$directeps->width\(\), 50/$directeps->height\(\)\);) -60 rotate show stroke 60 rotate newpath 80 umm 205 umm moveto ($ps->importeps\($directeps, 80, 210\);) -60 rotate show stroke 60 rotate 0 0 0.8 setrgbcolor 140 umm 210 umm 165 umm 260 umm box stroke BeginEPSF 140 umm 210 umm translate 1 umm 1 umm scale 0.5 0.5 scale newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (undef) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (PostScript::Simple generated page) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF 0 0 0.49804 setrgbcolor newpath 150 umm 205 umm moveto ($directeps->reset\(\);) -60 rotate show stroke 60 rotate newpath 145 umm 205 umm moveto ($directeps->scale\(50/$directeps->height\(\)\);) -60 rotate show stroke 60 rotate newpath 140 umm 205 umm moveto ($ps->importeps\($directeps, 140, 210\);) -60 rotate show stroke 60 rotate 0.78431 0 0.78431 setrgbcolor 30 umm 30 umm 90 umm 90 umm box stroke BeginEPSF 30 umm 30 umm translate 1 umm 1 umm scale 0.6 0.6 scale newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (undef) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (PostScript::Simple generated page) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /STARTDIFFENC { mark } bind def /ENDDIFFENC { % /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC - counttomark 2 add -1 roll 256 array copy /TempEncode exch def % pointer for sequential encodings /EncodePointer 0 def { % Get the bottom object counttomark -1 roll % Is it a mark? dup type dup /marktype eq { % End of encoding pop pop exit } { /nametype eq { % Insert the name at EncodePointer % and increment the pointer. TempEncode EncodePointer 3 -1 roll put /EncodePointer EncodePointer 1 add def } { % Set the EncodePointer to the number /EncodePointer exch def } ifelse } ifelse } loop TempEncode def } bind def % Define ISO Latin1 encoding if it doesnt exist /ISOLatin1Encoding where { % (ISOLatin1 exists!) = pop } { (ISOLatin1 does not exist, creating...) = /ISOLatin1Encoding StandardEncoding STARTDIFFENC 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ENDDIFFENC } ifelse % Name: Re-encode Font % Description: Creates a new font using the named encoding. /REENCODEFONT { % /Newfont NewEncoding /Oldfont findfont dup length 4 add dict begin { % forall 1 index /FID ne 2 index /UniqueID ne and 2 index /XUID ne and { def } { pop pop } ifelse } forall /Encoding exch def % defs for DPS /BitmapWidths false def /ExactSize 0 def /InBetweenSize 0 def /TransformedChar 0 def currentdict end definefont pop } bind def % Reencode the std fonts: /Courier-iso ISOLatin1Encoding /Courier REENCODEFONT /Courier-Bold-iso ISOLatin1Encoding /Courier-Bold REENCODEFONT /Courier-BoldOblique-iso ISOLatin1Encoding /Courier-BoldOblique REENCODEFONT /Courier-Oblique-iso ISOLatin1Encoding /Courier-Oblique REENCODEFONT /Helvetica-iso ISOLatin1Encoding /Helvetica REENCODEFONT /Helvetica-Bold-iso ISOLatin1Encoding /Helvetica-Bold REENCODEFONT /Helvetica-BoldOblique-iso ISOLatin1Encoding /Helvetica-BoldOblique REENCODEFONT /Helvetica-Oblique-iso ISOLatin1Encoding /Helvetica-Oblique REENCODEFONT /Times-Roman-iso ISOLatin1Encoding /Times-Roman REENCODEFONT /Times-Bold-iso ISOLatin1Encoding /Times-Bold REENCODEFONT /Times-BoldItalic-iso ISOLatin1Encoding /Times-BoldItalic REENCODEFONT /Times-Italic-iso ISOLatin1Encoding /Times-Italic REENCODEFONT /Symbol-iso ISOLatin1Encoding /Symbol REENCODEFONT /BeginEPSF { /b4_Inc_state save def /dict_count countdictstack def /op_count count 1 sub def userdict begin /showpage { } def 0 setgray 0 setlinecap 1 setlinewidth 0 setlinejoin 10 setmiterlimit [ ] 0 setdash newpath /languagelevel where { pop languagelevel 1 ne { false setstrokeadjust false setoverprint } if } if } bind def /EndEPSF { count op_count sub {pop} repeat countdictstack dict_count sub {end} repeat b4_Inc_state restore } bind def /ubp {} def %%EndResource %%EndProlog BeginEPSF 0 ubp 0 ubp translate 1 ubp 1 ubp scale 50 50 translate 20 rotate -50 -50 translate newpath 0 0 moveto 100 0 lineto 100 100 lineto 0 100 lineto closepath clip newpath %%BeginDocument: (undef) %!PS-Adobe-3.0 EPSF-1.2 %%Title: (PostScript::Simple generated page) %%LanguageLevel: 1 %%Creator: PostScript::Simple perl module version 0.08 %%CreationDate: Sat Jun 21 01:43:12 2014 %%For: mcn %%Orientation: Portrait %%BoundingBox: 0 0 100 100 %%EndComments %%BeginProlog /ll 1 def systemdict /languagelevel known { /ll languagelevel def } if %%BeginResource: PostScript::Simple /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def /ubp {} def %%EndResource %%EndProlog 5 ubp setlinewidth 10 ubp 10 ubp 90 ubp 90 ubp box stroke 0.4 ubp setlinewidth newpath 0 ubp 50 ubp moveto 100 ubp 50 ubp lineto stroke newpath 50 ubp 0 ubp moveto 50 ubp 100 ubp lineto stroke newpath 0 ubp 40 ubp moveto 0 ubp 60 ubp lineto stroke newpath 100 ubp 40 ubp moveto 100 ubp 60 ubp lineto stroke newpath 40 ubp 0 ubp moveto 60 ubp 0 ubp lineto stroke newpath 40 ubp 100 ubp moveto 60 ubp 100 ubp lineto stroke %%EOF %%EndDocument EndEPSF %%EOF %%EndDocument EndEPSF /Courier findfont 10 scalefont setfont newpath 100 umm 75 umm moveto ($directeps->reset\(\);) show stroke newpath 100 umm 70 umm moveto ($directeps->translate\(50, 50\);) show stroke newpath 100 umm 65 umm moveto ($directeps->rotate\(20\);) show stroke newpath 100 umm 60 umm moveto ($directeps->translate\(-50, -50\);) show stroke newpath 100 umm 55 umm moveto (# round-about way to set clipping path) show stroke newpath 100 umm 50 umm moveto ($eps = new PostScript::Simple\(eps => 1,) show stroke newpath 110 umm 45 umm moveto (xsize => 100, ysize => 100\);) show stroke newpath 100 umm 40 umm moveto ($eps->importeps\($directeps, 0, 0\);) show stroke newpath 100 umm 35 umm moveto ($directeps = $eps->geteps\(\);) show stroke newpath 100 umm 30 umm moveto ($directeps->scale\(60/100\);) show stroke newpath 100 umm 25 umm moveto ($ps->importeps\($directeps, 30, 30\);) show stroke %%PageTrailer pagelevel restore showpage %%Page: 3 3 %%BeginPageSetup /pagelevel save def %%EndPageSetup 10 umm 10 umm 200 umm 287 umm box stroke newpath 10 umm 277 umm moveto 200 umm 277 umm lineto stroke /Times-Roman findfont 14 scalefont setfont newpath 15 umm 280 umm moveto (PostScript::Simple example file: Using different units) show stroke /Courier findfont 10 scalefont setfont 0.8 0 0 setrgbcolor newpath 20 umm 268 umm moveto ($ps->line\(20,265, 190,265\); # default units is mm) show stroke newpath 20 umm 265 umm moveto 190 umm 265 umm lineto stroke 0 0 0.8 setrgbcolor newpath 20 umm 258 umm moveto ($ps->setlinewidth\("5 pt"\);) show stroke newpath 20 umm 253 umm moveto ($ps->line\(20,255, 190,255\);) show stroke 5 upt setlinewidth newpath 20 umm 250 umm moveto 190 umm 250 umm lineto stroke 0 0.8 0 setrgbcolor newpath 20 umm 243 umm moveto ($ps->setlinewidth\([0.25, "in"\);) show stroke newpath 20 umm 238 umm moveto ($ps->line\(20,232, 190,232\);) show stroke 0.25 uin setlinewidth newpath 20 umm 232 umm moveto 190 umm 232 umm lineto stroke 0.50196 0 0.50196 setrgbcolor newpath 20 umm 224 umm moveto ($ps->setlinewidth\("thin"\); # thin is 0.4 pt) show stroke newpath 20 umm 219 umm moveto ($ps->line\(20,216, 190,216\);) show stroke 0.4 ubp setlinewidth newpath 20 umm 216 umm moveto 190 umm 216 umm lineto stroke 8 udd setlinewidth 1 0.50196 0.50196 setrgbcolor newpath 1 uin 210 umm moveto 2 uin 210 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 1 uin 212 umm moveto 1 uin 198 umm lineto stroke 8 udd setlinewidth 0.5 0.50196 0.50196 setrgbcolor newpath 2 uin 208 umm moveto 3 uin 208 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 2 uin 212 umm moveto 2 uin 198 umm lineto stroke 8 udd setlinewidth 0.33333 0.50196 0.50196 setrgbcolor newpath 3 uin 206 umm moveto 4 uin 206 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 3 uin 212 umm moveto 3 uin 198 umm lineto stroke 8 udd setlinewidth 0.25 0.50196 0.50196 setrgbcolor newpath 4 uin 204 umm moveto 5 uin 204 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 4 uin 212 umm moveto 4 uin 198 umm lineto stroke 8 udd setlinewidth 0.2 0.50196 0.50196 setrgbcolor newpath 5 uin 202 umm moveto 6 uin 202 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 5 uin 212 umm moveto 5 uin 198 umm lineto stroke 8 udd setlinewidth 0.16667 0.50196 0.50196 setrgbcolor newpath 6 uin 200 umm moveto 7 uin 200 umm lineto stroke 0.4 ubp setlinewidth 0 0 0 setrgbcolor newpath 6 uin 212 umm moveto 6 uin 198 umm lineto stroke 0 0 0 setrgbcolor newpath 7 uin 212 umm moveto 7 uin 198 umm lineto stroke newpath 20 umm 193 umm moveto ($y = 210;) show stroke newpath 20 umm 188 umm moveto (for \(my $x = 1; $x < 7; $x++\) {) show stroke newpath 20 umm 183 umm moveto ( $ps->setlinewidth\([8, "dd"]\);) show stroke newpath 20 umm 178 umm moveto ( $ps->line\([$x, "in"],$y, [$x+1, "in"],$y, 255/$x, 128, 128\); # also set colour) show stroke newpath 20 umm 173 umm moveto ( $ps->setlinewidth\("thin"\);) show stroke newpath 20 umm 168 umm moveto ( $ps->line\([$x, "in"],212, [$x, "in"],198, 0,0,0\); # set black) show stroke newpath 20 umm 163 umm moveto ( $y -= 2;) show stroke newpath 20 umm 158 umm moveto (}) show stroke newpath 20 umm 153 umm moveto ($ps->line\([7, "in"],212, [7, "in"],198, 0,0,0\);) show stroke 15 upt setlinewidth 50 umm 4.5 uin 1 uin circle stroke /Courier-Bold findfont 10 scalefont setfont 1 1 0 setrgbcolor gsave 50 umm 4.5 uin translate ($ps->setlinewidth("10 pt"); $ps->circle(50, "4.5in", "2in");) 10 90 0.96 uin outsidecircletext grestore 0.49804 0 0 setrgbcolor /Courier findfont 8 scalefont setfont gsave 50 umm 4.5 uin translate ($ps->circletext({align => "outside"}, 50, "4.5in", "0.96in", 90, "...");) 8 90 0.78 uin outsidecircletext grestore %%PageTrailer pagelevel restore showpage %%EOF PostScript-Simple-0.09/Makefile.PL0000644000175000017500000000114712410400011015053 0ustar mcnmcnuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'PostScript::Simple', 'VERSION_FROM' => 'lib/PostScript/Simple.pm', # finds $VERSION 'PREREQ_PM' => { 'Test::More' => 0.18, ### Requires Test::More by tests.(Test::Simple and Test::Utils is not used.) }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/PostScript/Simple.pm', # retrieve abstract from module AUTHOR => 'Matthew Newton ') : ()), ); PostScript-Simple-0.09/META.json0000660000175000017500000000157512410400237014537 0ustar mcnmcn{ "abstract" : "Produce PostScript files from Perl", "author" : [ "Matthew Newton " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "PostScript-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::More" : "0.18" } } }, "release_status" : "stable", "version" : "0.09" } PostScript-Simple-0.09/README0000644000175000017500000000420112410400011013753 0ustar mcnmcnPostScript::Simple ================== INTRODUCTION PostScript::Simple allows you to have a simple method of writing PostScript files from Perl. It has several graphics primitives that allow lines, circles, polygons and boxes to be drawn. Text can be added to the page using standard PostScript fonts. It is named PostScript::Simple because it is intended to be simple to use to generate PostScript pages from Perl, not because it is a simplified interface for some other module, or can't do advanced things. Features include: Generation of multi-page PostScript files Generation of single-page EPS files Creating lines/circles etc. Rectangles and boxes Text Colour Pre-defined paper sizes Etc. etc. The file examples/example.pl provides some bad examples of what this module does. SOURCE The module source is now hosted on GitHub; see: https://github.com/mcnewton/postscript-simple INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2002-2014 Matthew C. Newton This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details, available at http://www.gnu.org/licenses/gpl.html. ACKNOWLEDGEMENTS Many people have contributed in different ways to PostScript::Simple. Thanks go to everyone involved! People who have helped include (in no particular order): Mark Withall, Andreas Riechert, P Kent, Flemming Frandsen, Michael Tomuschat, Vladi Belperchinov-Shabanski, Eric Voisard, Martin McCarthy, Eric Wilhelm, Glen Harris, Peter Kuehn, Tomas Karlsson, Satoshi Azuma I apologise if you should be here and I have missed you, please let me know. If you have sent me a patch for this module, and had no reply, please re-send it. I'm particularly bad at missing e-mails... PostScript-Simple-0.09/lib/0002750000175000017500000000000012410400237013653 5ustar mcnmcnPostScript-Simple-0.09/lib/PostScript/0002750000175000017500000000000012410400237015765 5ustar mcnmcnPostScript-Simple-0.09/lib/PostScript/Simple/0002750000175000017500000000000012410400237017216 5ustar mcnmcnPostScript-Simple-0.09/lib/PostScript/Simple/EPS.pm0000644000175000017500000003064612410400011020205 0ustar mcnmcn#! /usr/bin/perl package PostScript::Simple::EPS; use strict; use Exporter; use Carp; use PostScript::Simple; use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = qw(); $VERSION = "0.02"; #------------------------------------------------------------------------------- =head1 NAME PostScript::Simple::EPS - EPS support for PostScript::Simple =head1 SYNOPSIS use PostScript::Simple; # create a new PostScript object $p = new PostScript::Simple(papersize => "A4", colour => 1, units => "in"); # create a new page $p->newpage; # add an eps file $p->add_eps({xsize => 3}, "test.eps", 1,1); $p->add_eps({yscale => 1.1, xscale => 1.8}, "test.eps", 4,8); # create an eps object $e = new PostScript::Simple::EPS(file => "test.eps"); $e->rotate(90); $e->xscale(0.5); $p->add_eps($e, 3, 3); # add eps object to postscript object $e->xscale(2); $p->add_eps($e, 2, 5); # add eps object to postscript object again # write the output to a file $p->output("file.ps"); =head1 DESCRIPTION PostScript::Simple::EPS allows you to add EPS files into PostScript::Simple objects. Included EPS files can be scaled and rotated, and placed anywhere inside a PostScript::Simple page. Remember when using translate/scale/rotate that you will normally need to do the operations in the reverse order to that which you expect. =head1 PREREQUISITES This module requires C, C, C and C. =head2 EXPORT None. =cut =head1 CONSTRUCTOR =over 4 =item C Create a new PostScript::Simple::EPS object. The options that can be set are: =over 4 =item file EPS file to be included. This or C must exist when the C method is called. =item source PostScript code for the EPS document. Either this or C must be set when C is called. =item clip Set to 0 to disable clipping to the EPS bounding box. Default is to clip. =back Example: $ps = new PostScript::Simple(landscape => 1, eps => 0, xsize => 4, ysize => 3, units => "in"); $eps = new PostScript::Simple::EPS(file => "test.eps"); $eps->scale(0.5); Scale the EPS file by x0.5 in both directions. $ps->newpage(); $ps->importeps($eps, 1, 1); Add the EPS file to the PostScript document at coords (1,1). $ps->importepsfile("another.eps", 1, 2, 4, 4); Easily add an EPS file to the PostScript document using bounding box (1,2),(4,4). The methods C and C are described in the documentation of C. =back =cut sub new { my ($class, %data) = @_; my $self = { file => undef, # filename of the eps file xsize => undef, ysize => undef, units => "bp", # measuring units (see below) clip => 1, # clip to the bounding box bbx1 => 0, # Bounding Box definitions bby1 => 0, bbx2 => 0, bby2 => 0, epsprefix => [], epsfile => undef, epspostfix => [], }; foreach (keys %data) { $self->{$_} = $data{$_}; } if ((!defined $self->{"file"}) && (!defined $self->{"source"})) { croak "must provide file or source"; } if ((defined $self->{"file"}) && (defined $self->{"source"})) { croak "cannot provide both file and source"; } bless $self, $class; $self->init(); return $self; } #------------------------------------------------------------------------------- sub init { my $self = shift; my $foundbbx = 0; if (defined($$self{source})) { croak "EPS file must contain a BoundingBox" if (!$self->_getsourcebbox()); } else { croak "EPS file must contain a BoundingBox" if (!_getfilebbox($self)); } if (($$self{bbx2} - $$self{bbx1} == 0) || ($$self{bby2} - $$self{bby1} == 0)) { $self->_error("PostScript::Simple::EPS: Bounding Box has zero dimension"); return 0; } $self->reset(); return 1; } #------------------------------------------------------------------------------- =head1 OBJECT METHODS All object methods return 1 for success or 0 in some error condition (e.g. insufficient arguments). Error message text is also drawn on the page. =over 4 =item C Returns the EPS bounding box, as specified on the %%BoundingBox line of the EPS file. Units are standard PostScript points. Example: ($x1, $y1, $x2, $y2) = $eps->get_bbox(); =cut sub get_bbox { my $self = shift; return ($$self{bbx1}, $$self{bby1}, $$self{bbx2}, $$self{bby2}); } #------------------------------------------------------------------------------- =item C Returns the EPS width, in PostScript points. Example: print "EPS width is " . abs($eps->width()) . "\n"; =cut sub width { my $self = shift; return ($$self{bbx2} - $$self{bbx1}); } #------------------------------------------------------------------------------- =item C Returns the EPS height, in PostScript points. Example: To scale $eps to 72 points high, do: $eps->scale(1, 72/$eps->height()); =cut sub height { my $self = shift; return ($$self{bby2} - $$self{bby1}); } #------------------------------------------------------------------------------- =item C Scales the EPS file. To scale in one direction only, specify 1 as the other scale. To scale the EPS file the same in both directions, you may use the shortcut of just specifying the one value. Example: $eps->scale(1.2, 0.8); # make wider and shorter $eps->scale(0.5); # shrink to half size =cut sub scale { my $self = shift; my ($x, $y) = @_; $y = $x if (!defined $y); croak "bad arguments to scale" if (!defined $x); push @{$$self{epsprefix}}, "$x $y scale"; return 1; } #------------------------------------------------------------------------------- =item C Rotates the EPS file by C degrees anti-clockwise. The EPS file is rotated about it's own origin (as defined by it's bounding box). To rotate by a particular co-ordinate (again, relative to the EPS file, not the main PostScript document), use translate, too. Example: $eps->rotate(180); # turn upside-down To rotate 30 degrees about point (50,50): $eps->translate(50, 50); $eps->rotate(30); $eps->translate(-50, -50); =cut sub rotate { my $self = shift; my ($d) = @_; croak "bad arguments to rotate" if (!defined $d); push @{$$self{epsprefix}}, "$d rotate"; return 1; } #------------------------------------------------------------------------------- =item C Move the EPS file by C,C PostScript points. Example: $eps->translate(10, 10); # move 10 points in both directions =cut sub translate { my $self = shift; my ($x, $y) = @_; croak "bad arguments to translate" if (!defined $y); push @{$$self{epsprefix}}, "$x $y translate"; return 1; } #------------------------------------------------------------------------------- =item C Clear all translate, rotate and scale operations. Example: $eps->reset(); =cut sub reset { my $self = shift; @{$$self{"epsprefix"}} = (); return 1; } #------------------------------------------------------------------------------- =item C Reads the EPS file into memory, to save reading it from file each time if inserted many times into a document. Can not be used with C. =cut sub load { my $self = shift; local *EPS; return 1 if (defined $$self{"epsfile"}); return 1 if (defined $$self{"source"}); $$self{"epsfile"} = "\%\%BeginDocument: ($$self{file})\n"; open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}"; while () { $$self{"epsfile"} .= $_; } close EPS; $$self{"epsfile"} .= "\%\%EndDocument\n"; return 1; } #------------------------------------------------------------------------------- =item C Experimental: defines the EPS at in the document prolog, and just runs a command to insert it each time it is used. C is a PostScript::Simple object. If the EPS file is included more than once in the PostScript file then this will probably shrink the filesize quite a lot. Can not be used at the same time as C, or when using EPS objects defined from PostScript source. Example: $p = new PostScript::Simple(); $e = new PostScript::Simple::EPS(file => "test.eps"); $e->preload($p); =cut sub preload { my $self = shift; my $ps = shift; my $randcode = ""; croak "already loaded" if (defined $$self{"epsfile"}); croak "can't preload when using source" if (defined $$self{"source"}); croak "no PostScript::Simple module provided" if (!defined $ps); for my $i (0..7) { $randcode .= chr(int(rand()*26)+65); # yuk } $$self{"epsfile"} = "eps$randcode\n"; $$ps{"psprolog"} .= "/eps$randcode {\n"; $$ps{"psprolog"} .= "\%\%BeginDocument: ($$self{file})\n"; open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}"; while () { $$ps{"psprolog"} .= $_; } close EPS; $$ps{"psprolog"} .= "\%\%EndDocument\n"; $$ps{"psprolog"} .= "} def\n"; return 1; } ################################################################################ # PRIVATE methods sub _getfilebbox { my $self = shift; my $foundbbx = 0; return 0 if (!defined $$self{file}); open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}"; SCAN: while () { s/[\r\n]*$//; #ultimate chomp if (/^\%\%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s*$/) { $$self{bbx1} = $1; $$self{bby1} = $2; $$self{bbx2} = $3; $$self{bby2} = $4; $foundbbx = 1; last SCAN; } } close EPS; return $foundbbx; } #------------------------------------------------------------------------------- sub _getsourcebbox { my $self = shift; my $ref; $ref = \$self->{epsfile} if defined $self->{epsfile}; $ref = \$self->{source} if defined $self->{source}; return 0 unless defined $$ref; if ($$ref =~ /^\%\%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)$/m) { $$self{bbx1} = $1; $$self{bby1} = $2; $$self{bbx2} = $3; $$self{bby2} = $4; return 1; } return 0; } #------------------------------------------------------------------------------- sub _get_include_data { my $self = shift; my ($x, $y) = @_; my $data = ""; croak "argh... internal error (incorrect arguments)" if (scalar @_ != 2); foreach my $line (@{$$self{"epsprefix"}}) { $data .= "$line\n"; } if ($$self{"clip"}) { $data .= "newpath $$self{bbx1} $$self{bby1} moveto $$self{bbx2} $$self{bby1} lineto $$self{bbx2} $$self{bby2} lineto $$self{bbx1} $$self{bby2} lineto closepath clip newpath\n"; } if (defined $$self{"epsfile"}) { $data .= $$self{"epsfile"}; } elsif (defined $$self{"source"}) { $data .= "\%\%BeginDocument: (undef)\n"; $data .= $$self{"source"}; $data .= "\%\%EndDocument\n"; } else { $data .= "\%\%BeginDocument: ($$self{file})\n"; open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}"; while () { $data .= $_; } close EPS; $data .= "\%\%EndDocument\n"; } foreach my $line (@{$$self{"epspostfix"}}) { $data .= "$line\n"; } return $data; } sub _error { my $self = shift; my $msg = shift; $self->{pspages} .= "(error: $msg\n) print flush\n"; } =back =head1 BUGS This is software in development; some current functionality may not be as expected, and/or may not work correctly. =head1 AUTHOR The PostScript::Simple::EPS module was written by Matthew Newton, after prods for such a feature from several people around the world. A useful importeps function that provides scaling and aspect ratio operations was gratefully received from Glen Harris, and merged into this module. Copyright (C) 2002-2014 Matthew C. Newton This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details, available at http://www.gnu.org/licenses/gpl.html. =head1 SEE ALSO L =cut 1; # vim:foldmethod=marker: PostScript-Simple-0.09/lib/PostScript/Simple.pm0000644000175000017500000015773512410400213017573 0ustar mcnmcn#! /usr/bin/perl -w package PostScript::Simple; use strict; use vars qw($VERSION @ISA @EXPORT); use Carp; use Exporter; use PostScript::Simple::EPS; @ISA = qw(Exporter); @EXPORT = qw(); $VERSION = '0.09'; #------------------------------------------------------------------------------- =head1 NAME PostScript::Simple - Produce PostScript files from Perl =head1 SYNOPSIS use PostScript::Simple; # create a new PostScript object $p = new PostScript::Simple(papersize => "A4", colour => 1, eps => 0, units => "in"); # create a new page $p->newpage; # draw some lines and other shapes $p->line(1,1, 1,4); $p->linextend(2,4); $p->box(1.5,1, 2,3.5); $p->circle(2,2, 1); $p->setlinewidth( 0.01 ); $p->curve(1,5, 1,7, 3,7, 3,5); $p->curvextend(3,3, 5,3, 5,5); # draw a rotated polygon in a different colour $p->setcolour(0,100,200); $p->polygon({rotate=>45}, 1,1, 1,2, 2,2, 2,1, 1,1); # add some text in red $p->setcolour("red"); $p->setfont("Times-Roman", 20); $p->text(1,1, "Hello"); # write the output to a file $p->output("file.ps"); =head1 DESCRIPTION PostScript::Simple allows you to have a simple method of writing PostScript files from Perl. It has graphics primitives that allow lines, curves, circles, polygons and boxes to be drawn. Text can be added to the page using standard PostScript fonts. The images can be single page EPS files, or multipage PostScript files. The image size can be set by using a recognised paper size ("C", for example) or by giving dimensions. The units used can be specified ("C" or "C", etc) and are the same as those used in TeX. The default unit is a bp, or a PostScript point, unlike TeX. =head1 PREREQUISITES This module requires C and C. =head2 EXPORT None. =cut #------------------------------------------------------------------------------- # Define some colour names my %pscolours = ( # Original colours from PostScript::Simple brightred => [255, 0, 0], brightgreen => [0, 255, 0], brightblue => [0, 0, 1], red => [204, 0, 0], green => [0, 204, 0], blue => [0, 0, 204], darkred => [127, 0, 0], darkgreen => [0, 127, 0], darkblue => [0, 0, 127], grey10 => [25, 25, 25], grey20 => [51, 51, 51], grey30 => [76, 76, 76], grey40 => [102, 102, 102], grey50 => [127, 127, 127], grey60 => [153, 153, 153], grey70 => [178, 178, 178], grey80 => [204, 204, 204], grey90 => [229, 229, 229], black => [0, 0, 0], white => [255, 255, 255], # X-Windows colours, unless they clash with the above (only /(dark)?(red|green|blue)/ ) aliceblue => [240, 248, 255], antiquewhite => [250, 235, 215], aqua => [0, 255, 255], aquamarine => [127, 255, 212], azure => [240, 255, 255], beige => [245, 245, 220], bisque => [255, 228, 196], blanchedalmond => [255, 255, 205], blueviolet => [138, 43, 226], brown => [165, 42, 42], burlywood => [222, 184, 135], cadetblue => [95, 158, 160], chartreuse => [127, 255, 0], chocolate => [210, 105, 30], coral => [255, 127, 80], cornflowerblue => [100, 149, 237], cornsilk => [255, 248, 220], crimson => [220, 20, 60], cyan => [0, 255, 255], darkcyan => [0, 139, 139], darkgoldenrod => [184, 134, 11], darkgray => [169, 169, 169], darkgrey => [169, 169, 169], darkkhaki => [189, 183, 107], darkmagenta => [139, 0, 139], darkolivegreen => [85, 107, 47], darkorange => [255, 140, 0], darkorchid => [153, 50, 204], darksalmon => [233, 150, 122], darkseagreen => [143, 188, 143], darkslateblue => [72, 61, 139], darkslategray => [47, 79, 79], darkslategrey => [47, 79, 79], darkturquoise => [0, 206, 209], darkviolet => [148, 0, 211], deeppink => [255, 20, 147], deepskyblue => [0, 191, 255], dimgray => [105, 105, 105], dimgrey => [105, 105, 105], dodgerblue => [30, 144, 255], firebrick => [178, 34, 34], floralwhite => [255, 250, 240], forestgreen => [34, 139, 34], fuchsia => [255, 0, 255], gainsboro => [220, 220, 220], ghostwhite => [248, 248, 255], gold => [255, 215, 0], goldenrod => [218, 165, 32], gray => [128, 128, 128], grey => [128, 128, 128], greenyellow => [173, 255, 47], honeydew => [240, 255, 240], hotpink => [255, 105, 180], indianred => [205, 92, 92], indigo => [75, 0, 130], ivory => [255, 240, 240], khaki => [240, 230, 140], lavender => [230, 230, 250], lavenderblush => [255, 240, 245], lawngreen => [124, 252, 0], lemonchiffon => [255, 250, 205], lightblue => [173, 216, 230], lightcoral => [240, 128, 128], lightcyan => [224, 255, 255], lightgoldenrodyellow => [250, 250, 210], lightgray => [211, 211, 211], lightgreen => [144, 238, 144], lightgrey => [211, 211, 211], lightpink => [255, 182, 193], lightsalmon => [255, 160, 122], lightseagreen => [32, 178, 170], lightskyblue => [135, 206, 250], lightslategray => [119, 136, 153], lightslategrey => [119, 136, 153], lightsteelblue => [176, 196, 222], lightyellow => [255, 255, 224], lime => [0, 255, 0], limegreen => [50, 205, 50], linen => [250, 240, 230], magenta => [255, 0, 255], maroon => [128, 0, 0], mediumaquamarine => [102, 205, 170], mediumblue => [0, 0, 205], mediumorchid => [186, 85, 211], mediumpurple => [147, 112, 219], mediumseagreen => [60, 179, 113], mediumslateblue => [123, 104, 238], mediumspringgreen => [0, 250, 154], mediumturquoise => [72, 209, 204], mediumvioletred => [199, 21, 133], midnightblue => [25, 25, 112], mintcream => [245, 255, 250], mistyrose => [255, 228, 225], moccasin => [255, 228, 181], navajowhite => [255, 222, 173], navy => [0, 0, 128], oldlace => [253, 245, 230], olive => [128, 128, 0], olivedrab => [107, 142, 35], orange => [255, 165, 0], orangered => [255, 69, 0], orchid => [218, 112, 214], palegoldenrod => [238, 232, 170], palegreen => [152, 251, 152], paleturquoise => [175, 238, 238], palevioletred => [219, 112, 147], papayawhip => [255, 239, 213], peachpuff => [255, 218, 185], peru => [205, 133, 63], pink => [255, 192, 203], plum => [221, 160, 221], powderblue => [176, 224, 230], purple => [128, 0, 128], rosybrown => [188, 143, 143], royalblue => [65, 105, 225], saddlebrown => [139, 69, 19], salmon => [250, 128, 114], sandybrown => [244, 164, 96], seagreen => [46, 139, 87], seashell => [255, 245, 238], sienna => [160, 82, 45], silver => [192, 192, 192], skyblue => [135, 206, 235], slateblue => [106, 90, 205], slategray => [112, 128, 144], slategrey => [112, 128, 144], snow => [255, 250, 250], springgreen => [0, 255, 127], steelblue => [70, 130, 180], tan => [210, 180, 140], teal => [0, 128, 128], thistle => [216, 191, 216], tomato => [253, 99, 71], turquoise => [64, 224, 208], violet => [238, 130, 238], wheat => [245, 222, 179], whitesmoke => [245, 245, 245], yellow => [255, 255, 0], yellowgreen => [154, 205, 50], ); # define page sizes here (a4, letter, etc) # should be Properly Cased my %pspaper = ( A0 => [2384, 3370], A1 => [1684, 2384], A2 => [1191, 1684], A3 => [841.88976, 1190.5512], A4 => [595.27559, 841.88976], A5 => [420.94488, 595.27559], A6 => [297, 420], A7 => [210, 297], A8 => [148, 210], A9 => [105, 148], B0 => [2920, 4127], B1 => [2064, 2920], B2 => [1460, 2064], B3 => [1032, 1460], B4 => [729, 1032], B5 => [516, 729], B6 => [363, 516], B7 => [258, 363], B8 => [181, 258], B9 => [127, 181 ], B10 => [91, 127], Executive => [522, 756], Folio => [595, 935], 'Half-Letter' => [612, 397], Letter => [612, 792], 'US-Letter' => [612, 792], Legal => [612, 1008], 'US-Legal' => [612, 1008], Tabloid => [792, 1224], 'SuperB' => [843, 1227], Ledger => [1224, 792], 'Comm #10 Envelope' => [297, 684], 'Envelope-Monarch' => [280, 542], 'Envelope-DL' => [312, 624], 'Envelope-C5' => [461, 648], 'EuroPostcard' => [298, 420], ); # The 13 standard fonts that are available on all PS 1 implementations: my @fonts = ( 'Courier', 'Courier-Bold', 'Courier-BoldOblique', 'Courier-Oblique', 'Helvetica', 'Helvetica-Bold', 'Helvetica-BoldOblique', 'Helvetica-Oblique', 'Times-Roman', 'Times-Bold', 'Times-BoldItalic', 'Times-Italic', 'Symbol'); # define the origins for the page a document can have # (default is "LeftBottom") my %psorigin = ( 'LeftBottom' => [ 0, 0], 'LeftTop' => [ 0, -1], 'RightBottom' => [-1, 0], 'RightTop' => [-1, -1], ); # define the co-ordinate direction (default is 'RightUp') my %psdirs = ( 'RightUp' => [ 1, 1], 'RightDown' => [ 1, -1], 'LeftUp' => [-1, 1], 'LeftDown' => [-1, -1], ); # measuring units are two-letter acronyms as used in TeX: # bp: postscript point (72 per inch) # in: inch (72 postscript points) # pt: printer's point (72.27 per inch) # mm: millimetre (25.4 per inch) # cm: centimetre (2.54 per inch) # pi: pica (12 printer's points) # dd: didot point (67.567. per inch) # cc: cicero (12 didot points) # set up the others here (sp) XXXXX my %psunits = ( pt => [72, 72.27], pc => [72, 6.0225], in => [72, 1], bp => [1, 1], cm => [72, 2.54], mm => [72, 25.4], dd => [72, 67.567], cc => [72, 810.804], ); #------------------------------------------------------------------------------- =head1 CONSTRUCTOR =over 4 =item C Create a new PostScript::Simple object. The different options that can be set are: =over 4 =item units Units that are to be used in the file. Common units would be C, C, C, C, and C. Others are as used in TeX. (Default: C) =item xsize Specifies the width of the drawing area in units. =item ysize Specifies the height of the drawing area in units. =item papersize The size of paper to use, if C or C are not defined. This allows a document to easily be created using a standard paper size without having to remember the size of paper using PostScript points. Valid choices are currently "C", "C", "C", and "C". =item landscape Use the landscape option to rotate the page by 90 degrees. The paper dimensions are also rotated, so that clipping will still work. (Note that the printer will still think that the paper is portrait.) (Default: 0) =item copies Set the number of copies that should be printed. (Default: 1) =item clip If set to 1, the image will be clipped to the xsize and ysize. This is most useful for an EPS image. (Default: 0) =item colour Specifies whether the image should be rendered in colour or not. If set to 0 (default) all requests for a colour are mapped to a greyscale. Otherwise the colour requested with C or C is used. This option is present because most modern laser printers are only black and white. (Default: 0) =item eps Generate an EPS file, rather than a standard PostScript file. If set to 1, no newpage methods will actually create a new page. This option is probably the most useful for generating images to be imported into other applications, such as TeX. (Default: 1) =item page Specifies the initial page number of the (multi page) document. The page number is set with the Adobe DSC comments, and is used nowhere else. It only makes finding your pages easier. See also the C method. (Default: 1) =item coordorigin Defines the co-ordinate origin for each page produced. Valid arguments are C, C, C and C. The default is C. =item direction The direction the co-ordinates go from the origin. Values can be C, C, C and C. The default value is C. =item reencode Requests that a font re-encode function be added and that the 13 standard PostScript fonts get re-encoded in the specified encoding. The most popular choice (other than undef) is 'ISOLatin1Encoding' which selects the iso8859-1 encoding and fits most of western Europe, including the Scandinavia. Refer to Adobes Postscript documentation for other encodings. The output file is, by default, re-encoded to ISOLatin1Encoding. To stop this happening, use 'reencode => undef'. To use the re-encoded font, '-iso' must be appended to the names of the fonts used, e.g. 'Helvetica-iso'. =back Example: $ref = new PostScript::Simple(landscape => 1, eps => 0, xsize => 4, ysize => 3, units => "in"); Create a document that is 4 by 3 inches and prints landscape on a page. It is not an EPS file, and must therefore use the C method. $ref = new PostScript::Simple(eps => 1, colour => 1, xsize => 12, ysize => 12, units => "cm", reencode => "ISOLatin1Encoding"); Create a 12 by 12 cm EPS image that is in colour. Note that "C 1>" did not have to be specified because this is the default. Re-encode the standard fonts into the iso8859-1 encoding, providing all the special characters used in Western Europe. The C method should not be used. =back =cut sub new { my ($class, %data) = @_; my $self = { xsize => undef, ysize => undef, papersize => undef, units => "bp", # measuring units (see below) landscape => 0, # rotate the page 90 degrees copies => 1, # number of copies colour => 0, # use colour clip => 0, # clip to the bounding box eps => 1, # create eps file page => 1, # page number to start at reencode => "ISOLatin1Encoding", # Re-encode the 13 standard # fonts in this encoding bbx1 => 0, # Bounding Box definitions bby1 => 0, bbx2 => 0, bby2 => 0, pscomments => "", # the following entries store data psprolog => "", # for the same DSC areas of the psresources => {}, # postscript file. pssetup => "", pspages => [], pstrailer => "", usedunits => {}, # units that have been used lastfontsize => 0, pspagecount => 0, coordorigin => 'LeftBottom', direction => 'RightUp', lasterror => undef, }; foreach (keys %data) { $self->{$_} = $data{$_}; } bless $self, $class; $self->init(); return $self; } #------------------------------------------------------------------------------- sub _u { my ($self, $u, $rev) = @_; my $val; my $unit; # $u may be... # a simple number, in which case the current units are used # a listref of [number, "unit"], to force the unit # a string "number unit", e.g. "4 mm" or "2.4in" if (ref($u) eq "ARRAY") { $val = $$u[0]; $unit = $$u[1]; confess "Invalid array" if @$u != 2; } else { if ($u =~ /^\s*(-?\d+(?:\.\d+)?)\s*([a-z][a-z])?\s*$/) { $val = $1; $unit = $2 || $self->{units}; } } confess "Cannot determine length" unless defined $val; confess "Cannot determine unit (invalid array?)" unless defined $unit; croak "Invalid unit '$unit'" unless defined $psunits{$unit}; unless (defined $self->{usedunits}{$unit}) { my ($m, $d) = @{$psunits{$unit}}; my $c = "{"; $c .= "$m mul " unless $m == 1; $c .= "$d div " unless $d == 1; $c =~ s/ $//; $c .="}"; $self->{usedunits}{$unit} = "/u$unit $c def"; } $val = $rev * $val if defined $rev; return "$val u$unit "; } sub _ux { my ($self, $d) = @_; return $self->_u($d, $psdirs{$self->{direction}}[0]); } sub _uy { my ($self, $d) = @_; return $self->_u($d, $psdirs{$self->{direction}}[1]); } sub _uxy { my ($self, $x, $y) = @_; return $self->_ux($x) . $self->_uy($y); } sub init { my $self = shift; my ($m, $d) = (1, 1); my ($u, $mm); # Create a blank "page" for EPS if ($self->{eps}) { $self->{currentpage} = []; $self->{pspages} = [$self->{currentpage}]; } # Units $self->{units} = lc $self->{units}; if (defined($psunits{$self->{units}})) { ($m, $d) = @{$psunits{$self->{units}}}; } else { $self->_error( "unit '$self->{units}' undefined" ); } # Paper size if (defined $self->{papersize}) { $self->{papersize} = ucfirst lc $self->{papersize}; } if (!defined $self->{xsize} || !defined $self->{ysize}) { if (defined $self->{papersize} && defined $pspaper{$self->{papersize}}) { ($self->{xsize}, $self->{ysize}) = @{$pspaper{$self->{papersize}}}; $self->{bbx2} = int($self->{xsize}); $self->{bby2} = int($self->{ysize}); $self->{pscomments} .= "\%\%DocumentMedia: $self->{papersize} $self->{xsize} "; $self->{pscomments} .= "$self->{ysize} 0 ( ) ( )\n"; } else { ($self->{xsize}, $self->{ysize}) = (100,100); $self->_error( "page size undefined" ); } } else { $self->{bbx2} = int(($self->{xsize} * $m) / $d); $self->{bby2} = int(($self->{ysize} * $m) / $d); } if (!$self->{eps}) { $self->{pssetup} .= "ll 2 ge { << /PageSize [ $self->{xsize} " . "$self->{ysize} ] /ImagingBBox null >>" . " setpagedevice } if\n"; } # Landscape if ($self->{landscape}) { my $swap; $self->{psresources}{landscape} = <<"EOP"; /landscape { $self->{bbx2} 0 translate 90 rotate } bind def EOP # I now think that Portrait is the correct thing here, as the page is # rotated. $self->{pscomments} .= "\%\%Orientation: Portrait\n"; # $self->{pscomments} .= "\%\%Orientation: Landscape\n"; $swap = $self->{bbx2}; $self->{bbx2} = $self->{bby2}; $self->{bby2} = $swap; # for EPS files, change to landscape here, as there are no pages if ($self->{eps}) { $self->{pssetup} .= "landscape\n" } } else { $self->{pscomments} .= "\%\%Orientation: Portrait\n"; } # Clipping if ($self->{clip}) { $self->{psresources}{pageclip} = <<"EOP"; /pageclip { newpath $self->{bbx1} $self->{bby1} moveto $self->{bbx1} $self->{bby2} lineto $self->{bbx2} $self->{bby2} lineto $self->{bbx2} $self->{bby1} lineto $self->{bbx1} $self->{bby1} lineto closepath clip } bind def EOP if ($self->{eps}) { $self->{pssetup} .= "pageclip\n" } } # Font reencoding if ($self->{reencode}) { my $encoding; # The name of the encoding my $ext; # The extention to tack onto the std fontnames if (ref $self->{reencode} eq 'ARRAY') { die "Custom reencoding of fonts not really implemented yet, sorry..."; $encoding = shift @{$self->{reencode}}; $ext = shift @{$self->{reencode}}; # TODO: Do something to add the actual encoding to the postscript code. } else { $encoding = $self->{reencode}; $ext = '-iso'; } $self->{psresources}{REENCODEFONT} = <<'EOP'; /STARTDIFFENC { mark } bind def /ENDDIFFENC { % /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC - counttomark 2 add -1 roll 256 array copy /TempEncode exch def % pointer for sequential encodings /EncodePointer 0 def { % Get the bottom object counttomark -1 roll % Is it a mark? dup type dup /marktype eq { % End of encoding pop pop exit } { /nametype eq { % Insert the name at EncodePointer % and increment the pointer. TempEncode EncodePointer 3 -1 roll put /EncodePointer EncodePointer 1 add def } { % Set the EncodePointer to the number /EncodePointer exch def } ifelse } ifelse } loop TempEncode def } bind def % Define ISO Latin1 encoding if it doesnt exist /ISOLatin1Encoding where { % (ISOLatin1 exists!) = pop } { (ISOLatin1 does not exist, creating...) = /ISOLatin1Encoding StandardEncoding STARTDIFFENC 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ENDDIFFENC } ifelse % Name: Re-encode Font % Description: Creates a new font using the named encoding. /REENCODEFONT { % /Newfont NewEncoding /Oldfont findfont dup length 4 add dict begin { % forall 1 index /FID ne 2 index /UniqueID ne and 2 index /XUID ne and { def } { pop pop } ifelse } forall /Encoding exch def % defs for DPS /BitmapWidths false def /ExactSize 0 def /InBetweenSize 0 def /TransformedChar 0 def currentdict end definefont pop } bind def % Reencode the std fonts: EOP for my $font (@fonts) { $self->{psresources}{REENCODEFONT} .= "/${font}$ext $encoding /$font REENCODEFONT\n"; } } } #------------------------------------------------------------------------------- =head1 OBJECT METHODS Unless otherwise specified, object methods return 1 for success or 0 in some error condition (e.g. insufficient arguments). Error message text is also drawn on the page. =over 4 =item C Generates a new page on a PostScript file. If specified, C gives the number (or name) of the page. This method should not be used for EPS files. The page number is automatically incremented each time this is called without a new page number, or decremented if the current page number is negative. Example: $p->newpage(1); $p->newpage; $p->newpage("hello"); $p->newpage(-6); $p->newpage; will generate five pages, numbered: 1, 2, "hello", -6, -7. =cut sub newpage { my $self = shift; my $nextpage = shift; if (defined($nextpage)) { $self->{page} = $nextpage; } if ($self->{eps}) { # Cannot have multiple pages in an EPS file $self->_error("Do not use newpage for eps files!"); return 0; } # close old page if required if ($self->{pspagecount} != 0) { $self->_closepage(); } # start new page $self->_openpage(); return 1; } sub _openpage { my $self = shift; my ($x, $y); $self->{pspagecount}++; $self->{currentpage} = []; push @{$self->{pspages}}, $self->{currentpage}; $self->_addtopage("\%\%Page: $self->{page} $self->{pspagecount}\n"); if ($self->{page} >= 0) { $self->{page} ++; } else { $self->{page} --; } $self->_addtopage("\%\%BeginPageSetup\n"); $self->_addtopage("/pagelevel save def\n"); if ($self->{landscape}) { $self->_addtopage("landscape\n"); } if ($self->{clip}) { $self->_addtopage("pageclip\n"); } ($x, $y) = @{$psorigin{$self->{coordorigin}}}; $x = $self->{xsize} if ($x < 0); $y = $self->{ysize} if ($y < 0); $self->_addtopage("$x $y translate\n") if (($x != 0) || ($y != 0)); $self->_addtopage("\%\%EndPageSetup\n"); } sub _closepage { my $self = shift; $self->_addtopage("\%\%PageTrailer\npagelevel restore\nshowpage\n"); } #------------------------------------------------------------------------------- =item C Writes the current PostScript out to the file named C. Will destroy any existing file of the same name. Use this method whenever output is required to disk. The current PostScript document in memory is not cleared, and can still be extended. =cut sub _builddocument { my $self = shift; my $title = shift; my $doc; my $date = scalar localtime; my $user; $title = 'undefined' unless $title; $doc = []; # getlogin is unimplemented on some systems eval { $user = getlogin; }; $user = 'Console' unless $user; # Comments Section push @$doc, "%!PS-Adobe-3.0"; push @$doc, " EPSF-1.2" if ($self->{eps}); push @$doc, "\n"; push @$doc, "\%\%Title: ($title)\n"; push @$doc, "\%\%LanguageLevel: 1\n"; push @$doc, "\%\%Creator: PostScript::Simple perl module version $VERSION\n"; push @$doc, "\%\%CreationDate: $date\n"; push @$doc, "\%\%For: $user\n"; push @$doc, \$self->{pscomments}; # push @$doc, "\%\%DocumentFonts: \n"; if ($self->{eps}) { push @$doc, "\%\%BoundingBox: $self->{bbx1} $self->{bby1} $self->{bbx2} $self->{bby2}\n"; } else { push @$doc, "\%\%Pages: $self->{pspagecount}\n"; } push @$doc, "\%\%EndComments\n"; # Prolog Section push @$doc, "\%\%BeginProlog\n"; push @$doc, "/ll 1 def systemdict /languagelevel known {\n"; push @$doc, "/ll languagelevel def } if\n"; push @$doc, \$self->{psprolog}; foreach my $fn (sort keys %{$self->{psresources}}) { push @$doc, "\%\%BeginResource: PostScript::Simple-$fn\n"; push @$doc, $self->{psresources}{$fn}; push @$doc, "\%\%EndResource\n"; } push @$doc, "\%\%EndProlog\n"; # Setup Section push @$doc, "\%\%BeginSetup\n"; foreach my $un (sort keys %{$self->{usedunits}}) { push @$doc, $self->{usedunits}{$un} . "\n"; } if ($self->{copies} > 1) { push @$doc, "/#copies " . $self->{copies} . " def\n"; } push @$doc, \$self->{pssetup}; push @$doc, "\%\%EndSetup\n"; # Pages if ((!$self->{eps}) && ($self->{pspagecount} > 0)) { $self->_closepage(); } foreach my $page (@{$self->{pspages}}) { push @$doc, $self->_buildpage($page); } # Trailer Section if (length($self->{pstrailer})) { push @$doc, "\%\%Trailer\n"; push @$doc, \$self->{pstrailer}; } push @$doc, "\%\%EOF\n"; return $doc; } sub _buildpage { my ($self, $page) = @_; my $data = ""; foreach my $statement (@$page) { $data .= $$statement[1]; } return $data; } #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sub output { my $self = shift; my $file = shift || die("Must supply a filename for output"); my $page; my $i; $page = _builddocument($self, $file); local *OUT; open(OUT, '>', $file) or die("Cannot write to file $file: $!"); foreach $i (@$page) { if (ref($i) eq "SCALAR") { print OUT $$i; } else { print OUT $i; } } close OUT; return 1; } #------------------------------------------------------------------------------- =item C Returns the current document. Use this method whenever output is required as a scalar. The current PostScript document in memory is not cleared, and can still be extended. =cut sub get { my $self = shift; my $page; my $i; my $doc; $page = _builddocument($self, "PostScript::Simple generated page"); $doc = ""; foreach $i (@$page) { if (ref($i) eq "SCALAR") { $doc .= $$i; } else { $doc .= $i; } } return $doc; } #------------------------------------------------------------------------------- =item C Returns the current document as a PostScript::Simple::EPS object. Only works if the current document is EPS. This method calls new PostScript::Simple::EPS with all the default options. To change these, call it yourself as below, rather than using this method. $eps = new PostScript::Simple::EPS(source => $ps->get); =cut sub geteps { my $self = shift; my $page; my $i; my $doc; my $eps; croak "document is not EPS" unless ($$self{eps} == 1); $eps = new PostScript::Simple::EPS(source => $self->get); return $eps; } #------------------------------------------------------------------------------- =item C Sets the new drawing colour to the RGB values specified in C, C and C. The values range from 0 to 255. Alternatively, a colour name may be specified. Those currently defined are listed at the top of the PostScript::Simple module in the C<%pscolours> hash and include the standard X-Windows colour names. Example: # set new colour to brown $p->setcolour(200,100,0); # set new colour to black $p->setcolour("black"); =cut sub setcolour { my $self = shift; my ($r, $g, $b) = @_; if ( @_ == 1 ) { $r = lc $r; if (defined $pscolours{$r}) { ($r, $g, $b) = @{$pscolours{$r}}; } else { $self->_error( "bad colour name '$r'" ); return 0; } } my $bad = 0; if (not defined $r) { $r = 'undef'; $bad = 1; } if (not defined $g) { $g = 'undef'; $bad = 1; } if (not defined $b) { $b = 'undef'; $bad = 1; } if ($bad) { $self->_error( "setcolour given invalid arguments: $r, $g, $b" ); return 0; } # make sure floats aren't too long, and means the tests pass when # using a system with long doubles enabled by default $r = 0 + sprintf("%0.5f", $r / 255); $g = 0 + sprintf("%0.5f", $g / 255); $b = 0 + sprintf("%0.5f", $b / 255); if ($self->{colour}) { $self->_addtopage("$r $g $b setrgbcolor\n"); } else { # Better colour->grey conversion than just 0.33 of each: $r = 0.3*$r + 0.59*$g + 0.11*$b; $r = 0 + sprintf("%0.5f", $r / 255); $self->_addtopage("$r setgray\n"); } return 1; } #------------------------------------------------------------------------------- =item C Sets the new drawing colour to the CMYK values specified in C, C, C. The values range from 0 to 1. Note that PostScript::Simple does not do any colour management, so the output colour (as also with C) may vary according to output device. Example: # set new colour to a shade of blue $p->setcmykcolour(0.1, 0.5, 0, 0.2); # set new colour to black $p->setcmykcolour(0, 0, 0, 1); # set new colour to a rich black $p->setcmykcolour(0.5, 0.5, 0.5, 1); =cut sub setcmykcolour { my $self = shift; my ($c, $m, $y, $k) = @_; if ( @_ != 4 ) { $self->_error( "setcmykcolour given incorrect number of arguments" ); return 0; } # Don't currently convert to grey if colour is not set. Patches welcome for # something that gives a reasonable approximation... $self->_addtopage("$c $m $y $k setcmykcolor\n"); return 1; } #------------------------------------------------------------------------------- =item C Sets the new line width to C units. Example: # draw a line 10mm long and 4mm wide $p = new PostScript::Simple(units => "mm"); $p->setlinewidth(4); $p->line(10,10, 20,10); =cut sub setlinewidth { my $self = shift; my $width = shift || do { $self->_error( "setlinewidth not given a width" ); return 0; }; $width = "0.4 bp" if $width eq "thin"; $self->_addtopage($self->_u($width) . "setlinewidth\n"); return 1; } #------------------------------------------------------------------------------- =item C Draws a line from the co-ordinates (x1,x2) to (x2,y2). If values are specified for C, C and C, then the colour is set before the line is drawn. Example: # set the colour to black $p->setcolour("black"); # draw a line in the current colour (black) $p->line(10,10, 10,20); # draw a line in red $p->line(20,10, 20,20, 255,0,0); # draw another line in red $p->line(30,10, 30,20); =cut sub line { my $self = shift; my ($x1, $y1, $x2, $y2, $r, $g, $b) = @_; if ((!$self->{pspagecount}) and (!$self->{eps})) { # Cannot draw on to non-page when not an eps file return 0; } if ( @_ == 7 ) { $self->setcolour($r, $g, $b); } elsif ( @_ != 4 ) { $self->_error( "wrong number of args for line" ); return 0; } $self->newpath; $self->moveto($x1, $y1); $self->_addtopage($self->_uxy($x2, $y2) . "lineto stroke\n"); return 1; } #------------------------------------------------------------------------------- =item C Assuming the previous command was C, C, C or C, extend that line to include another segment to the co-ordinates (x,y). Behaviour after any other method is unspecified. Example: $p->line(10,10, 10,20); $p->linextend(20,20); $p->linextend(20,10); $p->linextend(10,10); Notes The C method may be more appropriate. =cut sub linextend { my $self = shift; my ($x, $y) = @_; unless ( @_ == 2 ) { $self->_error( "wrong number of args for linextend" ); return 0; } my $out = $self->_uxy($x, $y) . "lineto stroke\n"; my $p = $self->{currentpage}; my $last = pop @$p; $last = $$last[1]; $last =~ s/eto stroke\n$/eto\n$out/; $self->_addtopage($last); # FIXMEFIXMEFIXME # perhaps we need something like $self->{_lastcommand} to know if operations # are valid, rather than using a regexp? return 1; } #------------------------------------------------------------------------------- =item C Draws an arc on the circle of radius C with centre (C,C). The arc starts at angle C and finishes at C. Angles are specified in degrees, where 0 is at 3 o'clock, and the direction of travel is anti-clockwise. Any options are passed in a hash reference as the first parameter. The available option is: =over 4 =item filled => 1 If C is 1 then the arc will be filled in. =back Example: # semi-circle $p->arc(10, 10, 5, 0, 180); # complete filled circle $p->arc({filled=>1}, 30, 30, 10, 0, 360); =cut sub arc { my $self = shift; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } if ((!$self->{pspagecount}) and (!$self->{eps})) { # Cannot draw on to non-page when not an eps file return 0; } my ($x, $y, $r, $sa, $ea) = @_; unless (@_ == 5) { $self->_error("arc: wrong number of arguments"); return 0; } $self->newpath; $self->_addtopage($self->_uxy($x, $y) . $self->_u($r) . "$sa $ea arc "); if ($opt{'filled'}) { $self->_addtopage("fill\n"); } else { $self->_addtopage("stroke\n"); } return 1; } #------------------------------------------------------------------------------- =item C The C method is multi-function, allowing many shapes to be created and manipulated. Polygon draws lines from (x1,y1) to (x2,y2) and then from (x2,y2) to (x3,y3) up to (xn-1,yn-1) to (xn,yn). Any options are passed in a hash reference as the first parameter. The available options are as follows: =over 4 =item rotate => angle =item rotate => [angle,x,y] Rotate the polygon by C degrees anti-clockwise. If x and y are specified then use the co-ordinate (x,y) as the centre of rotation, otherwise use the co-ordinate (x1,y1) from the main polygon. =item filled => 1 If C is 1 then the PostScript output is set to fill the object rather than just draw the lines. =item offset => [x,y] Displace the object by the vector (x,y). =back Example: # draw a square with lower left point at (10,10) $p->polygon(10,10, 10,20, 20,20, 20,10, 10,10); # draw a filled square with lower left point at (20,20) $p->polygon( {offset => [10,10], filled => 1}, 10,10, 10,20, 20,20, 20,10, 10,10); # draw a filled square with lower left point at (10,10) # rotated 45 degrees (about the point (10,10)) $p->polygon( {rotate => 45, filled => 1}, 10,10, 10,20, 20,20, 20,10, 10,10); =cut sub polygon { my $self = shift; my %opt = (); my ($xoffset, $yoffset) = (0,0); my ($rotate, $rotatex, $rotatey) = (0,0,0); if ($#_ < 3) { # cannot have polygon with just one point... $self->_error( "bad polygon - not enough points" ); return 0; } if (ref($_[0])) { %opt = %{; shift}; } my $x = shift; my $y = shift; if (defined $opt{'rotate'}) { if (ref($opt{'rotate'})) { ($rotate, $rotatex, $rotatey) = @{$opt{'rotate'}}; } else { ($rotate, $rotatex, $rotatey) = ($opt{'rotate'}, $x, $y); } } if (defined $opt{'offset'}) { if (ref($opt{'offset'})) { ($xoffset, $yoffset) = @{$opt{'offset'}}; } else { $self->_error("polygon: bad offset option" ); return 0; } } if (!defined $opt{'filled'}) { $opt{'filled'} = 0; } unless (defined($x) && defined($y)) { $self->_error("polygon: no start point"); return 0; } my $savestate = ($xoffset || $yoffset || $rotate) ? 1 : 0 ; if ( $savestate ) { $self->_addtopage("gsave "); } if ($xoffset || $yoffset) { $self->_addtopage($self->_uxy($xoffset, $yoffset) . "translate\n"); } if ($rotate) { unless (defined $self->{psresources}{rotabout}) { $self->{psresources}{rotabout} = <<'EOP'; /rotabout { 3 copy pop translate rotate exch 0 exch sub exch 0 exch sub translate } def EOP } $self->_addtopage($self->_uxy($rotatex, $rotatey) . "$rotate rotabout\n"); } $self->newpath; $self->moveto($x, $y); while ($#_ > 0) { my $x = shift; my $y = shift; $self->_addtopage($self->_uxy($x, $y) . "lineto "); } if ($opt{'filled'}) { $self->_addtopage("fill\n"); } else { $self->_addtopage("stroke\n"); } if ( $savestate ) { $self->_addtopage("grestore\n"); } return 1; } #------------------------------------------------------------------------------- =item C Plot a circle with centre at (x,y) and radius of r. There is only one option. =over 4 =item filled => 1 If C is 1 then the PostScript output is set to fill the object rather than just draw the lines. =back Example: $p->circle(40,40, 20); $p->circle( {filled => 1}, 62,31, 15); =cut sub circle { my $self = shift; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } my ($x, $y, $r) = @_; unless (@_ == 3) { $self->_error("circle: wrong number of arguments"); return 0; } unless (defined $self->{psresources}{circle}) { $self->{psresources}{circle} = "/circle {newpath 0 360 arc closepath} bind def\n"; } $self->_addtopage($self->_uxy($x, $y) . $self->_u($r) . "circle "); if ($opt{'filled'}) { $self->_addtopage("fill\n"); } else { $self->_addtopage("stroke\n"); } return 1; } #------------------------------------------------------------------------------- =item C Draw text in an arc centered about angle C with circle midpoint (C,C) and radius C. There is only one option. =over 4 =item align => "alignment" C can be 'inside' or 'outside'. The default is 'inside'. =back Example: # outside the radius, centered at 90 degrees from the origin $p->circletext(40, 40, 20, 90, "Hello, Outside World!"); # inside the radius centered at 270 degrees from the origin $p->circletext( {align => "inside"}, 40, 40, 20, 270, "Hello, Inside World!"); =cut sub circletext { my $self = shift; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } my ($x, $y, $r, $a, $text) = @_; unless (@_ == 5) { $self->_error("circletext: wrong number of arguments"); return 0; } unless (defined $self->{lastfontsize}) { $self->_error("circletext: must set font first"); return 0; } unless (defined $self->{psresources}{circletext}) { $self->{psresources}{circletext} = <<'EOP'; /outsidecircletext { $circtextdict begin /radius exch def /centerangle exch def /ptsize exch def /str exch def /xradius radius ptsize 4 div add def gsave centerangle str findhalfangle add rotate str { /charcode exch def ( ) dup 0 charcode put outsideshowcharandrotate } forall grestore end } def /insidecircletext { $circtextdict begin /radius exch def /centerangle exch def /ptsize exch def /str exch def /xradius radius ptsize 3 div sub def gsave centerangle str findhalfangle sub rotate str { /charcode exch def ( ) dup 0 charcode put insideshowcharandrotate } forall grestore end } def /$circtextdict 16 dict def $circtextdict begin /findhalfangle { stringwidth pop 2 div 2 xradius mul pi mul div 360 mul } def /outsideshowcharandrotate { /char exch def /halfangle char findhalfangle def gsave halfangle neg rotate radius 0 translate -90 rotate char stringwidth pop 2 div neg 0 moveto char show grestore halfangle 2 mul neg rotate } def /insideshowcharandrotate { /char exch def /halfangle char findhalfangle def gsave halfangle rotate radius 0 translate 90 rotate char stringwidth pop 2 div neg 0 moveto char show grestore halfangle 2 mul rotate } def /pi 3.1415926 def end EOP } $self->_addtopage("gsave\n"); $self->_addtopage(" " . $self->_uxy($x, $y) . "translate\n"); $self->_addtopage(" ($text) $self->{lastfontsize} $a " . $self->_u($r)); if ($opt{'align'} && ($opt{'align'} eq "outside")) { $self->_addtopage("outsidecircletext\n"); } else { $self->_addtopage("insidecircletext\n"); } $self->_addtopage("grestore\n"); return 1; } #------------------------------------------------------------------------------- =item C Draw a rectangle from lower left co-ordinates (x1,y1) to upper right co-ordinates (y1,y2). Options are: =over 4 =item filled => 1 If C is 1 then fill the rectangle. =back Example: $p->box(10,10, 20,30); $p->box( {filled => 1}, 10,10, 20,30); Notes The C method is far more flexible, but this method is quicker! =cut sub box { my $self = shift; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } my ($x1, $y1, $x2, $y2) = @_; unless (@_ == 4) { $self->_error("box: wrong number of arguments"); return 0; } if (!defined($opt{'filled'})) { $opt{'filled'} = 0; } unless (defined $self->{psresources}{box}) { $self->{psresources}{box} = <<'EOP'; /box { newpath 3 copy pop exch 4 copy pop pop 8 copy pop pop pop pop exch pop exch 3 copy pop pop exch moveto lineto lineto lineto pop pop pop pop closepath } bind def EOP } $self->_addtopage($self->_uxy($x1, $y1)); $self->_addtopage($self->_uxy($x2, $y2) . "box "); if ($opt{'filled'}) { $self->_addtopage("fill\n"); } else { $self->_addtopage("stroke\n"); } return 1; } #------------------------------------------------------------------------------- =item C Set the current font to the PostScript font C. Set the size in PostScript points to C. Notes This method must be called on every page before the C method is used. =cut sub setfont { my $self = shift; my ($name, $size, $ysize) = @_; unless (@_ == 2) { $self->_error( "wrong number of arguments for setfont" ); return 0; } # set font y size XXXXX $self->_addtopage("/$name findfont $size scalefont setfont\n"); $self->{lastfontsize} = $size; return 1; } #------------------------------------------------------------------------------- =item C Plot text on the current page with the lower left co-ordinates at (x,y) and using the current font. The text is specified in C. Options are: =over 4 =item align => "alignment" alignment can be 'left', 'centre' or 'right'. The default is 'left'. =item rotate => angle "rotate" degrees of rotation, defaults to 0 (i.e. no rotation). The angle to rotate the text, in degrees. Centres about (x,y) and rotates clockwise. (?). Default 0 degrees. =back Example: $p->setfont("Times-Roman", 12); $p->text(40,40, "The frog sat on the leaf in the pond."); $p->text( {align => 'centre'}, 140,40, "This is centered."); $p->text( {rotate => 90}, 140,40, "This is rotated."); $p->text( {rotate => 90, align => 'centre'}, 140,40, "This is both."); =cut sub text { my $self = shift; my $rot = ""; my $rot_m = ""; my $align = ""; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } unless ( @_ == 3 ) { # check required params first $self->_error("text: wrong number of arguments"); return 0; } my ($x, $y, $text) = @_; unless (defined($x) && defined($y) && defined($text)) { $self->_error("text: wrong number of arguments"); return 0; } # Escape text to allow parentheses $text =~ s|([\\\(\)])|\\$1|g; $text =~ s/([\x00-\x1f\x7f-\xff])/sprintf('\\%03o',ord($1))/ge; $self->newpath; $self->moveto($x, $y); # rotation if (defined $opt{'rotate'}) { my $rot_a = $opt{ 'rotate' }; if( $rot_a != 0 ) { $rot = " $rot_a rotate "; $rot_a = -$rot_a; $rot_m = " $rot_a rotate "; }; } # alignment $align = " show stroke"; if (defined $opt{'align'}) { $align = " dup stringwidth pop neg 0 rmoveto show" if $opt{ 'align' } eq 'right'; $align = " dup stringwidth pop 2 div neg 0 rmoveto show" if $opt{ 'align' } eq 'center' or $opt{ 'align' } eq 'centre'; } $self->_addtopage("($text) $rot $align $rot_m\n"); return 1; } #------------------------------------------------------------------------------- =item curve( x1, y1, x2, y2, x3, y3, x4, y4 ) Create a curve from (x1, y1) to (x4, y4). (x2, y2) and (x3, y3) are the control points for the start- and end-points respectively. =cut sub curve { my $self = shift; my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @_; unless ( @_ == 8 ) { $self->_error( "bad curve definition, wrong number of args" ); return 0; } if ((!$self->{pspagecount}) and (!$self->{eps})) { # Cannot draw on to non-page when not an eps file return 0; } $self->newpath; $self->moveto($x1, $y1); $self->_addtopage($self->_uxy($x2, $y2)); $self->_addtopage($self->_uxy($x3, $y3)); $self->_addtopage($self->_uxy($x4, $y4) . "curveto stroke\n"); return 1; } #------------------------------------------------------------------------------- =item curvextend( x1, y1, x2, y2, x3, y3 ) Assuming the previous command was C, C, C or C, extend that path with another curve segment to the co-ordinates (x3, y3). (x1, y1) and (x2, y2) are the control points. Behaviour after any other method is unspecified. =cut sub curvextend { my $self = shift; my ($x1, $y1, $x2, $y2, $x3, $y3) = @_; unless ( @_ == 6 ) { $self->_error( "bad curvextend definition, wrong number of args" ); return 0; } my $out = $self->_uxy($x1, $y1); $out .= $self->_uxy($x2, $y2); $out .= $self->_uxy($x3, $y3) . "curveto stroke\n"; # FIXMEFIXMEFIXME # curveto may follow a lineto etc... my $p = $self->{currentpage}; my $last = pop @$p; $last = $$last[1]; $last =~ s/eto stroke\n$/eto\n$out/; $self->_addtopage($last); return 1; } #------------------------------------------------------------------------------- =item newpath This method is used internally to begin a new drawing path - you should generally NEVER use it. =cut sub newpath { my $self = shift; $self->_addtopage("newpath\n"); return 1; } #------------------------------------------------------------------------------- =item moveto( x, y ) This method is used internally to move the cursor to a new point at (x, y) - you will generally NEVER use this method. =cut sub moveto { my $self = shift; my ($x, $y) = @_; $self->_addtopage($self->_uxy($x, $y) . "moveto\n"); return 1; } #------------------------------------------------------------------------------- =item C Imports an EPS file and scales/translates its bounding box to fill the area defined by lower left co-ordinates (x1,y1) and upper right co-ordinates (x2,y2). By default, if the co-ordinates have a different aspect ratio from the bounding box, the scaling is constrained on the greater dimension to keep the EPS fully inside the area. Options are: =over 4 =item overlap => 1 If C is 1 then the scaling is calculated on the lesser dimension and the EPS can overlap the area. =item stretch => 1 If C is 1 then fill the entire area, ignoring the aspect ratio. This option overrides C if both are given. =back Example: # Assume smiley.eps is a round smiley face in a square bounding box # Scale it to a (10,10)(20,20) box $p->importepsfile("smiley.eps", 10,10, 20,20); # Keeps aspect ratio, constrained to smallest fit $p->importepsfile("smiley.eps", 10,10, 30,20); # Keeps aspect ratio, allowed to overlap for largest fit $p->importepsfile( {overlap => 1}, "smiley.eps", 10,10, 30,20); # Aspect ratio is changed to give exact fit $p->importepsfile( {stretch => 1}, "smiley.eps", 10,10, 30,20); =cut sub importepsfile { my $self = shift; my $bbllx; my $bblly; my $bburx; my $bbury; my $bbw; my $bbh; my $pagew; my $pageh; my $scalex; my $scaley; my $line; my $eps; my %opt = (); if (ref($_[0])) { %opt = %{; shift}; } my ($file, $x1, $y1, $x2, $y2) = @_; unless (@_ == 5) { $self->_error("importepsfile: wrong number of arguments"); return 0; } $opt{'overlap'} = 0 if (!defined($opt{'overlap'})); $opt{'stretch'} = 0 if (!defined($opt{'stretch'})); $eps = new PostScript::Simple::EPS(file => $file); ($bbllx, $bblly, $bburx, $bbury) = $eps->get_bbox(); $pagew = $x2 - $x1; $pageh = $y2 - $y1; $bbw = $bburx - $bbllx; $bbh = $bbury - $bblly; if (($bbw == 0) || ($bbh == 0)) { $self->_error("importeps: Bounding Box has zero dimension"); return 0; } $scalex = $pagew / $bbw; $scaley = $pageh / $bbh; if ($opt{'stretch'} == 0) { if ($opt{'overlap'} == 0) { if ($scalex > $scaley) { $scalex = $scaley; } else { $scaley = $scalex; } } else { if ($scalex > $scaley) { $scaley = $scalex; } else { $scalex = $scaley; } } } $eps->scale($scalex, $scaley); $eps->translate(-$bbllx, -$bblly); $self->_add_eps($eps, $x1, $y1); return 1; } #------------------------------------------------------------------------------- =item C Imports a PostScript::Simple::EPS object into the current document at position C<(x,y)>. Example: use PostScript::Simple; # create a new PostScript object $p = new PostScript::Simple(papersize => "A4", colour => 1, units => "in"); # create a new page $p->newpage; # create an eps object $e = new PostScript::Simple::EPS(file => "test.eps"); $e->rotate(90); $e->scale(0.5); # add eps to the current page $p->importeps($e, 10,50); =cut sub importeps { my $self = shift; my ($epsobj, $xpos, $ypos) = @_; unless (@_ == 3) { $self->_error("importeps: wrong number of arguments"); return 0; } $self->_add_eps($epsobj, $xpos, $ypos); return 1; } #------------------------------------------------------------------------------- =item C Returns the last error generated. Example: unless ($ps->setcolour("purplewithyellowspots")) { print $ps->err(); } # prints "bad colour name 'purplewithyellowspots'"; =cut sub err { my $self = shift; return $self->{lasterror}; } ################################################################################ # PRIVATE methods sub _addtopage { my ($self, $data) = @_; if (defined $self->{currentpage}) { push @{$self->{currentpage}}, ["ps", $data]; } else { confess "internal page error"; } } #------------------------------------------------------------------------------- sub _add_eps { my $self = shift; my $epsobj; my $xpos; my $ypos; if (ref($_[0]) ne "PostScript::Simple::EPS") { croak "internal error: _add_eps[0] must be eps object"; } if ((!$self->{pspagecount}) and (!$self->{eps})) { # Cannot draw on to non-page when not an eps file $self->_error("importeps: no current page"); return 0; } if ( @_ != 3 ) { croak "internal error: wrong number of arguments for _add_eps"; return 0; } unless (defined $self->{psresources}{importeps}) { $self->{psresources}{importeps} = <<'EOP'; /BeginEPSF { /b4_Inc_state save def /dict_count countdictstack def /op_count count 1 sub def userdict begin /showpage { } def 0 setgray 0 setlinecap 1 setlinewidth 0 setlinejoin 10 setmiterlimit [ ] 0 setdash newpath /languagelevel where { pop languagelevel 1 ne { false setstrokeadjust false setoverprint } if } if } bind def /EndEPSF { count op_count sub {pop} repeat countdictstack dict_count sub {end} repeat b4_Inc_state restore } bind def EOP } ($epsobj, $xpos, $ypos) = @_; my $eps = "BeginEPSF\n"; $eps .= $self->_uxy($xpos, $ypos) . "translate\n"; $eps .= $self->_uxy(1, 1) . "scale\n"; $eps .= $epsobj->_get_include_data($xpos, $ypos); $eps .= "EndEPSF\n"; $self->_addtopage($eps); return 1; } #------------------------------------------------------------------------------- sub _error { my $self = shift; my $msg = shift; $self->{lasterror} = $msg; $self->_addtopage("(error: $msg\n) print flush\n"); } #------------------------------------------------------------------------------- # Display method for debugging internal variables # #sub display { # my $self = shift; # my $i; # # foreach $i (keys(%{$self})) # { # print "$i = $self->{$i}\n"; # } #} =back =head1 BUGS Some current functionality may not be as expected, and/or may not work correctly. That's the fun with using code in development! =head1 AUTHOR The PostScript::Simple module was created by Matthew Newton, with ideas and suggestions from Mark Withall and many other people from around the world. Thanks! Please see the README file in the distribution for more information about contributors. Copyright (C) 2002-2014 Matthew C. Newton This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details, available at http://www.gnu.org/licenses/gpl.html. =head1 SEE ALSO L =cut 1; # vim:foldmethod=marker: PostScript-Simple-0.09/Changes0000644000175000017500000000613512410400011014376 0ustar mcnmcnRevision history for Perl extension PostScript::Simple. 0.09 - 23 September 2014 Matthew Newton: - add setcmykcolour method - add err method to find last error - internal data structure updates 0.08 - 20 June 2014 Satoshi Azuma: - remove Test::More module and make it a build dependency Matthew Newton: - fix test result failures on -Duselongdouble - allow units to be specified for any distance - add X-Windows colours, supplied by Steve Baldwin - change all space-separated lists to arrays - fix Begin/EndDocument handling in EPS file insertion 0.07 - 13 January 2006 Matthew Newton: - fix lack of newpath in arc 0.06 - 24 June 2004 Matthew Newton: - minor documentation changes 0.06p4 - 1 April 2004 Matthew Newton: - added /ll languagelevel check - added setpagedevice for languagelevel >= 2 0.06p3 - 29 March 2004 Matthew Newton: - added geteps method - added source argument to PostScript::Simple::EPS constructor - added width() and height() to PostScript::Simple::EPS - corrected some minor documentation errors 0.06p2 - 16 March 2004 Matthew Newton: - added get method 0.06p1 - 8 November 2003 Eric Wilhelm: - arc function Matthew Newton: - update/add some pod documentation - added PostScript::Simple::EPS module - tidy Changes file Glen Harris: - circletext function - useful code for eps addition 0.05 - 22 January 2003 Matthew Newton: - fold all functions in the code to make it easier to read - tidy up options to many functions (and probably break lots of stuff---sorry) Mark Withall - fix error with number of pages in eps files Vladi Belperchinov-Shabanski - add text rotation - modify interface to text alignment Martin McCarthy - curvextend typos - lots of other stuff that will hopefully make it into a different module Michael Tomuschat - page origin - co-ordinate direction 0.04 - 19 February 2002 Matthew Newton: - correct the definitions for dd and cc (I hope - still untested) - tidy up the code a bit - update the test suite Flemming Frandsen: - font encoding - text alignment - getlogin bugfix 0.03 - 17 January 2002 Matthew Newton: - Moved example.pl to a subdirectory so it doesn't get installed - PostScript header now includes version of PostScript::Simple - added dd and cc to the list of measurements, but they might not be correct P Kent: - Generate many tests in t/ - Simple.pm moved to lib/PostScript/Simple.pm to make life easier - moveto and newpath given new methods - curve and curvextend created for generating Bezier curves - all functions now return 1 for OK or 0 for fail - errors are written as () print flush in the PS output - many paper sizes added - other small tweaks 0.02 - 12 January 2002 Matthew Newton: - Fixed module to now use MakeMaker, i.e. perl Makefile.PL; make; make install now works. - Updated some documentation errors 0.01 - 11 January 2002 - original version; created by h2xs 1.21 with options -X -n PostScript::Simple