#!/usr/bin/perl -w # TODO: # ! (fill|stroke) should go -> proc_x fill # ! --set=key:val to insert postscript code. # ? color arguments should go -> COLOR set_clr # - center text. # - add some of the cookbook examples: arrows, text along a path # - accumulate shapes over multiple methods; # seemingly impossible with gsave though. # - method for smooth paths by control points ON THE PATH (uh oh) # - control dot size. # - method for grids # - method for specifying box by its center # -> recompute coordinates to fit x y dx dy system. # - polygon: specify by array of coordinates use Getopt::Long; use strict; my $help = 0; my $list = ""; my $rand = 0; my $double_up = 0; my @ARGV_COPY = @ARGV; my $n_args = @ARGV; $::debug = 0; $::test = 0; my $foo = ''; %::CONF = ( LLX => 20 , LLY => 20 , URX => 550 , URY => 800 ) ; my %FONTS = ( 'AvantGarde-Book' => 1 , 'AvantGarde-BookOblique' => 1 , 'AvantGarde-Demi' => 1 , 'AvantGarde-DemiOblique' => 1 , 'Bookman-Demi' => 1 , 'Bookman-DemiItalic' => 1 , 'Bookman-Light' => 1 , 'Bookman-LightItalic' => 1 , 'Courier' => 1 , 'Courier-Bold' => 1 , 'Courier-BoldOblique' => 1 , 'Courier-Oblique' => 1 , 'Helvetica' => 1 , 'Helvetica-Bold' => 1 , 'Helvetica-BoldOblique' => 1 , 'Helvetica-Narrow' => 1 , 'Helvetica-Narrow-Bold' => 1 , 'Helvetica-Narrow-BoldOblique' => 1 , 'Helvetica-Narrow-Oblique' => 1 , 'Helvetica-Oblique' => 1 , 'NewCenturySchlbk-Bold' => 1 , 'NewCenturySchlbk-BoldItalic' => 1 , 'NewCenturySchlbk-Italic' => 1 , 'NewCenturySchlbk-Roman' => 1 , 'Palatino-Bold' => 1 , 'Palatino-BoldItalic' => 1 , 'Palatino-Italic' => 1 , 'Palatino-Roman' => 1 , 'Times-Bold' => 1 , 'Times-BoldItalic' => 1 , 'Times-Italic' => 1 , 'Times-Roman' => 1 ) ; # Created from HTML rgb hex strings: # perl -na -e 'local $" = " "; BEGIN { sub cv { return hex($_[0])/256 } } local # $" = " "; @x = map { sprintf "%.2f", cv(substr($F[1], 2*$_, 2)) } (0,1,2); # printf "%-40s[@x] def\n", $F[0];' colours my %COLORS = ( AliceBlue => '[0.94 0.97 1.00]' , AntiqueWhite => '[0.98 0.92 0.84]' , Aqua => '[0.00 1.00 1.00]' , Aquamarine => '[0.50 1.00 0.83]' , Azure => '[0.94 1.00 1.00]' , Beige => '[0.96 0.96 0.86]' , Bisque => '[1.00 0.89 0.77]' , Black => '[0.00 0.00 0.00]' , BlanchedAlmond => '[1.00 0.92 0.80]' , Blue => '[0.00 0.00 1.00]' , BlueViolet => '[0.54 0.17 0.88]' , Brown => '[0.64 0.16 0.16]' , BurlyWood => '[0.87 0.72 0.53]' , CadetBlue => '[0.37 0.62 0.62]' , Chartreuse => '[0.50 1.00 0.00]' , Chocolate => '[0.82 0.41 0.12]' , Coral => '[1.00 0.50 0.31]' , CornflowerBlue => '[0.39 0.58 0.93]' , Cornsilk => '[1.00 0.97 0.86]' , Crimson => '[0.86 0.08 0.23]' , Cyan => '[0.00 1.00 1.00]' , DarkBlue => '[0.00 0.00 0.54]' , DarkCyan => '[0.00 0.54 0.54]' , DarkGoldenRod => '[0.72 0.52 0.04]' , DarkGray => '[0.66 0.66 0.66]' , DarkGreen => '[0.00 0.39 0.00]' , DarkKhaki => '[0.74 0.71 0.42]' , DarkMagenta => '[0.54 0.00 0.54]' , DarkOliveGreen => '[0.33 0.42 0.18]' , Darkorange => '[1.00 0.55 0.00]' , DarkOrchid => '[0.60 0.20 0.80]' , DarkRed => '[0.54 0.00 0.00]' , DarkSalmon => '[0.91 0.59 0.48]' , DarkSeaGreen => '[0.56 0.73 0.56]' , DarkSlateBlue => '[0.28 0.24 0.54]' , DarkSlateGray => '[0.18 0.31 0.31]' , DarkTurquoise => '[0.00 0.80 0.82]' , DarkViolet => '[0.58 0.00 0.82]' , DeepPink => '[1.00 0.08 0.57]' , DeepSkyBlue => '[0.00 0.75 1.00]' , DimGray => '[0.41 0.41 0.41]' , DodgerBlue => '[0.12 0.56 1.00]' , Feldspar => '[0.82 0.57 0.46]' , FireBrick => '[0.70 0.13 0.13]' , FloralWhite => '[1.00 0.98 0.94]' , ForestGreen => '[0.13 0.54 0.13]' , Fuchsia => '[1.00 0.00 1.00]' , Gainsboro => '[0.86 0.86 0.86]' , GhostWhite => '[0.97 0.97 1.00]' , Gold => '[1.00 0.84 0.00]' , GoldenRod => '[0.85 0.64 0.12]' , Gray => '[0.50 0.50 0.50]' , Green => '[0.00 0.50 0.00]' , GreenYellow => '[0.68 1.00 0.18]' , HoneyDew => '[0.94 1.00 0.94]' , HotPink => '[1.00 0.41 0.70]' , IndianRed => '[0.80 0.36 0.36]' , Indigo => '[0.29 0.00 0.51]' , Ivory => '[1.00 1.00 0.94]' , Khaki => '[0.94 0.90 0.55]' , Lavender => '[0.90 0.90 0.98]' , LavenderBlush => '[1.00 0.94 0.96]' , LawnGreen => '[0.48 0.98 0.00]' , LemonChiffon => '[1.00 0.98 0.80]' , LightBlue => '[0.68 0.84 0.90]' , LightCoral => '[0.94 0.50 0.50]' , LightCyan => '[0.88 1.00 1.00]' , LightGoldenRodYellow => '[0.98 0.98 0.82]' , LightGrey => '[0.82 0.82 0.82]' , LightGreen => '[0.56 0.93 0.56]' , LightPink => '[1.00 0.71 0.75]' , LightSalmon => '[1.00 0.62 0.48]' , LightSeaGreen => '[0.12 0.70 0.66]' , LightSkyBlue => '[0.53 0.80 0.98]' , LightSlateBlue => '[0.52 0.44 1.00]' , LightSlateGray => '[0.46 0.53 0.60]' , LightSteelBlue => '[0.69 0.77 0.87]' , LightYellow => '[1.00 1.00 0.88]' , Lime => '[0.00 1.00 0.00]' , LimeGreen => '[0.20 0.80 0.20]' , Linen => '[0.98 0.94 0.90]' , Magenta => '[1.00 0.00 1.00]' , Maroon => '[0.50 0.00 0.00]' , MediumAquaMarine => '[0.40 0.80 0.66]' , MediumBlue => '[0.00 0.00 0.80]' , MediumOrchid => '[0.73 0.33 0.82]' , MediumPurple => '[0.57 0.44 0.84]' , MediumSeaGreen => '[0.23 0.70 0.44]' , MediumSlateBlue => '[0.48 0.41 0.93]' , MediumSpringGreen => '[0.00 0.98 0.60]' , MediumTurquoise => '[0.28 0.82 0.80]' , MediumVioletRed => '[0.78 0.08 0.52]' , MidnightBlue => '[0.10 0.10 0.44]' , MintCream => '[0.96 1.00 0.98]' , MistyRose => '[1.00 0.89 0.88]' , Moccasin => '[1.00 0.89 0.71]' , NavajoWhite => '[1.00 0.87 0.68]' , Navy => '[0.00 0.00 0.50]' , OldLace => '[0.99 0.96 0.90]' , Olive => '[0.50 0.50 0.00]' , OliveDrab => '[0.42 0.55 0.14]' , Orange => '[1.00 0.64 0.00]' , OrangeRed => '[1.00 0.27 0.00]' , Orchid => '[0.85 0.44 0.84]' , PaleGoldenRod => '[0.93 0.91 0.66]' , PaleGreen => '[0.59 0.98 0.59]' , PaleTurquoise => '[0.68 0.93 0.93]' , PaleVioletRed => '[0.84 0.44 0.57]' , PapayaWhip => '[1.00 0.93 0.83]' , PeachPuff => '[1.00 0.85 0.72]' , Peru => '[0.80 0.52 0.25]' , Pink => '[1.00 0.75 0.79]' , Plum => '[0.86 0.62 0.86]' , PowderBlue => '[0.69 0.88 0.90]' , Purple => '[0.50 0.00 0.50]' , Red => '[1.00 0.00 0.00]' , RosyBrown => '[0.73 0.56 0.56]' , RoyalBlue => '[0.25 0.41 0.88]' , SaddleBrown => '[0.54 0.27 0.07]' , Salmon => '[0.98 0.50 0.45]' , SandyBrown => '[0.95 0.64 0.38]' , SeaGreen => '[0.18 0.54 0.34]' , SeaShell => '[1.00 0.96 0.93]' , Sienna => '[0.62 0.32 0.18]' , Silver => '[0.75 0.75 0.75]' , SkyBlue => '[0.53 0.80 0.92]' , SlateBlue => '[0.41 0.35 0.80]' , SlateGray => '[0.44 0.50 0.56]' , Snow => '[1.00 0.98 0.98]' , SpringGreen => '[0.00 1.00 0.50]' , SteelBlue => '[0.27 0.51 0.70]' , Tan => '[0.82 0.70 0.55]' , Teal => '[0.00 0.50 0.50]' , Thistle => '[0.84 0.75 0.84]' , Tomato => '[1.00 0.39 0.28]' , Turquoise => '[0.25 0.88 0.81]' , Violet => '[0.93 0.51 0.93]' , VioletRed => '[0.81 0.12 0.56]' , Wheat => '[0.96 0.87 0.70]' , White => '[1.00 1.00 1.00]' , WhiteSmoke => '[0.96 0.96 0.96]' , Yellow => '[1.00 1.00 0.00]' , DarkYellow => '[1.00 0.90 0.00]' , YellowGreen => '[0.60 0.80 0.20]' ) ; sub help { print < Options: --list font|color|palette|proc --du double-up; add white pages EOH } my $boundingbox = ""; if (! GetOptions ( "help" => \$help , "test" => \$::test , "list=s" => \$list , "rand=i" => \$rand , "bb=s" => \$boundingbox , "du" => \$double_up , "debug=i" => \$::debug ) ) { print STDERR "option processing failed\n"; exit(1); } if ($help) { help(); exit(0); } if ($boundingbox) { my @bb = split ',', $boundingbox; die "need four boundingbox parameters joined by commas" unless @bb == 4; @::CONF{qw(LLX LLY URX URY)} = @bb; } if ($list) { if ($list =~ /palette/) { my @keys = sort { (reverse $a) cmp (reverse $b) } keys %COLORS; my $xo = 30; my $yo = 50; for my $k (@keys) { print "(fill) $k [$xo $yo 20 20] proc_box\n"; print "($k) 14 [$xo $yo 20 20] proc_box_text_right\n"; print "($COLORS{$k}) 14 [$xo $yo 10 add 20 20] proc_box_text_right\n"; $yo += 25; if ($yo > 750) { $yo = 50; $xo += 110; } } print "showpage\n"; } if ($list =~ /color/) { my @keys = sort keys %COLORS; my @sel = (); if ($rand) { my %sel = (); while (keys %sel < $rand && @sel < @keys) { my $x = int(rand(@keys)); push @sel, $keys[$x] if !defined($sel{$x}); $sel{$x} = 1; } } else { @sel = @keys; } local $, = "\n"; print map { sprintf "%-25s %s", $_, $COLORS{$_} } @sel; print "\n"; } if ($list =~ /font/) { local $, = "\n"; print sort keys %FONTS; print "\n"; } if ($list =~ /proc/) { while () { if (s/^%\/PROC//) { $_ = ; s/%/ /; print; } } print <) { $bbox = $_ if /^%%BoundingBox/i; s/%\\%.*//; if (/^showpage/ || /showpage$/) { $PAGE++; push @{$content{$PAGE}}, "\n"; } elsif (/showpage/) { print STDERR "unjustified showpage (not interpreted as operator)\n"; } else { push @{$content{$PAGE}}, $_; } $trailing = !/showpage/ && /\S/ ? 1 : 0; } if ($trailing) { print STDERR "you might be missing a trailing showpage - I'll add one to be sure\n"; $PAGE++; push @{$content{$PAGE}}, "\n"; } { my $PAGE_MAX = $PAGE-1; $PAGE_MAX *= 2 if $double_up; print <> setpagedevice % %%EndFeature /BBLL [ $::CONF{LLX} $::CONF{LLY} ] def /BBUR [ $::CONF{URX} $::CONF{URY} ] def EOH while () { if (/\@colors\@/) { print join "", map { "/$_ $COLORS{$_} def\n" } keys %COLORS; } else { print $_; } } my @pages = sort {$a <=> $b} keys %content; while (my $p = shift @pages) { my $page = $content{$p}; last if !@pages || $page !~ /\S+/; local $" = ''; my $pphysical = $double_up ? 2*$p-1 : $p; print "\n%%Page: $pphysical $pphysical\n"; print @$page; print "%%EndPage\n"; print "showpage\n"; if ($double_up) { my $pback = $pphysical + 1; print "\n%%Page: $pback $pback\n"; print "% double-up page\n"; print "%%EndPage\n"; print "showpage\n"; } } print "%%Trailer\n"; print "%%EOF\n"; } __DATA__ /B_test 0 def % set to 1 to test BoundingBox parameters B_test 1 eq { newpath BBLL aload pop -4 add exch -4 add exch moveto BBLL aload pop BBUR aload pop pop 4 add exch -4 add lineto BBUR aload pop 4 add exch 4 add exch lineto BBUR aload pop BBLL aload pop pop -4 add exch 4 add lineto % this is UL closepath stroke } if %/PROC% % proc_circle (stroke|fill) [r g b] [x y] r % /proc_circle { exch aload pop moveto currentpoint newpath 3 -1 roll 0 360 arc aload pop setrgbcolor cvx exec } def % v % | % \ | % xy \| %/PROC% % proc_triangle_left (stroke|fill) [r g b] #box# % /proc_triangle_left { gsave aload pop % x y dx dy 4 -2 roll moveto 2 copy % dx dy dx dy rmoveto 2 copy % dx dy dx dy -1 mul 0 exch rlineto % dx dy dx pop 0.5 mul exch -1 mul exch % -dx dhy rlineto closepath aload pop setrgbcolor cvx exec grestore } def % v % | % | / % xy|/ %/PROC% % proc_triangle_right (stroke|fill) [r g b] #box# % /proc_triangle_right { gsave aload pop % x y dx dy 4 -2 roll moveto 2 copy % dx dy dx dy 0.5 mul rlineto % dx dy 0.5 mul exch % dhy dx -1 mul exch rlineto closepath aload pop setrgbcolor cvx exec grestore } def % ------> % / % / % xy / %/PROC% % proc_triangle_down (stroke|fill) [r g b] #box# % /proc_triangle_down { gsave aload pop 4 -2 roll % dx dy x y moveto % {x,y} dx dy dup 0 exch rmoveto % dx dy exch dup 0 rlineto % dy dx -0.5 mul exch -1 mul % -dhx -dy rlineto closepath aload pop setrgbcolor cvx exec grestore } def % | % |-height % | % ---xy---- (base) % dl dr % % angle indicates angle of base with x axis %/PROC% % proc_triangle_aim (stroke|fill) [r g b ] [x y height] [dl dr angle] % /proc_triangle_aim { gsave exch aload pop 3 1 roll % height x y translate exch aload pop % height dl dr angle rotate exch dup -1 mul % height dr dl -dl 0 translate exch % height dr dl newpath 0 0 moveto dup 3 1 roll % height dl dr dl add 0 rlineto % height dl -1 mul exch rlineto closepath aload pop setrgbcolor cvx exec grestore } def % \ % \ % \ % xy.-----> %/PROC% % proc_triangle_up (stroke|fill) [r g b] #box# % /proc_triangle_up { gsave aload pop 4 -2 roll % dx dy x y newpath moveto exch % dy dx dup 0 rlineto % dy dx -0.5 mul exch rlineto closepath aload pop setrgbcolor cvx exec grestore } def %/PROC% % proc_box (stroke|fill) [r g b] #box# % /proc_box { gsave aload pop 4 -2 roll % dy dx x y newpath moveto % dy dy exch dup % dx dy dx 0 rlineto % dx dx exch % dy dy 0 exch rlineto % dx -1 mul 0 rlineto closepath aload pop setrgbcolor % 1 eq % { fill % } % { stroke % } % ifelse cvx exec grestore } def %/PROC% % proc_box_text_right (text) dx #box# % /proc_box_text_right { dup dup % shift box box box 0 get exch % shift box y box 2 get add % shift box y+dx 3 -1 roll add exch % y+dy+shift box 1 get moveto show } def %/PROC% % proc_box_text_left (text) dx #box# % /proc_box_text_left { dup 0 get % shift box x 3 -1 roll -1 mul add exch % y-shift box 1 get moveto show } def %/PROC% % proc_box_text_left_dots (text) dx #box# % /proc_box_text_left_dots { dup 0 get % (s) dx [box] x1 exch 1 get % (s) dx x1 y1 4 -1 roll stringwidth pop % dx x1 y1 sw 4 -1 roll exch -1 mul add dup % x1 y1 dx-sw dx-sw 4 -1 roll exch -1 mul add % y1 dx-sw x1-(dx-sw) 3 -1 roll gsave 1 add translate newpath 5 3 3 -1 roll -2 add { 1 mul 0 moveto currentpoint 0.5 0 360 arc } for fill grestore } def % % stack: [ Ax Ay ] [ Bx By] wAB wBA % /biarcdict 11 dict def /proc_2way_edge { gsave biarcdict begin 0.1 setlinewidth /wBA exch def /wAB exch def aload pop /By exch def /Bx exch def aload pop /Ay exch def /Ax exch def /dx Ax Bx -1 mul add def /dy Ay By -1 mul add def /L dx dx mul dy dy mul add sqrt def /ddx dy L div displacement mul def /ddy dx L div displacement mul def wAB 0.002 gt { Ax ddx add Ay ddy -1 mul add moveto Bx ddx add By ddy -1 mul add lineto 1 1 wAB sqrt sqrt -1 mul add dup setrgbcolor stroke } if wBA 0.002 gt { Bx ddx -1 mul add By ddy add moveto Ax ddx -1 mul add Ay ddy add lineto 1 1 wBA sqrt sqrt -1 mul add dup setrgbcolor stroke } if end grestore } def % /she { proc_2way_edge } def % /shn { proc_circle } def %/PROC% % proc_set_rgbcolor [r g b] % /proc_set_rgbcolor { aload pop setrgbcolor } def %/PROC% % proc_iplt f l r | l + (r-l)*f % /proc_iplt { % f l r left right fraction: compute l + (r-l)*fr exch dup % f r l l 4 1 roll % l f r l -1 mul add mul add } def %/PROC% % proc_clr_iplt f a1 a2 | a1 + (a2-a1)*f % /proc_clr_iplt { 0 begin /a2 exch def /a1 exch def /f exch def f a1 0 get a2 0 get iplt f a1 1 get a2 1 get iplt f a1 2 get a2 2 get iplt 3 array astore end } def /proc_clr_iplt load 0 3 dict put %/PROC% % proc_set_font scale /FontName % /proc_set_font { findfont exch scalefont setfont } def /Times-Roman findfont 10 scalefont setfont /c {proc_circle} bind def /tl {proc_triangle_left} bind def /tr {proc_triangle_right} bind def /td {proc_triangle_down} bind def /ta {proc_triangle_aim} bind def /tu {proc_triangle_up} bind def /b {proc_box} bind def /btr {proc_box_text_right} bind def /btl {proc_box_text_left} bind def /btld {proc_box_text_left_dots} bind def /rgb {proc_set_rgbcolor} bind def /iplt {proc_iplt} bind def @colors@