pumpkin-books.ps.pl

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