pumpkin-books.ps.pl

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