our @EXPORT = qw(
$pumpkin $green $red $blue $yellow $moth $purple $lotus $white
+ $anychip $black colour
+
+ $ps_framing
+
+ $page_pre ps_head
+
+ arrow_any
);
our $purple = ["145/44/238", "0 0 0"];
our $lotus = [("0/245/255",) x 2];
our $white = ["1 1 1", "0 0 0"];
+
+our $anychip = ['0.8', '0'];
+our $black = colour('0');
+
+sub colour ($) {
+ my ($c) = @_;
+ if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
+ return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
+ } elsif ($c =~ m/[^ 0-9.]/) {
+ return $c;
+ } elsif ($c =~ m/^\s*\S+\s*$/) {
+ return "$c setgray";
+ } elsif ($c =~ m/./) {
+ return "$c setrgbcolor";
+ } else {
+ return '';
+ }
+}
+
+our $page_pre = <<END;
+72 25.4 div dup scale
+%210 0 translate
+%90 rotate
+7 30 translate
+END
+
+our $ps_framing = '';
+
+sub arrow_any ($) { <<END;
+ $black 1 setlinewidth
+ newpath
+ $_[0]
+ arrowlen 0 moveto
+ arrowhead dup neg exch rmoveto
+ arrowhead dup neg rlineto
+ arrowhead neg dup rlineto
+ stroke
+END
+};
+
+sub ps_head () {
+ $ps_framing .= <<END;
+%!
+
+$page_pre
+
+/tw 57.5 def
+/th 73 def
+/bdiag 5 def
+/thirdlineh 0.45 def
+/costcirch 0.3 def
+/chip 15 def
+/spot 3.5 def
+/arrowlen 6 def
+/arrowhead 3 def
+/putback_len 10 def
+
+/costtexth 0.215 def
+/costtextsz 12 def
+/costtextdx -0.03 def
+/costfont /Heletica-BoldOblique findfont costtextsz scalefont def
+
+/rubysz 4 def
+
+% diagonal conversion
+/dc { % xprop yprop
+ dup th mul % xprop yprop y
+ 3 1 roll % y xprop yprop
+ bdiag mul neg % y xprop x-margin-at-this-height
+ tw add % y xprop x-width-at-this-height
+ exch mul % y x-width-at-this-height xprop
+ exch % x y
+} def
+
+/arrow {
+ ${\ arrow_any("0 0 moveto arrowlen 0 rlineto") }
+} def
+
+END
+}
+
+1;
BEGIN { unshift @INC, '.'; }
use Quacks;
-my $anychip = ['0.8', '0'];
-
-our $page_pre = <<END;
-72 25.4 div dup scale
-%210 0 translate
-%90 rotate
-7 30 translate
-END
-
-sub colour ($) {
- my ($c) = @_;
- if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
- return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
- } elsif ($c =~ m/[^ 0-9.]/) {
- return $c;
- } elsif ($c =~ m/^\s*\S+\s*$/) {
- return "$c setgray";
- } elsif ($c =~ m/./) {
- return "$c setrgbcolor";
- } else {
- return '';
- }
-}
-
-our $black = colour('0');
-
sub chip ($$) {
my ($cary, $pips) = @_; # put in a gsave translate
my $o = <<END;
$o;
}
-
-sub arrow_any ($) { <<END;
- $black 1 setlinewidth
- newpath
- $_[0]
- arrowlen 0 moveto
- arrowhead dup neg exch rmoveto
- arrowhead dup neg rlineto
- arrowhead neg dup rlineto
- stroke
-END
-};
-
-
-our $ps_framing = <<END;
-%!
-
-$page_pre
-
-/tw 57.5 def
-/th 73 def
-/bdiag 5 def
-/thirdlineh 0.45 def
-/costcirch 0.3 def
-/chip 15 def
-/spot 3.5 def
-/arrowlen 6 def
-/arrowhead 3 def
-/putback_len 10 def
-
-/costtexth 0.215 def
-/costtextsz 12 def
-/costtextdx -0.03 def
-/costfont /Heletica-BoldOblique findfont costtextsz scalefont def
-
-/rubysz 4 def
-
-% diagonal conversion
-/dc { % xprop yprop
- dup th mul % xprop yprop y
- 3 1 roll % y xprop yprop
- bdiag mul neg % y xprop x-margin-at-this-height
- tw add % y xprop x-width-at-this-height
- exch mul % y x-width-at-this-height xprop
- exch % x y
-} def
-
-/arrow {
- ${\ arrow_any("0 0 moveto arrowlen 0 rlineto") }
-} def
-
-END
+ps_head();
sub def_image ($$) {
my ($ncomps, $name) = @_;