pumpkin-books.ps.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my $pumpkin = ["255/185/15", "0 0 0"];
   6 my $green   = ["0/238/118", "1 1 1"];
   7 my $red     = ["1   0  0", "0 0 0"];
   8 my $blue    = ["0  .4 1 ", "1 1 1"];
   9 my $yellow  = ["1  1   0", "0 0 0"];
  10 my $moth    = [" 0  0  0", "1 1 1"];
  11 my $purple  = ["145/44/238", "0 0 0"];
  12 my $lotus   = [("0/245/255",) x 2];
  13 my $white   = ["1  1   1", "0 0 0"];
  14
  15 my $anychip = ['0.8', '0'];
  16
  17 our $page_pre = <<END;
  18 72 25.4 div dup scale
  19 %210 0 translate
  20 %90 rotate
  21 7 10 translate
  22 END
  23
  24 sub colour ($) {
  25   my ($c) = @_;
  26   if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
  27     return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
  28   } elsif ($c =~ m/[^ 0-9.]/) {
  29     return $c;
  30   } elsif ($c =~ m/^\s*\S+\s*$/) {
  31     return "$c setgray";
  32   } elsif ($c =~ m/./) {
  33     return "$c setrgbcolor";
  34   } else {
  35     return '';
  36   }
  37 }
  38
  39 our $black = colour('0');
  40
  41 sub chip ($$) {
  42   my ($cary, $pips) = @_; # put in a gsave translate
  43   my $o = <<END;
  44   newpath
  45   0 0 chip 0.5 mul 0 360 arc
  46   gsave 1 setlinewidth $black stroke grestore
  47   ${\ colour($cary->[0]) } fill
  48 END
  49   if ($pips) {
  50     $o .= <<END;
  51   ${\ colour($cary->[1]) }
  52 END
  53   }
  54   my $spot = sub {
  55     my ($x,$y) = @_;
  56     $o .= <<END;
  57     newpath
  58     spot 0.5 sqrt mul 1.1 mul dup
  59     $x mul exch $y mul
  60     spot 0.5 mul
  61     0 360 arc fill
  62 END
  63   };
  64
  65   $spot->( 0, 0) if $pips & 1;
  66   $spot->(-1,-1) if $pips & 6;
  67   $spot->(+1,+1) if $pips & 6;
  68   $spot->(-1,+1) if $pips & 4;
  69   $spot->(+1,-1) if $pips & 4;
  70
  71   $o;
  72 }
  73
  74 sub veepsspot ($) {
  75   my ($chip) = @_;
  76   <<END;
  77 gsave
  78   0 chip -0.5 mul translate
  79   $black
  80   newpath 0 0 chip 0.5 mul 0 360 arc stroke
  81   /Times-Bold findfont 7 scalefont setfont
  82   -1 -5 translate
  83   0 0 moveto (?) show
  84   newpath
  85    -1 -1 moveto 6 0 rlineto 0 7 rlineto -6 0 rlineto
  86     closepath 0.5 setlinewidth stroke
  87 grestore
  88   $chip
  89 END
  90 }
  91
  92 sub anychip ($) {
  93   my ($pips) = @_;
  94   my $fsz = 10;
  95   <<END;
  96 gsave
  97   chip -0.5 mul  $fsz -0.30 mul  moveto
  98   /Helvetica-Bold findfont $fsz scalefont setfont
  99   (Any) dup stringwidth  3 2 roll show
 100   pop pop
 101   20 0 translate
 102   ${\ chip($anychip, $pips) }
 103 grestore
 104 END
 105 }
 106
 107 sub ruby () { # put in gsave translate
 108   <<END;
 109   newpath
 110     rubysz neg  0 moveto
 111     0  rubysz neg lineto
 112     rubysz      0 lineto
 113     0      rubysz lineto
 114     closepath
 115     ${\ colour('1 .2 .2') } gsave fill grestore
 116     $black 1 setlinewidth stroke
 117 END
 118 }
 119
 120 sub exposition ($) {
 121   my ($text) = @_;
 122   my $fontsz = 6;
 123   my $o = <<END;
 124     /Times-Roman findfont $fontsz scalefont setfont $black
 125 END
 126   $text =~ s/\n$//;
 127   my @lines = split /\n/, $text;
 128   foreach my $y (0..$#lines) {
 129     my $l = $lines[$y];
 130     $l =~ s/[()\\]/\\$&/g;
 131     my $yd = $fontsz * (0.5*@lines - $y);
 132     $o .= <<END;
 133     0 0.70 dc moveto
 134     0 $yd rmoveto
 135     ($l)  dup stringwidth pop -0.5 mul 0 rmoveto
 136     show
 137 END
 138   }
 139   $o;
 140 }
 141
 142
 143 sub general_book ($$) { # put in a gsave
 144   my ($this, $costs) = @_;
 145   my $o = <<END;
 146 tw  0  translate
 147
 148 3 setlinewidth
 149 0.9 setgray
 150 newpath
 151 0 0 dc moveto
 152 0 1 dc lineto stroke
 153
 154 $black
 155 1 setlinewidth
 156
 157 newpath
 158 -1 0  dc moveto
 159 +1 0  dc lineto
 160 +1 1  dc lineto
 161 -1 1  dc lineto
 162 closepath stroke
 163
 164 newpath
 165 0 0 dc         moveto
 166 0 thirdlineh dc rlineto
 167 -1 thirdlineh dc lineto stroke
 168
 169 /thirddivline {               % xprop
 170   newpath
 171   dup -3 div  0               dc moveto
 172       -3 div  thirdlineh      dc lineto stroke
 173                               %
 174 } def
 175
 176 END
 177
 178   $o .= <<END if @$costs == 3;
 179 1 thirddivline
 180 2 thirddivline
 181 END
 182
 183   foreach my $costi (0..2) {
 184     my ($cost, $pips);
 185     if (@$costs == 3) {
 186       $cost = $costs->[$costi];
 187       $pips = qw(1 2 4)[$costi];
 188     } else {
 189       next unless $costi == 1;
 190       $cost = $costs->[0];
 191       $pips = $costs->[1];
 192     }
 193     $o .= <<END
 194   costfont setfont
 195   -2.5 $costi add 3 div
 196 gsave
 197   dup costcirch dc translate
 198   ${\ chip($this,$pips) }
 199 grestore
 200   costtexth exch costtextdx add exch dc moveto
 201   $black
 202   ($cost)
 203   dup stringwidth pop  -0.5 mul  costtextsz neg  rmoveto
 204   show
 205 END
 206   }
 207
 208   $o;
 209 }
 210
 211 sub green_book () {
 212   my $o = general_book($green, [qw(5 9 15)]);
 213
 214   $o .= <<END;
 215 gsave 0.25 0.15 dc translate ${\ chip($pumpkin,0) } grestore
 216 gsave 0.25 0.40 dc translate ${\ chip($green,0) } grestore
 217
 218 /Times-Bold findfont
 219 dup
 220   6 scalefont setfont
 221   0.40 0.17 dc moveto (last) show
 222 %
 223   8 scalefont setfont
 224   0.40 0.09 dc moveto (3) show
 225 /Times-Roman findfont
 226   38 scalefont setfont
 227   0.45 0.14 dc moveto (}) show
 228
 229 gsave
 230   0.85 0.275 dc translate
 231   ${\ ruby() }
 232 grestore
 233 END
 234
 235   $o .= exposition(<<END);
 236 For each pumpkin in the last 3 chips,
 237 receive 1 ruby.
 238 But, not more rubies than the number
 239 of green chips in your pot.
 240 END
 241
 242   $o;
 243 }
 244
 245 sub red_book () {
 246   my $o = general_book($red, [qw(4 9 16)]);
 247
 248   $o .= <<END;
 249 gsave 0.35 0.30 dc translate ${\ chip($pumpkin,0) } grestore
 250
 251 /Times-Bold findfont
 252   15 scalefont setfont
 253   0.50 0.24 dc moveto (+1) show
 254
 255 END
 256
 257   $o .= exposition(<<END);
 258 The next 1/2/4 pumpkins you place are
 259 each moved one extra space.
 260 (After applying any other special effects;
 261 one extra space no matter how many reds)
 262 END
 263
 264   $o;
 265 }
 266
 267 sub blue_book () {
 268   my $o = general_book($blue, [qw(4 10 18)]);
 269
 270   $o .= <<END;
 271 /Times-Bold findfont 15 scalefont setfont $black
 272 END
 273
 274   my $exchip = sub {
 275     my ($that, $pips) = @_;
 276     <<END;
 277   gsave ${\ chip($that, $pips) } grestore
 278 END
 279   };
 280   my $exslash = sub {
 281     <<END;
 282     8 -5 moveto (/) show
 283     20 0 translate
 284 END
 285   };
 286
 287   my $exchline = sub {
 288     my ($y, $pips, $content) = @_;
 289     <<END;
 290 gsave
 291   0.16 0.15 0.16 $y mul add dc translate
 292   0.60 dup scale
 293   gsave ${\ chip($blue,$pips) } grestore
 294   8 -3 moveto (:) show
 295   3 0 translate
 296   0.8 dup scale
 297   21 0 translate
 298 $content
 299 grestore
 300
 301 gsave
 302   0.50 0.65 dc translate
 303   0.65 dup scale
 304   gsave -10 0 translate ${\ chip($pumpkin,1) } grestore
 305   arrow
 306 grestore
 307 END
 308   };
 309
 310   $o .= $exchline->(2, 1, <<END);
 311   ${\ $exchip->($green,1) }  ${\ $exslash->() }
 312   ${\ $exchip->($red,  1) }  ${\ $exslash->() }
 313   ${\ $exchip->($blue, 1) }  ${\ $exslash->() }
 314   ${\ $exchip->($yellow, 1) }
 315 END
 316
 317   $o .= $exchline->(1, 2, <<END);
 318   ${\ $exchip->($moth,1) }  ${\ $exslash->() }
 319   ${\ $exchip->($purple,1) }  ${\ $exslash->() }
 320   ${\ anychip(2) }
 321 END
 322
 323   $o .= $exchline->(0, 4, <<END);
 324   ${\ anychip(4) }
 325 END
 326
 327   $o .= exposition(<<END);
 328 If the previous chip placed was a pumpkin,
 329 you may exchange it as follows:
 330
 331
 332 END
 333
 334   $o;
 335 }
 336
 337 sub lotus_book () {
 338   my $o = general_book($lotus, [8, 0]);
 339
 340   $o .= <<END;
 341 /Times-Bold findfont 15 scalefont setfont $black
 342
 343 gsave
 344   0.36 0.38 dc translate
 345   0.80 dup scale
 346   gsave ${\ chip($lotus,0) } grestore
 347
 348   9 -4 moveto (=) show
 349 grestore
 350 gsave
 351   0.20 0.15 dc translate
 352   0.80 dup scale
 353   gsave ${\ chip($pumpkin,0) } grestore
 354   chip 0.5 mul 0 translate
 355   gsave ${\ chip($pumpkin,0) } grestore
 356
 357   10 -4.5 moveto (... +1) show
 358
 359 grestore
 360 END
 361 <<END;
 362 gsave
 363   0.16 0.20  dc translate
 364   0.60 dup scale
 365
 366   gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
 367   gsave 0 20 translate ${\ chip($purple, 1) } grestore
 368   27 0 translate
 369 grestore
 370 END
 371
 372
 373   $o .= exposition(<<END);
 374 The value of this chip is
 375 1 higher than the number of pumpkins
 376 previously placed in the pot (but max.4)
 377 END
 378
 379   $o;
 380 }
 381
 382 sub purple_book () {
 383   my $o = general_book($purple, [10, 1]);
 384
 385   my $input = <<END;
 386   gsave ${\ veepsspot(chip($pumpkin, 0)) } grestore
 387   gsave 0 20 translate ${\ chip($purple, 1) } grestore
 388 END
 389
 390   $o .= <<END;
 391 /Times-Bold findfont 15 scalefont setfont $black
 392 gsave
 393   0.16 0.20  dc translate
 394   0.60 dup scale
 395
 396 $input
 397   8 -12 moveto (...) show
 398   27 0 translate
 399 $input
 400 grestore
 401
 402 gsave
 403 /Times-Roman findfont
 404   32 scalefont setfont
 405   0.48 0.14 dc moveto (}) show
 406 grestore
 407
 408 gsave
 409    0.83 0.25 dc translate
 410    0.85 dup scale
 411    ${\ chip($anychip, 0) }
 412 grestore
 413
 414 gsave
 415   0.72 0.22 dc translate
 416   0.50 dup scale
 417    $black 0 0 moveto (?+?) show
 418 grestore
 419 END
 420
 421   $o .= exposition(<<END);
 422 For each pumpkin in the pot (but
 423  not more than the number of purple chips),
 424 add up the VPs of the covered spaces.
 425 Buy 1/2 chips of up to that total value.
 426 END
 427
 428   $o;
 429 }
 430
 431 sub tile {
 432   my $index = scalar @_;
 433   my $pos = 0;
 434   my $o = '';
 435   my $showpage = sub {
 436     $o .= <<END;
 437 showpage
 438 END
 439   };
 440   while (my $d = pop @_) {
 441     if ($pos >= 5) {
 442       $pos -= 5;
 443       $showpage->();
 444     }
 445     $o .= <<END;
 446 gsave
 447 END
 448     if ($pos < 3) {
 449       $o .= <<END
 450         0   th 10 add  $pos mul  translate
 451 END
 452     } else {
 453       $o .= <<END
 454 tw 2 mul 7 add
 455    dup    th add  0 translate
 456    90 rotate
 457    $pos 3 sub mul  0 translate
 458 END
 459     }
 460     $o .= "\n".$d."\n";
 461     $o .= <<END;
 462
 463     /Courier-Bold findfont 6 scalefont setfont
 464     -0.98 0.94 dc moveto
 465     ($index) show
 466
 467 grestore
 468 END
 469     $pos++;
 470     $index--;
 471   }
 472   $showpage->();
 473   $o;
 474 }
 475
 476 sub yellow_book () {
 477   my $o = general_book($yellow, [qw(7 12 19)]);
 478
 479   $o .= <<END;
 480 END
 481
 482   $o .= exposition(<<END);
 483 Put a chip, no bigger than the yellow,
 484 placed in your pot before a pumpkin,
 485 back in your bag.
 486
 487
 488 END
 489
 490   $o;
 491 }
 492
 493 print <<END or die $!;
 494 %!
 495
 496 $page_pre
 497
 498 /tw 57.5 def
 499 /th 73 def
 500 /bdiag 5 def
 501 /thirdlineh 0.45 def
 502 /costcirch 0.3 def
 503 /chip 15 def
 504 /spot 3.5 def
 505 /arrowlen 6 def
 506 /arrowhead 3 def
 507
 508 /costtexth 0.215 def
 509 /costtextsz 12 def
 510 /costtextdx -0.03 def
 511 /costfont /Heletica-BoldOblique findfont costtextsz scalefont def
 512
 513 /rubysz 4 def
 514
 515 % diagonal conversion
 516 /dc {                    % xprop yprop
 517     dup th mul           % xprop yprop y
 518     3 1 roll             % y xprop yprop
 519     bdiag mul neg        % y xprop x-margin-at-this-height
 520     tw add               % y xprop x-width-at-this-height
 521     exch mul             % y x-width-at-this-height xprop
 522     exch                 % x y
 523 } def
 524
 525 /arrow {
 526   $black 1 setlinewidth
 527     newpath
 528        0 0 moveto  arrowlen 0 rlineto
 529        arrowhead dup neg exch  rmoveto
 530        arrowhead dup neg       rlineto
 531        arrowhead neg dup       rlineto
 532        stroke
 533 } def
 534
 535 END
 536
 537 print tile(
 538            yellow_book(),
 539           ) or die $! if 1;
 540
 541 print "showpage\n" or die $!;
 542
 543 print tile(
 544            red_book(),
 545            green_book(),
 546            purple_book(),
 547            blue_book(),
 548            lotus_book(),
 549           ) or die $! if 1;