2 # Books of Pumpkins, etc. Extensions to Quacks of Quedlinburg
3 # SPDX-License-Identifier: GPL-3.0-or-later OR CC-BY-SA-4.0
4 # Copyright 2020-2022 Ian Jackson
9 use Exporter qw(import);
13 $pumpkin $green $red $blue $yellow $moth $purple $lotus $white
14 $anychip $black colour
24 our $pumpkin = ["255/185/15", "0 0 0"];
25 our $green = ["0/238/118", "1 1 1"];
26 our $red = ["1 0 0", "0 0 0"];
27 our $blue = ["0 .4 1 ", "1 1 1"];
28 our $yellow = ["1 1 0", "0 0 0"];
29 our $moth = [" 0 0 0", "1 1 1"];
30 our $purple = ["145/44/238", "0 0 0"];
31 our $lotus = [("0/245/255",) x 2];
32 our $white = ["1 1 1", "0 0 0"];
36 if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
37 return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
38 } elsif ($c =~ m/[^ 0-9.]/) {
40 } elsif ($c =~ m/^\s*\S+\s*$/) {
42 } elsif ($c =~ m/./) {
43 return "$c setrgbcolor";
49 our $anychip = ['0.8', '0'];
50 our $black = colour('0');
56 sub arrow_any ($) { <<END;
61 arrowhead dup neg exch rmoveto
62 arrowhead dup neg rlineto
63 arrowhead neg dup rlineto
69 my ($cary, $pips) = @_; # put in a gsave translate
72 0 0 chip 0.5 mul 0 360 arc
73 gsave 1 setlinewidth $black stroke grestore
74 ${\ colour($cary->[0]) } fill
78 ${\ colour($cary->[1]) }
85 spot 0.5 sqrt mul 1.1 mul dup
92 $spot->( 0, 0) if $pips & 1;
93 $spot->(-1,-1) if $pips & 6;
94 $spot->(+1,+1) if $pips & 6;
95 $spot->(-1,+1) if $pips & 4;
96 $spot->(+1,-1) if $pips & 4;
101 sub ruby () { # put in gsave translate
109 ${\ colour('1 .2 .2') } gsave fill grestore
110 $black 1 setlinewidth stroke
119 72 25.4 div dup scale
125 $ps_framing .= <<END;
143 /costtextdx -0.03 def
144 /costfont /Heletica-BoldOblique findfont costtextsz scalefont def
148 % diagonal conversion
150 dup th mul % xprop yprop y
151 3 1 roll % y xprop yprop
152 bdiag mul neg % y xprop x-margin-at-this-height
153 tw add % y xprop x-width-at-this-height
154 exch mul % y x-width-at-this-height xprop
159 ${\ arrow_any("0 0 moveto arrowlen 0 rlineto") }