our @EXPORT = qw(
$pumpkin $green $red $blue $yellow $moth $purple $lotus $white
+ $anychip $black colour
+
+ $ps_framing
+
+ $page_pre ps_start
+
+ arrow_any chip ruby
);
our $purple = ["145/44/238", "0 0 0"];
our $lotus = [("0/245/255",) x 2];
our $white = ["1 1 1", "0 0 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 $anychip = ['0.8', '0'];
+our $black = colour('0');
+
+our $page_pre;
+
+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 chip ($$) {
+ my ($cary, $pips) = @_; # put in a gsave translate
+ my $o = <<END;
+ newpath
+ 0 0 chip 0.5 mul 0 360 arc
+ gsave 1 setlinewidth $black stroke grestore
+ ${\ colour($cary->[0]) } fill
+END
+ if ($pips) {
+ $o .= <<END;
+ ${\ colour($cary->[1]) }
+END
+ }
+ my $spot = sub {
+ my ($x,$y) = @_;
+ $o .= <<END;
+ newpath
+ spot 0.5 sqrt mul 1.1 mul dup
+ $x mul exch $y mul
+ spot 0.5 mul
+ 0 360 arc fill
+END
+ };
+
+ $spot->( 0, 0) if $pips & 1;
+ $spot->(-1,-1) if $pips & 6;
+ $spot->(+1,+1) if $pips & 6;
+ $spot->(-1,+1) if $pips & 4;
+ $spot->(+1,-1) if $pips & 4;
+
+ $o;
+}
+
+sub ruby () { # put in gsave translate
+ <<END;
+ newpath
+ rubysz neg 0 moveto
+ 0 rubysz neg lineto
+ rubysz 0 lineto
+ 0 rubysz lineto
+ closepath
+ ${\ colour('1 .2 .2') } gsave fill grestore
+ $black 1 setlinewidth stroke
+END
+}
+
+sub ps_start (;$) {
+ my ($adj) = @_;
+ $adj //= '';
+
+ $page_pre = <<END;
+72 25.4 div dup scale
+%210 0 translate
+%90 rotate
+$adj
+END
+
+ $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;