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