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) }
44 sub ruby () { # put in gsave translate
52 ${\ colour('1 .2 .2') } gsave fill grestore
53 $black 1 setlinewidth stroke
61 /Times-Roman findfont $fontsz scalefont setfont $black
64 my @lines = split /\n/, $text;
65 foreach my $y (0..$#lines) {
67 $l =~ s/[()\\]/\\$&/g;
68 my $yd = $fontsz * (0.5*@lines - $y);
72 ($l) dup stringwidth pop -0.5 mul 0 rmoveto
79 sub num_players ($;$) {
85 -0.94 0.50 dc translate
90 pot_image 18 0 translate
93 $o .= <<END if defined $plus;
95 /Helvetica-Bold findfont 25 scalefont setfont
105 sub general_book ($$) { # put in a gsave
106 my ($this, $costs) = @_;
128 0 thirdlineh dc rlineto
129 -1 thirdlineh dc lineto stroke
131 /thirddivline { % xprop
133 dup -3 div 0 dc moveto
134 -3 div thirdlineh dc lineto stroke
140 $o .= <<END if @$costs == 3;
145 foreach my $costi (0..2) {
148 $cost = $costs->[$costi];
149 $pips = qw(1 2 4)[$costi];
151 next unless $costi == 1;
157 -2.5 $costi add 3 div
159 dup costcirch dc translate
160 ${\ chip($this,$pips) }
162 costtexth exch costtextdx add exch dc moveto
165 dup stringwidth pop -0.5 mul costtextsz neg rmoveto
174 my $o = general_book($green, [qw(5 9 15)]);
177 gsave 0.25 0.15 dc translate ${\ chip($pumpkin,0) } grestore
178 gsave 0.25 0.40 dc translate ${\ chip($green,0) } grestore
183 0.40 0.17 dc moveto (last) show
186 0.40 0.09 dc moveto (3) show
187 /Times-Roman findfont
189 0.45 0.14 dc moveto (}) show
192 0.85 0.275 dc translate
197 $o .= exposition(<<END);
198 For each pumpkin in the last 3 chips,
200 But, not more rubies than the number
201 of green chips in your pot.
208 my $o = general_book($red, [qw(4 9 16)]);
211 gsave 0.35 0.30 dc translate ${\ chip($pumpkin,0) } grestore
215 0.50 0.24 dc moveto (+1) show
219 $o .= exposition(<<END);
220 The next 1/2/4 pumpkins you place are
221 each moved one extra space.
222 (After applying any other special effects;
223 one extra space no matter how many reds)
230 my $o = general_book($blue, [qw(4 10 18)]);
233 /Times-Bold findfont 15 scalefont setfont $black
236 0.50 0.65 dc translate
238 gsave -10 0 translate ${\ chip($pumpkin,0) } grestore
244 my ($that, $pips) = @_;
246 gsave ${\ chip($that, $pips) } grestore
257 my ($y, $pips, $content) = @_;
260 0.16 0.15 0.16 $y mul add dc translate
262 gsave ${\ chip($blue,$pips) } grestore
272 $o .= $exchline->(2, 1, <<END);
273 ${\ $exchip->($green,1) } ${\ $exslash->() }
274 ${\ $exchip->($red, 1) } ${\ $exslash->() }
275 ${\ $exchip->($blue, 1) } ${\ $exslash->() }
276 ${\ $exchip->($yellow, 1) }
279 $o .= $exchline->(1, 2, <<END);
280 ${\ $exchip->($moth,1) } ${\ $exslash->() }
281 ${\ $exchip->($purple,1) } ${\ $exslash->() }
285 $o .= $exchline->(0, 4, <<END);
289 $o .= exposition(<<END);
290 If the previous chip placed was a pumpkin,
291 you may exchange it as follows:
300 my $o = general_book($lotus, [8, 0]);
303 /Times-Bold findfont 15 scalefont setfont $black
306 0.36 0.38 dc translate
308 gsave ${\ chip($lotus,0) } grestore
313 0.20 0.15 dc translate
315 gsave ${\ chip($pumpkin,0) } grestore
316 chip 0.5 mul 0 translate
317 gsave ${\ chip($pumpkin,0) } grestore
319 10 -4.5 moveto (... +1) show
325 0.16 0.20 dc translate
328 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
329 gsave 0 20 translate ${\ chip($purple, 1) } grestore
335 $o .= exposition(<<END);
336 The value of this chip is
337 1 higher than the number of pumpkins
338 previously placed in the pot (but max.4)
345 my $o = general_book($purple, [10, 1]);
348 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
349 gsave 0 20 translate ${\ chip($purple, 1) } grestore
353 /Times-Bold findfont 15 scalefont setfont $black
355 0.16 0.20 dc translate
359 8 -12 moveto (...) show
365 /Times-Roman findfont
367 0.48 0.14 dc moveto (}) show
371 0.83 0.25 dc translate
373 ${\ chip($anychip, 0) }
377 0.72 0.22 dc translate
379 $black 0 0 moveto (?+?) show
383 $o .= exposition(<<END);
384 For each pumpkin in the pot (but
385 not more than the number of purple chips),
386 add up the VPs of the covered spaces.
387 Buy 1/2 chips of up to that total value.
394 my $o = general_book($yellow, [qw(7 12 19)]);
398 0.50 0.62 dc translate
401 gsave 26 0 translate ${\ chip($anychip,0) } grestore
402 gsave 46 0 translate ${\ chip($pumpkin,0) } grestore
403 gsave -30 rotate bag_image grestore
420 my ($that, $pips) = @_;
422 gsave ${\ chip($that, $pips) } grestore
433 my ($y, $pips, $content) = @_;
436 0.20 0.12 0.16 $y mul add dc translate
438 gsave ${\ chip($yellow,$pips) } grestore
448 $o .= $exchline->(2, 1, <<END);
449 ${\ $exchip->($white,1) } ${\ $exslash->() }
450 ${\ $exchip->($anychip,1) } ${\ $exslash->() }
451 ${\ $exchip->($lotus,0) }
454 $o .= $exchline->(1, 2, <<END);
455 ${\ $exchip->($white,2) } ${\ $exslash->() }
456 ${\ $exchip->($anychip,2) }
459 $o .= $exchline->(0, 4, <<END);
460 ${\ $exchip->($white,3) } ${\ $exslash->() }
461 ${\ $exchip->($anychip,4) }
464 $o .= exposition(<<END);
465 Put a chip, no bigger than the yellow,
466 whose next placed chip is a pumpkin,
475 sub black_common ($) {
478 /Helvetica-Bold findfont 5.5 scalefont setfont
484 3.5 -1 translate .7 dup scale
491 dup stringwidth .5 mul exch .5 mul exch translate
492 dup stringwidth -1 mul exch -1 mul exch moveto show
493 .7 dup scale 7 3 translate
512 newpath 0 0 moveto -18 0 rlineto stroke
515 ${\ chip($pumpkin,0) }
523 sub book_black_pair () {
524 my $o = general_book($moth, [10, 1]);
526 $o .= num_players(2);
527 $o .= black_common('equal:');
529 $o .= exposition(<<END);
530 The player with the shortest distance
531 between a black chip and a pumpkin
532 gets to move their droplet.
534 If tied, both players get a ruby.
540 sub book_black_more () {
541 my $o = general_book($moth, [10, 1]);
543 $o .= num_players(3,'+');
544 $o .= black_common('2nd:');
546 $o .= exposition(<<END);
548 The player(s) with the shortest distance
549 between a black chip and a pumpkin
550 get to move their droplet.
551 If only one player won a droplet, the
552 player(s) with the next-shortest distance
558 ps_start('7 30 translate');
561 my ($ncomps, $name) = @_;
563 my $ext = $ncomps == 1 ? 'pgm' : $ncomps == 3 ? 'ppm' : die;
564 my $oper = $ncomps == 1 ? 'image' :
565 $ncomps == 3 ? 'false 3 colorimage' : die;
566 my $magic = $ncomps == 1 ? 'P2' : $ncomps == 3 ? 'P3' : die;
568 open B, "$name.$ext" or die $!;
569 <B> eq "$magic\n" or die "$name.$ext expected $magic";
571 my @d = split ' ', <B>;
576 my $maxval = shift @d;
577 die unless $maxval eq 255;
582 $ps_framing .= <<END . '{<';
585 [ -$sz 0 0 -$sz $w 2 div $h 2 div ]
587 for (my $i=0; $i< $w*$h*$ncomps; $i++) {
588 $ps_framing .= sprintf "%02x", shift @d;
590 $ps_framing .= <<END;
600 foreach my $spec (@_) {
602 foreach my $stem (split m{/}, $spec) {
605 $func = ${*::}{"book_$func"} // die "$func ?";
606 my $data = $func->();
608 /Courier-Bold findfont 6 scalefont setfont
612 open F, ">book-$stem.ps" or die $!;
613 print F $ps_framing, $data, "\nshowpage\n" or die $!;
617 foreach my $dd (@datas) {
632 while (my $d = pop @tiles) {
642 0 th 10 add $pos mul translate
647 dup th add 0 translate
649 $pos 3 sub mul 0 translate
664 def_image(3, "droplet");
666 print $ps_framing or die $!;
668 print "gsave\n" or die $!;
670 print tile(@ARGV) or die $! if 1;