chiark / gitweb /
preview png, actually make it a png
[pandemic-rising-tide.git] / generate-board
index f35a6991af93eb72ee309da021887cdb715bbb9b..9ce1dc23e4fd441521e71abc37fcd0e71f862f75 100755 (executable)
@@ -1,4 +1,50 @@
 #!/usr/bin/perl -w
+#
+# generate-board - program for generating playing board images
+#   for games very like Pandemic Rising Tide
+#
+# Copyright (C) 2019 Ian Jackson
+#
+# This program is dual licensed, GPv3+ or CC-BY-SA 4.0+.
+# It copies bits of itself into its output; those parts are CC-BY 4.0+.
+# Only to the Pandemic Rising Tide folks, it is permissively licensed.
+#
+#   This program is free software.
+#
+#   You can redistribute it and/or modify it under the terms of the
+#   GNU General Public License as published by the Free Software
+#   Foundation, either version 3 of the License, or (at your option)
+#   any later version; or (at your option), under the terms of the
+#   Creative Commons Attribution-ShareAlike International License,
+#   version 4.0 of that License, or (at your option), any later
+#   version.
+#
+#   This program copies pieces itself into the output.  Those pieces,
+#   when copied into the output, are additionally (at your option)
+#   available under a difference licence: they are made available
+#   under the Creative Commons Attribution International License,
+#   version 4.0 of that License, or (at your option), any later
+#   version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+#   General Public License Creative Commons Attribution-ShareAlike
+#   License or the for more details.
+#
+#   You should have received a copy of these licenses along with this
+#   program.  If not, see <https://www.gnu.org/licenses/> and
+#   <https://creativecommons.org/licenses/>.
+#
+# Pandemic and Pandemic Rising Tide are (I think) trademarks of Z-Man
+# games and I use them without permission.
+# 
+# For the avoidance of doubt, I do not consider this program to be a
+# derivative work of the game Pandemic Rising Tide.  However, it is
+# not very useful without a pair of game description files and the
+# only nontrivial game description files I know of are indeed such
+# derivatives.
+
 
 use strict;
 use Carp;
@@ -22,6 +68,7 @@ our $facesf;
 our %vxname2pos; # $vxname2pos{VXNAME} = Math::GSL::Vector
 our %bb; # $r{Bounding...}[0..3] = points
 our $maxpaper = 'a3';
+my $a1sfactor = 1/sqrt(8);
 
 sub TAU { M_PI * 2.0; }
 sub MM2PT { 72.0 / 25.4; }
@@ -31,9 +78,13 @@ our $mid;
 our $a4_w = 595;
 our $a4_h = 842;
 our $a3_h = 1190;
+our $a1_w = 1684;
+our $a1_h = 2384;
 
 our $max_printeredge = 5.50 * MM2PT;
-
+our $a1m_pasteedge = 3.5 * MM2PT; # along each edge
+our $preamble_from_boundings = '';
+our %adjuncts_dy_from_boundings = (Top => 0, Bottom => 0);
 
 # ----- region names from plag, incl. reverse mapping -----
 
@@ -51,7 +102,7 @@ our $sre = qr{(?:(\")|(?=\w))(.*)\1$}; # 2 captures, $2 is the name
 
 sub prs2r ($) {
   # bodgery for the sea and land
-  return 'NZ' if m/ \| / && !grep { !m{^(?:NZ|L2?)$} } split / \| /, $_[0];
+  return $c{Sea} if m/ \| / && !grep { !m{^$c{OuterfaceRe}$} } split / \| /, $_[0];
   $prs2region{$_[0]} // confess "@_ ?"
 }
 sub prs2rr ($) { $region{prs2r($_[0])} }
@@ -76,19 +127,19 @@ sub read_faces () {
   my @edges;
   my $process_rr = sub {
     my $last_ai;
-    if ($rr->{Name} eq 'NZ') {
-      # We combined L and NZ; now we must split them again
-      # in fact, we just throw away L and L2 entirely.
-      # Here, when processing NZ, we keep only vertices that
-      # are part of NZ.
+    if ($rr->{Name} eq $c{Sea}) {
+      # We combined land and sea; now we must split them again
+      # in fact, we just throw away all L entirely.
+      # Here, when processing sea, we keep only vertices that
+      # are part of the sea.
       @edges = grep {
        my $evxname = $_->{VxName};
        my @eregions = split / \| ?/, $evxname;
-       grep { $_ eq 'NZ' } @eregions
+       grep { $_ eq $c{Sea} } @eregions
       } @edges;
     }
     $rr->{Polygon} = [ @edges ];
-    if ($rr->{Name} ne 'NZ') {
+    if ($rr->{Name} ne $c{Sea}) {
       for my $ei (0..$#edges) {
        if (!defined $last_ai) {
          my $ai;
@@ -136,7 +187,7 @@ sub read_faces () {
   }
   $process_rr->();
 
-  $region{$_}{Special} = 1 foreach qw(NZ L L2);
+  $region{$_}{Special} = 1 foreach @{ $c{SpecialRegions} };
 }
 
 #----- geometry mangling -----
@@ -199,8 +250,8 @@ sub transform_coordinates () {
   my $transform = Math::GSL::Matrix->new(2,2);
   $transform->set_row(0, [  $c, -$s ]);
   $transform->set_row(1, [  $s,  $c ]);
-  print STDERR "rotate was=",prvec($dir)," theta=$theta",
-      " rotateby=$rotateby s=$s c=$c\n";
+  #  print STDERR "rotate was=",prvec($dir)," theta=$theta",
+  #    " rotateby=$rotateby s=$s c=$c\n";
   my @lims;
   foreach my $topend (qw(0 1)) {
     my $v = $topend ? -$GSL_DBL_MAX : $GSL_DBL_MAX;
@@ -228,9 +279,9 @@ sub transform_coordinates () {
       }
     }
   });
-  print STDERR "lims ",prvec($lims[0])," .. ",prvec($lims[1]),"\n";
+  #print STDERR "lims ",prvec($lims[0])," .. ",prvec($lims[1]),"\n";
   my $translate = -$lims[0];
-  print STDERR "translate ",prvec($translate),"\n";
+  #print STDERR "translate ",prvec($translate),"\n";
   my $scale = $c{GraphScale} * MM2PT;
   for_each_pos(sub {
     my ($pr) = @_;
@@ -240,45 +291,55 @@ sub transform_coordinates () {
   $mid = ($lims[1] - $lims[0]) * 0.5;
 }
 
-sub adjust_nz() {
-  my $poly = $region{NZ}{Polygon};
+sub pos_plus_dy_adjunct ($) {
+  my ($cval) = @_;
+  my ($x,$y,$whadjunct) = @$cval;
+  my $adjunct = $adjuncts_dy_from_boundings{ $whadjunct//'' };
+  return "$x $y".( defined $adjunct and " $adjunct add translate" );
+}
+
+sub adjust_sea() {
+  # Adjusts the top and bottom edges of the sea
+  my $poly = $region{$c{Sea}}{Polygon};
   my %occurs;
   foreach my $v (@$poly) {
     $occurs{$v->{VxName}}++
   }
   foreach my $v (@$poly) {
-    $v->{NZ_Occurs} = $occurs{$v->{VxName}};
+    $v->{SeaOccurs} = $occurs{$v->{VxName}};
   }
-  print STDERR " nz ".(scalar @$poly)."\n";
+  #print STDERR " sea ".(scalar @$poly)."\n";
   my $occurs_m = sub {
     my ($ei) = @_;
-    $poly->[($ei+@$poly) % @$poly]{NZ_Occurs} > 1
+    $poly->[($ei+@$poly) % @$poly]{SeaOccurs} > 1
   };
   for my $ei (0..$#$poly) {
     next if $occurs_m->($ei);
     next unless $occurs_m->($ei-1);
     next unless $occurs_m->($ei+1);
-    print STDERR " nz would adjust $poly->[$ei]{VxName}\n";
+    #print STDERR " sea would adjust $poly->[$ei]{VxName}\n";
     # adjust coord outwards
   }
   for my $ei (0..$#$poly) {
     next unless $occurs_m->($ei);
-    print STDERR " nz occurs_m $ei $poly->[$ei]{VxName}\n";
+    #print STDERR " sea occurs_m $ei $poly->[$ei]{VxName}\n";
     next unless $occurs_m->($ei-1);
-    my $dleft = mkvec(-1000,0);
+    my $delta = &mkvec(@{ $c{PA}{OuterCoastDelta} });
     foreach my $which (0,-1) {
       my $ej = ($ei +        $which + @$poly) % @$poly;
       my $ek = ($ei + +1 + 3*$which + @$poly) % @$poly;
       my $posj = \ $poly->[$ej]{Pos};
       my $posk = \ $poly->[$ek]{Pos};
       my $dout = $$posk - $$posj;
-      print STDERR " nz adj j=$ej ",prvec($$posj)," $poly->[$ej]{VxName}\n";
-      print STDERR " nz adj k=$ek ",prvec($$posk)," $poly->[$ek]{VxName}\n";
-      if ($poly->[$ej]{VxName} =~ /Noorderzijlvest/) {
-       print STDERR " nz adj extra\n";
-       $$posk = $$posj + 10 * mkvec(100,-50);
+      #print STDERR " sea adj j=$ej ",prvec($$posj)," $poly->[$ej]{VxName}\n";
+      #print STDERR " sea adj k=$ek ",prvec($$posk)," $poly->[$ek]{VxName}\n";
+      foreach my $paocv (@{ $c{PA_Outercoast_Vertices} }) {
+       if ($poly->[$ej]{VxName} =~ m{$paocv->{Re}}) {
+         #print STDERR " sea adj extra\n";
+         $$posk = $$posj + 10 * &mkvec(@{ $paocv->{PA} });
+       }
       }
-      $$posj = $$posj + $dleft + $dout*10;
+      $$posj = $$posj + $delta + $dout*10;
       $$posk = $$posk          + $dout*10;
     }
   }
@@ -304,27 +365,94 @@ sub face_path ($) {
 
 sub computeboundings() {
   $bb{Entire} = [ 0,0, $a4_h, $a4_w + $a3_h ];
-  $bb{PageB} = [ 0,0, $a4_h, $a4_w ];
-  my $page2minprintable = sub {
-    my (@p) = @{ $_[0] };
-    [ $p[0] + $max_printeredge,
-      $p[1] + $max_printeredge,
-      $p[2] - $max_printeredge,
-      $p[3] - $max_printeredge ];
+  my $submargins = sub {
+    my ($margin, $pr) = @_;
+    my @p = @$pr;
+    [ $p[0] + $margin,
+      $p[1] + $margin,
+      $p[2] - $margin,
+      $p[3] - $margin ];
   };
-  $bb{PrintableB} = $page2minprintable->($bb{PageB});
-  my $mt_offset = $bb{PrintableB}[3] - $max_printeredge;
-  $bb{PageMT} = [ 0, $mt_offset, $a4_h, $mt_offset + $a3_h ];
-  $bb{PrintableMT} = $page2minprintable->($bb{PageMT});
-  $bb{PrintableAll} = [
-                     @{ $bb{PrintableB} }[0..1],
-                     @{ $bb{PrintableMT} }[2..3],
-                    ];
+  my $somepage = sub {
+    my $id = shift @_;
+    print STDERR "defining page Page$id\n";
+    $bb{"Page$id"} = [ @_ ];
+    $bb{"Printable$id"} = $submargins->($max_printeredge, $bb{"Page$id"});
+  };
+  my $pageb_a4 = sub {
+    $somepage->('B', 0,0, $a4_h, $a4_w );
+  };
+  if ($maxpaper eq 'a3') {
+    $pageb_a4->();
+    my $mt_offset = $bb{PrintableB}[3] - $max_printeredge;
+    $somepage->('MT', 0, $mt_offset, $a4_h, $mt_offset + $a3_h );
+    $bb{PrintableAll} = [
+                        @{ $bb{PrintableB} }[0..1],
+                        @{ $bb{PrintableMT} }[2..3],
+                       ];
+  } elsif ($maxpaper eq 'a4') {
+    $pageb_a4->();
+    my $m_offset = $bb{PrintableB}[3] - $max_printeredge;
+    $somepage->('M', 0, $m_offset, $a4_h, $m_offset + $a4_w );
+    my $t_offset = $bb{PrintableM}[3] - $max_printeredge;
+    $somepage->('T', 0, $t_offset, $a4_h, $t_offset + $a4_w );
+    $bb{PrintableAll} = [
+                        @{ $bb{PrintableB} }[0..1],
+                        @{ $bb{PrintableT} }[2..3],
+                       ];
+  } elsif ($maxpaper =~ m/^a1/) {
+    my $offx = ($a1_w - $bb{Entire}[2] * (1 + $a1sfactor)) / 3;
+    my $offy = 0.5*($a1_h - $bb{Entire}[3]);
+    $somepage->('P', -$offx,-$offy, $a1_w-$offx, $a1_h-$offy);
+    my $hairs = 30 * MM2PT;
+    my $hairsw = $bb{Entire}[2];
+    my $hairsh = $bb{Entire}[3];
+    my $surround = 5 * MM2PT;
+    my $surroundw = $bb{Entire}[2] + $surround*2;
+    my $surroundh = $bb{Entire}[3] + $surround*2;
+    my @hrect = @{ $bb{Entire} };
+    if ($maxpaper eq 'a1m') {
+      @hrect = @{ $submargins->($a1m_pasteedge, \@hrect) };
+      $bb{Cutout} = \@hrect;
+    }
+    my $w_stroke = $xopts =~ m/W/ ?
+       ' gsave 3 setlinewidth stroke grestore '
+       : '';
+    $preamble_from_boundings = <<END;
+         1 setlinewidth
+         0 setgray
+         /a1hairs {
+             newpath moveto
+             $hairs 0        rmoveto
+             $hairs -2 mul 0 rlineto
+             $hairs $hairs   rmoveto
+             0 $hairs -2 mul rlineto
+             stroke
+         } def
+         $hrect[0] $hrect[1] a1hairs
+         $hrect[0] $hrect[3] a1hairs
+         $hrect[2] $hrect[3] a1hairs
+         $hrect[2] $hrect[1] a1hairs
+         newpath
+         -$surround -$surround moveto
+          $surroundw 0         rlineto
+          0 $surroundh         rlineto
+          -$surroundw 0        rlineto
+                 closepath $w_stroke clip
+END
+    $adjuncts_dy_from_boundings{Top}    = $c{PA}{BoundingsA1dy}[0];
+    $adjuncts_dy_from_boundings{Bottom} = $c{PA}{BoundingsA1dy}[1];
+    # ^ if we are doing it all in one go we lose less printable area
+  } else {
+    confess;
+  }
 }
 
 sub showboundings () {
   return unless $xopts =~ m/B/;
-  o("  grestore gsave\n");
+  o(" gsave\n");
+  my $bb = $bb{$bounding};
+  o("  $bb->[0] neg $bb->[1] neg translate\n");
   my $i = 0;
   my $on = 2;
   my $off = 9;
@@ -343,6 +471,7 @@ sub showboundings () {
     o("    closepath stroke\n");
     $i++;
   }
+  o(" grestore");
 }
 
 sub o_amble (@) {
@@ -353,36 +482,63 @@ sub o_amble (@) {
   $t =~ s/^\&+/ '%' x length $& /mge;
   o($t);
 }
-      
+
 sub preamble() {
   my $bb = $bb{$bounding}; confess $bounding unless $bb;
   my $sz = [ $bb->[2] - $bb->[0], $bb->[3] - $bb->[1] ];
   o_amble(<<END);
 &!PS-Adobe-3.0
-&&BoundingBox @$bb
+&&BoundingBox 0 0 @$sz
 &&Pages: 1
 &&EndComments
 &&BeginProlog
 &&EndProlog
 &&BeginSetup
 << /PageSize [ @$sz ] >> setpagedevice
+/all {
+  gsave
+  $bb->[0] neg  $bb->[1] neg  translate
+  $preamble_from_boundings
+  board
+  grestore
+  showboundings
+} def
+/showboundings {
+END
+  showboundings();
+  o_amble(<<END);
+} def
 /board {
   gsave
-  34 -15 translate
+  % adjustment to actual image placement within prinable areas etc.:
+  @{ $c{PA}{Overall} } translate
 END
-  # xxx split into pages
+  my $oadj = $c{PA}{OverallOn}{$maxpaper};
+  if ($oadj) {
+    o("@$oadj translate\n");
+  }
 }
 
 sub postamble () {
   o_amble(<<END);
   grestore
-} bind def
+} def % board
 &&EndSetup
 &&Page: 1
 &&BeginPageSetup
 /pgsave save def
 &&EndPageSetup
-board
+all
+END
+  if ($maxpaper =~ m/^a1/) {
+    o(<<END);
+  $a1_w 0 translate
+  $a1sfactor dup scale
+  $a1_w neg 0 translate
+  1 1 3 { pop all 0 $a1_h 0.8 mul translate } for
+END
+  }
+  o_amble(<<END);
 pgsave restore
 showpage
 &&EOF
@@ -422,7 +578,7 @@ sub pscolour ($$$$) {
       m/^([CMYK])([0-7](?:\.\d*)?|8)_?$/ or confess $_.' ?';
       confess if defined $cmyk{$1};
       $cmyk{$1} = $2 / 8.;
-      print STDERR " CMYK $1 $2\n";
+      #print STDERR " CMYK $1 $2\n";
     }
     @r = map { $cmyk{$_} // 0 } qw(C M Y K);
     $rw = 'setcmykcolor';
@@ -438,24 +594,26 @@ sub pscolour ($$$$) {
 
 sub lighterpscolour ($$) {
   my ($colourname, $retain) = @_;
-  print STDERR "COLOUR LIGHTER $retain $colourname\n";
+  #print STDERR "COLOUR LIGHTER $retain $colourname\n";
   pscolour($colourname, 0, $retain, 1-$retain);
 }
 
 sub darkerpscolour ($$) {
   my ($colourname, $retain) = @_;
-  print STDERR "COLOUR DARKER $retain $colourname\n";
+  #print STDERR "COLOUR DARKER $retain $colourname\n";
   pscolour($colourname, 2, $retain, 0);
 }
 
 sub facepscolour ($) {
   my ($colourname) = @_;
-  $xopts =~ m/W/ ? '1 setgray' : lighterpscolour($colourname, 0.75);
+  $xopts =~ m/W/ ? '1 setgray' :
+      $colourname =~ m/land/ ? miscpscolour($colourname)
+      : lighterpscolour($colourname, 0.75);
 }
 
 sub miscpscolour ($) {
   my ($colourname) = @_;
-  print STDERR "COLOUR MISC $colourname\n";
+  #print STDERR "COLOUR MISC $colourname\n";
   pscolour($colourname, 1, 1,0);
 }
 
@@ -481,14 +639,15 @@ sub some_edge_faces (@) {
   }
 }
 
-sub afsluitdijk() {
-  my ($adj) = grep { $_->{Name} eq 'NZ' } @{ $region{'ZZ'}{Adj} };
+sub dashedwithhs ($$$) {
+  my ($inner, $comment, $colour) = @_;
+  my ($adj) = grep { $_->{Name} eq $c{Sea} } @{ $region{$inner}{Adj} };
   my $dash = 20;
   my (@pos) = adj_ends($adj);
   my $mid = 0.5 * ($pos[0] + $pos[1]);
   my $r = 0.5 * ($pos[1] - $pos[0])->norm();
-  o(sprintf <<'END', facepscolour('sea'), psvec($mid), $r);
-  %% Afsluitdijk
+  o(sprintf <<'END', $comment, facepscolour('sea'), psvec($mid), $r);
+  %% %s
   %s %s %s 0 360 arc closepath fill
 END
   some_edge_faces(()); # just sets the colour
@@ -498,14 +657,24 @@ END
   stroke
   [] 0 setdash
 END
-  one_hs('purple', $mid);
+  one_hs($colour, $mid);
+}
+
+sub dashedwithhses() {
+  dashedwithhs(
+             $_->{Inner},
+             $_->{Comment},
+             $_->{Colour}
+            ) foreach @{ $c{DashedHs} };
 }
 
 sub edge_faces() {
-  some_edge_faces($region{'NZ'});
-  afsluitdijk();
+  some_edge_faces($region{$c{Sea}});
+  dashedwithhses();
   some_edge_faces(grep {
-    $_->{Name} !~ m{^(?:L2?|NZ|ZZ)$}
+    my $n = $_->{Name};
+    $n !~ m{^$c{OuterfaceRe}$} &&
+    !grep { $n eq $_->{Inner} } @{ $c{DashedHs} }
   } values %region);
 }
 
@@ -560,15 +729,17 @@ END
     next if $rr->{Name} =~ m/^L\d?$/;
     my $words = $rr->{DisplayName};
     my $pos;
-    if ($rr->{Name} eq 'NZ') {
+    if ($rr->{Name} eq $c{Sea}) {
       $pos = mkvec(90, 1280);
     } else {
       $pos = $rr->{Centre} + mkvec( 0, 0.5 * $sz * @$words );
     }
     if ($hs{$rr->{Name}}) {
-      print STDERR "adjust hs $rr->{Name}\n";
-      $pos -= mkvec(0, -$hs_sz*
-                   ( $rr->{Colour} eq 'green' ? 0.25 : 0.65 ));
+      #print STDERR "adjust hs $rr->{Name}\n";
+      my $posadj = $c{PA_HS_HS}{$rr->{Colour}};
+      $posadj //= [0,0];
+      $pos -= mkvec(0, -$hs_sz * 0.65);
+      $pos += &mkvec(@$posadj) * $hs_sz;
       my $hspos = $pos - mkvec(0, $sz * @$words + $hs_sz/2 + $hs_lw
                               + $hs_sz*0.15);
       one_hs($rr->{Colour}, $hspos);
@@ -578,13 +749,13 @@ END
       $pos += $sz * &mkvec(@$adjust);
     }
     my $w = $rr->{Water};
-    $w = 2 if $rr->{Special} || $rr->{Name} eq 'ZZ';
+    $w = 2 if $rr->{Name} eq $c{Sea};
     if ($w) {
-      print STDERR " water $w in $rr->{Name}\n";
+      #print STDERR " water $w in $rr->{Name}\n";
       my $down = water_cubes_sz(2) - water_cubes_sz(1) + $cube_gap;
       $pos -= mkvec(0, -0.5 * $down);
       my $cube_y = -($sz * @$words);
-      if ($rr->{Name} eq 'Wieringermeer') {
+      if (grep { $_ eq $rr->{Name} } @{ $c{CubeAbove} }) {
        $pos -= mkvec(0,+$sz);
        $cube_y = 0;
        $down = 0;
@@ -652,19 +823,24 @@ sub decks(){
   }
   o("    closepath\n");
   o("  } bind def");
+
   o("  /deckpairpathx {\n"); # x because it leaves matrix changed
   o("    newpath         deck1path\n");
   o("    200 0 translate deck1path\n");
   o("  } bind def");
-  o("  $lw setlinewidth ",miscpscolour('playerdeck'),"\n");
-  o("  gsave 401 44 translate deckpairpathx stroke grestore");
-  o("  $lw setlinewidth ",miscpscolour('dykefail'),"\n");
-  o("  gsave 242 1363 translate 90 rotate deckpairpathx stroke grestore");
+
+  foreach my $deck (@{ $c{Decks} }) {
+    o("  $lw setlinewidth ",miscpscolour($deck->{Colour}),"\n");
+    o("  gsave ".pos_plus_dy_adjunct($deck->{PosAdy})."     ");
+    my $rotate = $deck->{Rotate};
+    if ($rotate) { o(" $rotate rotate "); }
+    o("deckpairpathx stroke grestore");
+  }
 }
 
 sub sea_track(){
   o("% sea level track\n");
-  o("  gsave 11 700 translate\n");
+  o("  gsave ",pos_plus_dy_adjunct($c{PA}{SeaTrack})," translate\n");
   my $track = $c{SeaTrack};
   my $token_sz = $hs_sz;
   my $dy = $token_sz * 1.25;
@@ -749,7 +925,7 @@ sub dykes(){
   my $t_sz = $symbol_sz * 1.0;
   my $t_at = sub {
     my ($ang) = @_;
-    print STDERR "ANG $ang\n";
+    #print STDERR "ANG $ang\n";
     map { $t_sz * 0.5 * $_ } cos($ang), sin($ang);
   };
   my @t0 = $t_at->((TAU) *  0.25         );
@@ -764,7 +940,7 @@ sub dykes(){
   o("  } bind def\n");
   foreach my $rr (values %region) {
     next if $rr->{Special};
-    next if $rr->{Name} eq 'ZZ';
+    next if grep { $_->{Inner} eq $rr->{Name} } @{ $c{DashedHs} };
     next if $rr->{Colour} eq 'high';
     foreach my $adj (@{ $rr->{Adj} }) {
       my $neigh = $adj->{Name};
@@ -803,52 +979,58 @@ sub dykes(){
   }
 }
 
-sub hs_initial_1 ($$$;$$$) {
-  my ($colour, $xi,$yi, $text, $text2, $fn) = @_;
+sub hs_initial_1 ($) {
+  my ($hs1) = @_;
+  my ($colour) = $hs1->{Colour};
+  my ($text, $text2);
+  if ($hs1->{Water}) {
+    ($text,$text2) = ('up to '.$hs1->{Water}, 'fewer');
+  } elsif ($hs1->{Dykes}) {
+    ($text,$text2) = ('up to '.$hs1->{Dykes}, '');
+  }
   my $interval = $hs_sz * 1.75;
   my $demo_h = $hs_sz; #water_cubes_sz(3);
   my $demo_x0 = $hs_sz * 0.75 + $dyke_l * 0.60;
   my $demo_w = $demo_x0 + $dyke_l * 0.60;
   o("  % HS I $colour\n");
   o("  gsave\n");
-  o("    550 1705 translate\n");
-  o("    ", ($xi*$interval), " ", (($yi-1)*$interval), " translate\n");
-  if ($fn) {
+  o("    ".pos_plus_dy_adjunct($c{PA}{HS1_initials})."\n");
+  o("    ", ($hs1->{XIYI}[0]*$interval), " ",
+           (($hs1->{XIYI}[1]-1)*$interval), " translate\n");
+  if (defined $text) {
     o("  gsave\n");
     o("        $demo_h setlinewidth 0 0 moveto $demo_w 0 rlineto\n");
     o("        ", facepscolour($colour), " stroke grestore\n");
   }
   one_hs($colour, mkvec(0,0));
-  if ($fn) {
+  if (defined $text) {
     o("    /words {\n");
     o("      2 copy moveto                      ($text) show\n");
     o("      2 copy moveto 0 -$text_sz rmoveto ($text2) show\n");
     o("    } bind def\n");
     o("    gsave ".($hs_sz * 0.8)." $cube_gap translate wordsshow grestore\n");
     o("    $demo_x0 ",($hs_sz * -0.25)," translate\n");
-    $fn->();
   }
-  o("  grestore\n");
-}
-
-sub hs_initial () {
-  hs_initial_1('red',     0,0);
-  hs_initial_1('purple',  0,1);
-  hs_initial_1('green',   1,0, 'up to 6', 'fewer', sub {
+  if ($hs1->{Water}) {
     o("    ",(water_cubes_sz(1))," 0 translate\n");
     o("    0 ",(-water_cubes_sz(1) * 0.3)," translate\n");
     water_cubes(1, miscpscolour('edge'));
-  });
-  hs_initial_1('yellow',  1,1, 'up to 4', '', sub {
+  } elsif ($hs1->{Dykes}) {
     o("    newpath dykepath\n");
     o("    gsave ",miscpscolour('edge')," stroke grestore\n");
     o("    gsave ",miscpscolour('dykehsadd')," fill grestore\n");
-  });
+  }
+  o("  grestore\n");
+}
+
+sub hs_initial () {
+  hs_initial_1($_) foreach @{ $c{HS1} };
 }
 
 sub play_hint () {
   my $sz = 20;
-  o("  gsave ",miscpscolour('hinttext')," 260 1715 translate\n");
+  o("  gsave ",miscpscolour('hinttext'),
+    " ",pos_plus_dy_adjunct($c{PA}{PlayHint}),"\n");
   o("  /Helvetica-Bold findfont $sz scalefont setfont\n");
   my @t = split /\n/, $c{PlayHint};
   foreach my $i (0..$#t) {
@@ -864,7 +1046,7 @@ sub play_hint () {
 $xopts = shift @ARGV if $ARGV[0] =~ s/^-X//;
 $bounding = $1 if $xopts =~ s/b(\w+)//;
 $maxpaper = $1 if $xopts =~ s/p(\w+)//;
-$maxpaper =~ m/^a[134]$/ or confess;
+$maxpaper =~ m/^a[134]$|^a1m$/ or confess;
 
 ($facesf, @ARGV) = @ARGV or die;
 parse_input_graph();
@@ -872,7 +1054,7 @@ prep_region_rmap();
 read_faces();
 calculate_centres();
 transform_coordinates();
-adjust_nz();
+adjust_sea();
 
 computeboundings();
 preamble();
@@ -884,7 +1066,6 @@ decks();
 sea_track();
 hs_initial();
 play_hint();
-showboundings();
 postamble();
 
 print STDERR Dumper(\%region) if $ENV{'GENERATE_BOARD_DUP'};