X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=pumpkin-books.ps.pl;h=2b3dbbe275ba637b3d2d9804fa3c79c5fa4390f4;hb=HEAD;hp=825d3f4c5f2b4ae74a5a59139998f55dcefc99f8;hpb=96e8cb6507e6d4d607dac3ab37150e82ea2b803a;p=quacks.git

diff --git a/pumpkin-books.ps.pl b/pumpkin-books.ps.pl
index 825d3f4..2b3dbbe 100755
--- a/pumpkin-books.ps.pl
+++ b/pumpkin-books.ps.pl
@@ -1,75 +1,12 @@
 #!/usr/bin/perl -w
+# Books of Pumpkins, etc.  Extensions to Quacks of Quedlinburg
+#  SPDX-License-Identifier: GPL-3.0-or-later OR CC-BY-SA-4.0
+# Copyright 2020-2021 Ian Jackson
 
 use strict;
 
-my $pumpkin = ["255/185/15", "0 0 0"];
-my $green   = ["0/238/118", "1 1 1"];
-my $red     = ["1   0  0", "0 0 0"];
-my $blue    = ["0  .4 1 ", "1 1 1"];
-my $yellow  = ["1  1   0", "0 0 0"];
-my $moth    = [" 0  0  0", "1 1 1"];
-my $purple  = ["145/44/238", "0 0 0"];
-my $lotus   = [("0/245/255",) x 2];
-my $white   = ["1  1   1", "0 0 0"];
-
-my $anychip = ['0.8', '0'];
-
-our $page_pre = <<END;
-72 25.4 div dup scale
-%210 0 translate
-%90 rotate
-7 10 translate
-END
-
-sub colour ($) {
-  my ($c) = @_;
-  if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
-    return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
-  } elsif ($c =~ m/[^ 0-9.]/) {
-    return $c;
-  } elsif ($c =~ m/^\s*\S+\s*$/) {
-    return "$c setgray";
-  } elsif ($c =~ m/./) {
-    return "$c setrgbcolor";
-  } else {
-    return '';
-  }
-}
-
-our $black = colour('0');
-
-sub chip ($$) {
-  my ($cary, $pips) = @_; # put in a gsave translate
-  my $o = <<END;
-  newpath
-  0 0 chip 0.5 mul 0 360 arc
-  gsave 1 setlinewidth $black stroke grestore
-  ${\ colour($cary->[0]) } fill
-END
-  if ($pips) {
-    $o .= <<END;
-  ${\ colour($cary->[1]) }
-END
-  }
-  my $spot = sub {
-    my ($x,$y) = @_;
-    $o .= <<END;
-    newpath
-    spot 0.5 sqrt mul 1.1 mul dup
-    $x mul exch $y mul
-    spot 0.5 mul
-    0 360 arc fill
-END
-  };
-
-  $spot->( 0, 0) if $pips & 1;
-  $spot->(-1,-1) if $pips & 6;
-  $spot->(+1,+1) if $pips & 6;
-  $spot->(-1,+1) if $pips & 4;
-  $spot->(+1,-1) if $pips & 4;
-
-  $o;
-}
+BEGIN { unshift @INC, '.'; }
+use Quacks;
 
 sub veepsspot ($) {
   my ($chip) = @_;
@@ -104,19 +41,6 @@ grestore
 END
 }
 
-sub ruby () { # put in gsave translate
-  <<END;
-  newpath
-    rubysz neg  0 moveto
-    0  rubysz neg lineto
-    rubysz      0 lineto
-    0      rubysz lineto
-    closepath
-    ${\ colour('1 .2 .2') } gsave fill grestore
-    $black 1 setlinewidth stroke
-END
-}
-
 sub exposition ($) {
   my ($text) = @_;
   my $fontsz = 6;
@@ -233,7 +157,7 @@ END
   $o;
 }
   
-sub green_book () {
+sub book_green () {
   my $o = general_book($green, [qw(5 9 15)]);
 
   $o .= <<END;
@@ -267,7 +191,7 @@ END
   $o;
 }
   
-sub red_book () {
+sub book_red () {
   my $o = general_book($red, [qw(4 9 16)]);
 
   $o .= <<END;
@@ -289,8 +213,8 @@ END
   $o;
 }
 
-sub blue_book () {
-  my $o = general_book($blue, [qw(4 10 18)]);
+sub book_blue () {
+  my $o = general_book($blue, [qw(4 9 17)]);
 
   $o .= <<END;
 /Times-Bold findfont 15 scalefont setfont $black
@@ -342,7 +266,8 @@ END
   $o .= $exchline->(1, 2, <<END);
   ${\ $exchip->($moth,1) }  ${\ $exslash->() }
   ${\ $exchip->($purple,1) }  ${\ $exslash->() }
-  ${\ anychip(2) }
+  ${\ $exchip->($lotus,0) }  ${\ $exslash->() }
+  ${\ $exchip->($anychip,2) }
 END
 
   $o .= $exchline->(0, 4, <<END);
@@ -359,7 +284,7 @@ END
   $o;
 }
 
-sub lotus_book () {
+sub book_lotus () {
   my $o = general_book($lotus, [8, 0]);
 
   $o .= <<END;
@@ -398,13 +323,13 @@ END
   $o .= exposition(<<END);
 The value of this chip is
 1 higher than the number of pumpkins
-previously placed in the pot (but max.4)
+in the pot (but max.4)
 END
 
   $o;
 }
 
-sub purple_book () {
+sub book_purple () {
   my $o = general_book($purple, [10, 1]);
 
   my $input = <<END;
@@ -453,82 +378,26 @@ END
   $o;
 }
 
-sub tile {
-  my @tiles;
-  my $index_i = 1;
-  foreach my $d (@_) {
-    foreach my $dd (ref $d ? @$d : $d) {
-      push @tiles, [ $dd, $index_i ];
-    }
-    $index_i++;
-  }      
-
-  my $pos = 0;
-  my $o = '';
-  my $showpage = sub {
-    $o .= <<END;
-showpage
-$page_pre
-END
-  };
-
-  while (my $di = pop @tiles) {
-    my ($d, $index) = @$di;
-
-    if ($pos >= 5) {
-      $pos -= 5;
-      $showpage->();
-    }
-    $o .= <<END;
-gsave
-END
-    if ($pos < 3) {
-      $o .= <<END
-        0   th 10 add  $pos mul  translate
-END
-    } else {
-      $o .= <<END
-tw 2 mul 7 add
-   dup    th add  0 translate
-   90 rotate
-   $pos 3 sub mul  0 translate
-END
-    }
-    $o .= "\n".$d."\n";
-    $o .= <<END;
-
-    /Courier-Bold findfont 6 scalefont setfont
-    -0.98 0.94 dc moveto
-    ($index) show
-
-grestore
-END
-    $pos++;
-  }
-  $showpage->();
-  $o;
-}
-
-sub yellow_book () {
-  my $o = general_book($yellow, [qw(7 12 19)]);
+sub book_yellow () {
+  my $o = general_book($yellow, [qw(5 11 19)]);
 
   $o .= <<END;
 gsave
-  0.50 0.62 dc translate
-  0.65 dup scale
+  0.52 0.32 dc translate
+  0.80 dup scale
   -26 0 translate
-  gsave 26 0 translate ${\ chip($anychip,0) } grestore
+  gsave 26 0 translate ${\ chip($yellow,0) } grestore
   gsave 46 0 translate ${\ chip($pumpkin,0) } grestore
-  gsave -30 rotate bag_image grestore
-  8 14 translate
-  -120 rotate
+  34 14 translate
+  -22.5 rotate
+  1 -1 scale
   ${\ arrow_any("
     gsave
      arrowlen 0 translate
   -85 rotate
-    putback_len neg 0
-      putback_len
-      240 0 arc
+    -40 0
+      40
+      300 0 arc
     stroke
     grestore
   ") }
@@ -548,44 +417,11 @@ END
 END
   };
   
-  my $exchline = sub {
-    my ($y, $pips, $content) = @_;
-    <<END;
-gsave 
-  0.20 0.12 0.16 $y mul add dc translate
-  0.60 dup scale
-  gsave ${\ chip($yellow,$pips) } grestore
-  8 -3 moveto (:) show
-  3 0 translate
-  0.8 dup scale
-  24 0 translate
-$content
-grestore
-END
-  };
-
-  $o .= $exchline->(2, 1, <<END);
-  ${\ $exchip->($white,1) }  ${\ $exslash->() }
-  ${\ $exchip->($anychip,1) }  ${\ $exslash->() }
-  ${\ $exchip->($lotus,0) }
-END
-
-  $o .= $exchline->(1, 2, <<END);
-  ${\ $exchip->($white,2) }  ${\ $exslash->() }
-  ${\ $exchip->($anychip,2) }
-END
-
-  $o .= $exchline->(0, 4, <<END);
-  ${\ $exchip->($white,3) }  ${\ $exslash->() }
-  ${\ $exchip->($anychip,4) }
-END
-
   $o .= exposition(<<END);
-Put a chip, no bigger than the yellow,
-whose next placed chip is a pumpkin,
-back in your bag.                
-
- 
+Move up to 1/2/4 pumpkins
+already in your pot, to after the yellow.
+(always immediately after, only one space,
+regardless of other rules)
 END
 
   $o;
@@ -639,7 +475,7 @@ END
 END
 }
 
-sub black_book_pair () {
+sub book_black_pair () {
   my $o = general_book($moth, [10, 1]);
 
   $o .= num_players(2);
@@ -656,7 +492,7 @@ END
   $o;
 }
 
-sub black_book_more () {
+sub book_black_more () {
   my $o = general_book($moth, [10, 1]);
 
   $o .= num_players(3,'+');
@@ -674,57 +510,7 @@ END
 
   $o;
 }
-
-sub arrow_any ($) { <<END;
-  $black 1 setlinewidth
-    newpath
-       $_[0]
-       arrowlen 0 moveto
-       arrowhead dup neg exch  rmoveto
-       arrowhead dup neg       rlineto
-       arrowhead neg dup       rlineto
-       stroke
-END
-};
-
-print <<END or die $!;
-%!
-
-$page_pre
-
-/tw 57.5 def
-/th 73 def
-/bdiag 5 def
-/thirdlineh 0.45 def
-/costcirch 0.3 def
-/chip 15 def
-/spot 3.5 def
-/arrowlen 6 def
-/arrowhead 3 def
-/putback_len 10 def
-
-/costtexth 0.215 def
-/costtextsz 12 def
-/costtextdx -0.03 def
-/costfont /Heletica-BoldOblique findfont costtextsz scalefont def
-
-/rubysz 4 def
-
-% diagonal conversion
-/dc {                    % xprop yprop
-    dup th mul           % xprop yprop y
-    3 1 roll             % y xprop yprop
-    bdiag mul neg        % y xprop x-margin-at-this-height
-    tw add               % y xprop x-width-at-this-height
-    exch mul             % y x-width-at-this-height xprop
-    exch                 % x y
-} def
-
-/arrow {
-  ${\ arrow_any("0 0 moveto  arrowlen 0 rlineto") }
-} def
-
-END
+ps_start('7 30 translate');
 
 sub def_image ($$) {
   my ($ncomps, $name) = @_;
@@ -748,33 +534,93 @@ sub def_image ($$) {
   my $sz = $w/17.0;
   my $hsz = $sz/2;
 
-  print <<END, '{<' or die $!;
+  $ps_framing .= <<END . '{<';
 /${name}_image {
   $w $h 8 
   [ -$sz 0 0  -$sz  $w 2 div  $h 2 div  ]
 END
   for (my $i=0; $i< $w*$h*$ncomps; $i++) {
-    printf "%02x", shift @d or die $!;
+    $ps_framing .= sprintf "%02x", shift @d;
   }
-  print <<END or die $!;
+  $ps_framing .= <<END;
 >} $oper
 } def
 END
 }
 
+sub tile {
+  my @tiles;
+  my $index = 1;
+
+  foreach my $spec (@_) {
+    my @datas;
+    foreach my $stem (split m{/}, $spec) {
+      my $func = $stem;
+      $func =~ y/-/_/;
+      $func = ${*::}{"book_$func"} // die "$func ?";
+      my $data = $func->();
+      $data .= <<END;
+    /Courier-Bold findfont 6 scalefont setfont
+    -0.98 0.94 dc moveto
+    ($index) show
+END
+      open F, ">book-$stem.ps" or die $!;
+      print F $ps_framing, $data, "\nshowpage\n" or die $!;
+      close F or die $!;
+      push @datas, $data;
+    }
+    foreach my $dd (@datas) {
+      push @tiles, $dd;
+    }
+    $index++;
+  }
+
+  my $pos = 0;
+  my $o = '';
+  my $showpage = sub {
+    $o .= <<END;
+showpage
+$page_pre
+END
+  };
+
+  while (my $d = pop @tiles) {
+    if ($pos >= 5) {
+      $pos -= 5;
+      $showpage->();
+    }
+    $o .= <<END;
+gsave
+END
+    if ($pos < 3) {
+      $o .= <<END
+        0   th 10 add  $pos mul  translate
+END
+    } else {
+      $o .= <<END
+tw 2 mul 7 add
+   dup    th add  0 translate
+   90 rotate
+   $pos 3 sub mul  0 translate
+END
+    }
+    $o .= "\n".$d."\n";
+    $o .= <<END;
+grestore
+END
+    $pos++;
+  }
+  $showpage->();
+  $o;
+}
+
 def_image(1, "bag");
 def_image(1, "pot");
 def_image(3, "droplet");
 
+print $ps_framing or die $!;
+
 print "gsave\n" or die $!;
 
-print tile(
-	   red_book(),
-	   green_book(),
-	   purple_book(),
-	   blue_book(),
-	   lotus_book(),
-	   yellow_book(),
-	   [black_book_pair(), black_book_more()],
-	  ) or die $! if 1;
+print tile(@ARGV) or die $! if 1;