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-2021 Ian Jackson
8 BEGIN { unshift @INC, '.'; }
15 0 chip -0.5 mul translate
17 newpath 0 0 chip 0.5 mul 0 360 arc stroke
18 /Times-Bold findfont 7 scalefont setfont
22 -1 -1 moveto 6 0 rlineto 0 7 rlineto -6 0 rlineto
23 closepath 0.5 setlinewidth stroke
34 chip -0.5 mul $fsz -0.30 mul moveto
35 /Helvetica-Bold findfont $fsz scalefont setfont
36 (Any) dup stringwidth 3 2 roll show
39 ${\ chip($anychip, $pips) }
48 /Times-Roman findfont $fontsz scalefont setfont $black
51 my @lines = split /\n/, $text;
52 foreach my $y (0..$#lines) {
54 $l =~ s/[()\\]/\\$&/g;
55 my $yd = $fontsz * (0.5*@lines - $y);
59 ($l) dup stringwidth pop -0.5 mul 0 rmoveto
66 sub num_players ($;$) {
72 -0.94 0.50 dc translate
77 pot_image 18 0 translate
80 $o .= <<END if defined $plus;
82 /Helvetica-Bold findfont 25 scalefont setfont
92 sub general_book ($$) { # put in a gsave
93 my ($this, $costs) = @_;
115 0 thirdlineh dc rlineto
116 -1 thirdlineh dc lineto stroke
118 /thirddivline { % xprop
120 dup -3 div 0 dc moveto
121 -3 div thirdlineh dc lineto stroke
127 $o .= <<END if @$costs == 3;
132 foreach my $costi (0..2) {
135 $cost = $costs->[$costi];
136 $pips = qw(1 2 4)[$costi];
138 next unless $costi == 1;
144 -2.5 $costi add 3 div
146 dup costcirch dc translate
147 ${\ chip($this,$pips) }
149 costtexth exch costtextdx add exch dc moveto
152 dup stringwidth pop -0.5 mul costtextsz neg rmoveto
161 my $o = general_book($green, [qw(5 9 15)]);
164 gsave 0.25 0.15 dc translate ${\ chip($pumpkin,0) } grestore
165 gsave 0.25 0.40 dc translate ${\ chip($green,0) } grestore
170 0.40 0.17 dc moveto (last) show
173 0.40 0.09 dc moveto (3) show
174 /Times-Roman findfont
176 0.45 0.14 dc moveto (}) show
179 0.85 0.275 dc translate
184 $o .= exposition(<<END);
185 For each pumpkin in the last 3 chips,
187 But, not more rubies than the number
188 of green chips in your pot.
195 my $o = general_book($red, [qw(4 9 16)]);
198 gsave 0.35 0.30 dc translate ${\ chip($pumpkin,0) } grestore
202 0.50 0.24 dc moveto (+1) show
206 $o .= exposition(<<END);
207 The next 1/2/4 pumpkins you place are
208 each moved one extra space.
209 (After applying any other special effects;
210 one extra space no matter how many reds)
217 my $o = general_book($blue, [qw(4 10 18)]);
220 /Times-Bold findfont 15 scalefont setfont $black
223 0.50 0.65 dc translate
225 gsave -10 0 translate ${\ chip($pumpkin,0) } grestore
231 my ($that, $pips) = @_;
233 gsave ${\ chip($that, $pips) } grestore
244 my ($y, $pips, $content) = @_;
247 0.16 0.15 0.16 $y mul add dc translate
249 gsave ${\ chip($blue,$pips) } grestore
259 $o .= $exchline->(2, 1, <<END);
260 ${\ $exchip->($green,1) } ${\ $exslash->() }
261 ${\ $exchip->($red, 1) } ${\ $exslash->() }
262 ${\ $exchip->($blue, 1) } ${\ $exslash->() }
263 ${\ $exchip->($yellow, 1) }
266 $o .= $exchline->(1, 2, <<END);
267 ${\ $exchip->($moth,1) } ${\ $exslash->() }
268 ${\ $exchip->($purple,1) } ${\ $exslash->() }
269 ${\ $exchip->($lotus,0) } ${\ $exslash->() }
270 ${\ $exchip->($anychip,2) }
273 $o .= $exchline->(0, 4, <<END);
277 $o .= exposition(<<END);
278 If the previous chip placed was a pumpkin,
279 you may exchange it as follows:
288 my $o = general_book($lotus, [8, 0]);
291 /Times-Bold findfont 15 scalefont setfont $black
294 0.36 0.38 dc translate
296 gsave ${\ chip($lotus,0) } grestore
301 0.20 0.15 dc translate
303 gsave ${\ chip($pumpkin,0) } grestore
304 chip 0.5 mul 0 translate
305 gsave ${\ chip($pumpkin,0) } grestore
307 10 -4.5 moveto (... +1) show
313 0.16 0.20 dc translate
316 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
317 gsave 0 20 translate ${\ chip($purple, 1) } grestore
323 $o .= exposition(<<END);
324 The value of this chip is
325 1 higher than the number of pumpkins
326 previously placed in the pot (but max.4)
333 my $o = general_book($purple, [10, 1]);
336 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
337 gsave 0 20 translate ${\ chip($purple, 1) } grestore
341 /Times-Bold findfont 15 scalefont setfont $black
343 0.16 0.20 dc translate
347 8 -12 moveto (...) show
353 /Times-Roman findfont
355 0.48 0.14 dc moveto (}) show
359 0.83 0.25 dc translate
361 ${\ chip($anychip, 0) }
365 0.72 0.22 dc translate
367 $black 0 0 moveto (?+?) show
371 $o .= exposition(<<END);
372 For each pumpkin in the pot (but
373 not more than the number of purple chips),
374 add up the VPs of the covered spaces.
375 Buy 1/2 chips of up to that total value.
382 my $o = general_book($yellow, [qw(5 11 18)]);
386 0.52 0.32 dc translate
389 gsave 26 0 translate ${\ chip($yellow,0) } grestore
390 gsave 46 0 translate ${\ chip($pumpkin,0) } grestore
408 my ($that, $pips) = @_;
410 gsave ${\ chip($that, $pips) } grestore
420 $o .= exposition(<<END);
421 Move up to 1/2/4 pumpkins
422 already in your pot, to after the yellow.
423 (always immediately after, only one space,
424 regardless of other rules)
430 sub black_common ($) {
433 /Helvetica-Bold findfont 5.5 scalefont setfont
439 3.5 -1 translate .7 dup scale
446 dup stringwidth .5 mul exch .5 mul exch translate
447 dup stringwidth -1 mul exch -1 mul exch moveto show
448 .7 dup scale 7 3 translate
467 newpath 0 0 moveto -18 0 rlineto stroke
470 ${\ chip($pumpkin,0) }
478 sub book_black_pair () {
479 my $o = general_book($moth, [10, 1]);
481 $o .= num_players(2);
482 $o .= black_common('equal:');
484 $o .= exposition(<<END);
485 The player with the shortest distance
486 between a black chip and a pumpkin
487 gets to move their droplet.
489 If tied, both players get a ruby.
495 sub book_black_more () {
496 my $o = general_book($moth, [10, 1]);
498 $o .= num_players(3,'+');
499 $o .= black_common('2nd:');
501 $o .= exposition(<<END);
503 The player(s) with the shortest distance
504 between a black chip and a pumpkin
505 get to move their droplet.
506 If only one player won a droplet, the
507 player(s) with the next-shortest distance
513 ps_start('7 30 translate');
516 my ($ncomps, $name) = @_;
518 my $ext = $ncomps == 1 ? 'pgm' : $ncomps == 3 ? 'ppm' : die;
519 my $oper = $ncomps == 1 ? 'image' :
520 $ncomps == 3 ? 'false 3 colorimage' : die;
521 my $magic = $ncomps == 1 ? 'P2' : $ncomps == 3 ? 'P3' : die;
523 open B, "$name.$ext" or die $!;
524 <B> eq "$magic\n" or die "$name.$ext expected $magic";
526 my @d = split ' ', <B>;
531 my $maxval = shift @d;
532 die unless $maxval eq 255;
537 $ps_framing .= <<END . '{<';
540 [ -$sz 0 0 -$sz $w 2 div $h 2 div ]
542 for (my $i=0; $i< $w*$h*$ncomps; $i++) {
543 $ps_framing .= sprintf "%02x", shift @d;
545 $ps_framing .= <<END;
555 foreach my $spec (@_) {
557 foreach my $stem (split m{/}, $spec) {
560 $func = ${*::}{"book_$func"} // die "$func ?";
561 my $data = $func->();
563 /Courier-Bold findfont 6 scalefont setfont
567 open F, ">book-$stem.ps" or die $!;
568 print F $ps_framing, $data, "\nshowpage\n" or die $!;
572 foreach my $dd (@datas) {
587 while (my $d = pop @tiles) {
597 0 th 10 add $pos mul translate
602 dup th add 0 translate
604 $pos 3 sub mul 0 translate
619 def_image(3, "droplet");
621 print $ps_framing or die $!;
623 print "gsave\n" or die $!;
625 print tile(@ARGV) or die $! if 1;