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, '.'; }
12 my ($cary, $pips) = @_; # put in a gsave translate
15 0 0 chip 0.5 mul 0 360 arc
16 gsave 1 setlinewidth $black stroke grestore
17 ${\ colour($cary->[0]) } fill
21 ${\ colour($cary->[1]) }
28 spot 0.5 sqrt mul 1.1 mul dup
35 $spot->( 0, 0) if $pips & 1;
36 $spot->(-1,-1) if $pips & 6;
37 $spot->(+1,+1) if $pips & 6;
38 $spot->(-1,+1) if $pips & 4;
39 $spot->(+1,-1) if $pips & 4;
48 0 chip -0.5 mul translate
50 newpath 0 0 chip 0.5 mul 0 360 arc stroke
51 /Times-Bold findfont 7 scalefont setfont
55 -1 -1 moveto 6 0 rlineto 0 7 rlineto -6 0 rlineto
56 closepath 0.5 setlinewidth stroke
67 chip -0.5 mul $fsz -0.30 mul moveto
68 /Helvetica-Bold findfont $fsz scalefont setfont
69 (Any) dup stringwidth 3 2 roll show
72 ${\ chip($anychip, $pips) }
77 sub ruby () { # put in gsave translate
85 ${\ colour('1 .2 .2') } gsave fill grestore
86 $black 1 setlinewidth stroke
94 /Times-Roman findfont $fontsz scalefont setfont $black
97 my @lines = split /\n/, $text;
98 foreach my $y (0..$#lines) {
100 $l =~ s/[()\\]/\\$&/g;
101 my $yd = $fontsz * (0.5*@lines - $y);
105 ($l) dup stringwidth pop -0.5 mul 0 rmoveto
112 sub num_players ($;$) {
118 -0.94 0.50 dc translate
123 pot_image 18 0 translate
126 $o .= <<END if defined $plus;
128 /Helvetica-Bold findfont 25 scalefont setfont
138 sub general_book ($$) { # put in a gsave
139 my ($this, $costs) = @_;
161 0 thirdlineh dc rlineto
162 -1 thirdlineh dc lineto stroke
164 /thirddivline { % xprop
166 dup -3 div 0 dc moveto
167 -3 div thirdlineh dc lineto stroke
173 $o .= <<END if @$costs == 3;
178 foreach my $costi (0..2) {
181 $cost = $costs->[$costi];
182 $pips = qw(1 2 4)[$costi];
184 next unless $costi == 1;
190 -2.5 $costi add 3 div
192 dup costcirch dc translate
193 ${\ chip($this,$pips) }
195 costtexth exch costtextdx add exch dc moveto
198 dup stringwidth pop -0.5 mul costtextsz neg rmoveto
207 my $o = general_book($green, [qw(5 9 15)]);
210 gsave 0.25 0.15 dc translate ${\ chip($pumpkin,0) } grestore
211 gsave 0.25 0.40 dc translate ${\ chip($green,0) } grestore
216 0.40 0.17 dc moveto (last) show
219 0.40 0.09 dc moveto (3) show
220 /Times-Roman findfont
222 0.45 0.14 dc moveto (}) show
225 0.85 0.275 dc translate
230 $o .= exposition(<<END);
231 For each pumpkin in the last 3 chips,
233 But, not more rubies than the number
234 of green chips in your pot.
241 my $o = general_book($red, [qw(4 9 16)]);
244 gsave 0.35 0.30 dc translate ${\ chip($pumpkin,0) } grestore
248 0.50 0.24 dc moveto (+1) show
252 $o .= exposition(<<END);
253 The next 1/2/4 pumpkins you place are
254 each moved one extra space.
255 (After applying any other special effects;
256 one extra space no matter how many reds)
263 my $o = general_book($blue, [qw(4 10 18)]);
266 /Times-Bold findfont 15 scalefont setfont $black
269 0.50 0.65 dc translate
271 gsave -10 0 translate ${\ chip($pumpkin,0) } grestore
277 my ($that, $pips) = @_;
279 gsave ${\ chip($that, $pips) } grestore
290 my ($y, $pips, $content) = @_;
293 0.16 0.15 0.16 $y mul add dc translate
295 gsave ${\ chip($blue,$pips) } grestore
305 $o .= $exchline->(2, 1, <<END);
306 ${\ $exchip->($green,1) } ${\ $exslash->() }
307 ${\ $exchip->($red, 1) } ${\ $exslash->() }
308 ${\ $exchip->($blue, 1) } ${\ $exslash->() }
309 ${\ $exchip->($yellow, 1) }
312 $o .= $exchline->(1, 2, <<END);
313 ${\ $exchip->($moth,1) } ${\ $exslash->() }
314 ${\ $exchip->($purple,1) } ${\ $exslash->() }
318 $o .= $exchline->(0, 4, <<END);
322 $o .= exposition(<<END);
323 If the previous chip placed was a pumpkin,
324 you may exchange it as follows:
333 my $o = general_book($lotus, [8, 0]);
336 /Times-Bold findfont 15 scalefont setfont $black
339 0.36 0.38 dc translate
341 gsave ${\ chip($lotus,0) } grestore
346 0.20 0.15 dc translate
348 gsave ${\ chip($pumpkin,0) } grestore
349 chip 0.5 mul 0 translate
350 gsave ${\ chip($pumpkin,0) } grestore
352 10 -4.5 moveto (... +1) show
358 0.16 0.20 dc translate
361 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
362 gsave 0 20 translate ${\ chip($purple, 1) } grestore
368 $o .= exposition(<<END);
369 The value of this chip is
370 1 higher than the number of pumpkins
371 previously placed in the pot (but max.4)
378 my $o = general_book($purple, [10, 1]);
381 gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
382 gsave 0 20 translate ${\ chip($purple, 1) } grestore
386 /Times-Bold findfont 15 scalefont setfont $black
388 0.16 0.20 dc translate
392 8 -12 moveto (...) show
398 /Times-Roman findfont
400 0.48 0.14 dc moveto (}) show
404 0.83 0.25 dc translate
406 ${\ chip($anychip, 0) }
410 0.72 0.22 dc translate
412 $black 0 0 moveto (?+?) show
416 $o .= exposition(<<END);
417 For each pumpkin in the pot (but
418 not more than the number of purple chips),
419 add up the VPs of the covered spaces.
420 Buy 1/2 chips of up to that total value.
427 my $o = general_book($yellow, [qw(7 12 19)]);
431 0.50 0.62 dc translate
434 gsave 26 0 translate ${\ chip($anychip,0) } grestore
435 gsave 46 0 translate ${\ chip($pumpkin,0) } grestore
436 gsave -30 rotate bag_image grestore
453 my ($that, $pips) = @_;
455 gsave ${\ chip($that, $pips) } grestore
466 my ($y, $pips, $content) = @_;
469 0.20 0.12 0.16 $y mul add dc translate
471 gsave ${\ chip($yellow,$pips) } grestore
481 $o .= $exchline->(2, 1, <<END);
482 ${\ $exchip->($white,1) } ${\ $exslash->() }
483 ${\ $exchip->($anychip,1) } ${\ $exslash->() }
484 ${\ $exchip->($lotus,0) }
487 $o .= $exchline->(1, 2, <<END);
488 ${\ $exchip->($white,2) } ${\ $exslash->() }
489 ${\ $exchip->($anychip,2) }
492 $o .= $exchline->(0, 4, <<END);
493 ${\ $exchip->($white,3) } ${\ $exslash->() }
494 ${\ $exchip->($anychip,4) }
497 $o .= exposition(<<END);
498 Put a chip, no bigger than the yellow,
499 whose next placed chip is a pumpkin,
508 sub black_common ($) {
511 /Helvetica-Bold findfont 5.5 scalefont setfont
517 3.5 -1 translate .7 dup scale
524 dup stringwidth .5 mul exch .5 mul exch translate
525 dup stringwidth -1 mul exch -1 mul exch moveto show
526 .7 dup scale 7 3 translate
545 newpath 0 0 moveto -18 0 rlineto stroke
548 ${\ chip($pumpkin,0) }
556 sub book_black_pair () {
557 my $o = general_book($moth, [10, 1]);
559 $o .= num_players(2);
560 $o .= black_common('equal:');
562 $o .= exposition(<<END);
563 The player with the shortest distance
564 between a black chip and a pumpkin
565 gets to move their droplet.
567 If tied, both players get a ruby.
573 sub book_black_more () {
574 my $o = general_book($moth, [10, 1]);
576 $o .= num_players(3,'+');
577 $o .= black_common('2nd:');
579 $o .= exposition(<<END);
581 The player(s) with the shortest distance
582 between a black chip and a pumpkin
583 get to move their droplet.
584 If only one player won a droplet, the
585 player(s) with the next-shortest distance
591 ps_start('7 30 translate');
594 my ($ncomps, $name) = @_;
596 my $ext = $ncomps == 1 ? 'pgm' : $ncomps == 3 ? 'ppm' : die;
597 my $oper = $ncomps == 1 ? 'image' :
598 $ncomps == 3 ? 'false 3 colorimage' : die;
599 my $magic = $ncomps == 1 ? 'P2' : $ncomps == 3 ? 'P3' : die;
601 open B, "$name.$ext" or die $!;
602 <B> eq "$magic\n" or die "$name.$ext expected $magic";
604 my @d = split ' ', <B>;
609 my $maxval = shift @d;
610 die unless $maxval eq 255;
615 $ps_framing .= <<END . '{<';
618 [ -$sz 0 0 -$sz $w 2 div $h 2 div ]
620 for (my $i=0; $i< $w*$h*$ncomps; $i++) {
621 $ps_framing .= sprintf "%02x", shift @d;
623 $ps_framing .= <<END;
633 foreach my $spec (@_) {
635 foreach my $stem (split m{/}, $spec) {
638 $func = ${*::}{"book_$func"} // die "$func ?";
639 my $data = $func->();
641 /Courier-Bold findfont 6 scalefont setfont
645 open F, ">book-$stem.ps" or die $!;
646 print F $ps_framing, $data, "\nshowpage\n" or die $!;
650 foreach my $dd (@datas) {
665 while (my $d = pop @tiles) {
675 0 th 10 add $pos mul translate
680 dup th add 0 translate
682 $pos 3 sub mul 0 translate
697 def_image(3, "droplet");
699 print $ps_framing or die $!;
701 print "gsave\n" or die $!;
703 print tile(@ARGV) or die $! if 1;