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
8 BEGIN { unshift @INC, '.'; }
13 for (@_) { $ps_framing .= $_ }
30 my $cutd_slope = ($x_cut2-$x_cut)/$x_cut;
31 my $y_cut2d = $y_cutd * $cutd_slope;
32 my $y_cutdd = $x_cutd * $cutd_slope;
40 my $vhalf = sqrt( $spacing ** 2 - ($colspacing*0.5) ** 2 );
42 my $y_cut = 2.75 * $spacing;
44 my $x_pl_zero = $paper_x*0.5 - 3*$colspacing;
45 my $y_pl_zero = $y_cut + $spacing - $y_cutd* 0.5 * $x_cut/$colspacing;
47 my $y_top = $y_pl_zero + $y_cutd + $spacing*1.25;
49 our $veep_bg = " 0.95 0.90 0.67 setrgbcolor ";
51 our $x_cut_rhs = $paper_x - $x_cut;
53 sub some_cut_line($) {
63 o <<GS, some_cut_line(<<GR), <<END;
68 $x_cut2 $y_cut2 lineto
69 $x_cut $x_cutd add $y_cut2 $y_cut2d add lineto
70 $x_cut $x_cutd add $y_cut $y_cutdd add lineto
71 0 $y_cut $y_cutd add lineto
78 my $veep_font = "/Helvetica-Bold findfont 6.5 scalefont setfont";
79 my $money_font = "/Helvetica-BoldOblique findfont 6.5 scalefont setfont";
96 newpath -$sqx -$sqy moveto
99 $sqx -$sqy lineto closepath
105 0.19 0.35 0.25 setrgbcolor
112 ($veeps) dup stringwidth pop -0.5 mul -2.5 rmoveto show
132 my $line_word = 'moveto';
139 foreach (split /\n/, $data) {
143 s{L}{ ($repi == 0 ? 1 : 0) }ge;
144 s{R}{ ($repi == $nrepis-1 ? 1 : 0) }ge;
146 s{V}{ $vhalf / $spacing }ge;
147 my ($x,$y,$money,$veeps,$ruby) = map { eval $_ } split /\s+/;
154 $line .= " $x $y $line_word";
155 $line_word = 'lineto';
156 next unless defined $money;
162 % place $x $y $money $veeps $ruby
167 0 0 chip 0.5 mul 0 360 arc
168 gsave 0.5 setlinewidth $black stroke grestore
169 0.80 0.89 0.63 setrgbcolor fill
172 -4.7 1 moveto ($money) show
177 $o .= <<END if $ruby;
195 0.66 0.85 0.75 setrgbcolor
205 for my $places_i (qw(0 1)) {
206 for my $repi (0..$nrepis-1) {
208 % repi $places_i $repi
210 $repi $colspacing 2 mul mul 0 translate
213 o( (places($repi))[$places_i] );
225 $x_cut_rhs 0 translate
229 o some_cut_line <<END;
232 $x_cut_rhs $y_top lineto
240 $coverup_x $coverup_y translate
241 /Times-Roman findfont 4.0 scalefont setfont
242 0 8 moveto (cover) show
243 2 4.5 moveto (up) show
245 /Helvetica-Bold-Italic findfont 3.5 scalefont setfont (35) show
247 /Helvetica-Bold findfont 3.5 scalefont setfont (15) show
251 $paper_x $x_cut sub $y_top 7 sub translate
254 arrowlen 2 add neg 0 translate
255 ${\ arrow_any("arrowlen 0 moveto -30 0 rlineto") }
259 /Helvetica-Bold findfont 6.5 scalefont setfont
269 /Times-Roman findfont 4.5 scalefont setfont
278 gsave 0 $y_top translate
285 print $ps_framing or die $!;