X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=Parse.pm;h=df732e8ae7f75c5ad23e2d290706abe872f5d437;hb=80d5c2f420e30982360cd7398e63898e05111c9f;hp=51cb1fa17e68bf948f8ce2dadb07dd724e33727a;hpb=d7a7f0d55b318d3db7cac6806b189b8039819a65;p=pandemic-rising-tide.git

diff --git a/Parse.pm b/Parse.pm
index 51cb1fa..df732e8 100644
--- a/Parse.pm
+++ b/Parse.pm
@@ -1,3 +1,39 @@
+# Parse.pm - module for parsing board definitions
+#   for games very like Pandemic Rising Tide
+#
+# Copyright (C) 2019 Ian Jackson
+#
+# This program is dual licensed, GPv3+ or CC-BY-SA 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 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.
 
 package Parse;
 
@@ -8,20 +44,25 @@ use Graph;
 use Exporter;
 
 our @ISA = qw(Exporter);
-our @EXPORT = qw(parse_input_graph o %region %adj);
+our @EXPORT = qw(parse_input_graph o plag_prs %region %c);
+
+our %c;
+require 'misc-data.pl';
 
 our %region;
 # $region{NAME}{Colour}
 # $region{NAME}{Water}
+# $region{NAME}{Name}
 # $region{NAME}{L} # line number
 # $region{NAME}{Adj}[]{Name}
+# $region{NAME}{Adj}[]{DisplayName}[]
 # $region{NAME}{Adj}[]{Pattern}
 # $region{NAME}{Adj}[]{Regexp}
-# $region{NAME}{Adj}[]{Dikes}
+# $region{NAME}{Adj}[]{Dykes}
 # $region{NAME}{Adj}[]{L}
 
 our %adj;
-# $adj{EARLIER}{LATER}{Dikes}
+# $adj{EARLIER}{LATER}{Dykes}
 # $adj{EARLIER}{LATER}{L}[]
 # $adj{EARLIER}{LATER}{T}[]
 
@@ -37,17 +78,30 @@ sub read_in () {
       $ccolour = $&;
       next;
     }
-    if (my ($name, $water) = m{^\t(\S.*\w|L)(?: \[(\d+)\])?$}) {
+    if (my ($name, $water) = m{^\t(\S.*\w|L2?)(?: \[(\d+)\])?$}) {
       confess unless defined $ccolour;
+      my $dname = $c{DisplayNames}{$name} // $name;
+      $name =~ s{/}{}g;
       confess "$name ?" if $region{$name};
       $region{$name}{Colour} = $ccolour;
       $region{$name}{Water} = $water;
       $region{$name}{L} = $.;
+      if ($dname =~ m{/}) {
+	$dname =~ s{(?<!-)/(?! )}{-/}g;
+	$region{$name}{DisplayName} = [ grep m/./, split m{ */ *}, $dname ];
+      } else {
+	$region{$name}{DisplayName} = [ split m{(?<=-)| }, $dname ];
+      }
       $cregion = $name;
       next;
     }
-    if (my ($aref, $adikes) = m{^\t\t(\S.*[A-Za-z.]|L)(?: (\+\+?))?$}) {
-      my $adj = { Dikes => (length $adikes // 0), L => $. };
+    if (my ($aref, $adykes, $dwdyke) =
+	m{^\t\t(\S.*[A-Za-z.]|L2?)(?: (\+\+?)(\@?))?$}) {
+      my $adj = {
+		 Dykes => (length $adykes // 0),
+		 Deltawerk => !!$dwdyke,
+		 L => $.
+		};
       if ($aref =~ m{\.}) {
 	$adj->{Pattern} = $aref;
 	$aref =~ s{\-}{[^- ]*-}g;
@@ -95,7 +149,8 @@ sub unique_aref ($$) {
 
 sub region_cmp {
   ($a eq 'L' ) <=> ($b eq 'L' ) or
-  ($a eq 'NZ') <=> ($b eq 'NZ') or
+  ($a eq 'L2') <=> ($b eq 'L2') or
+  ($a eq $c{Sea}) <=> ($b eq $c{Sea}) or
    $a          cmp  $b
 }
 
@@ -129,20 +184,26 @@ sub adjacencies () {
       push @{ $adj{$r0}{$r1}{L} }, $adja->{L};
       push @{ $adj{$r0}{$r1}{T} }, substr($ra,0,1)."#".$adji;
       my $e = $adj{$r0}{$r1};
-      $e->{Dikes} //= $adja->{Dikes};
-      confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dikes} $adja->{Dikes} ?"
-	  unless $e->{Dikes} == $adja->{Dikes};
+      $e->{Dykes} //= $adja->{Dykes};
+      confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dykes} $adja->{Dykes} ?"
+	  unless $e->{Dykes} == $adja->{Dykes};
     }
   }
-  my $ndikes = 0;
+  my $ndykes = 0;
   foreach my $r0 (sort keys %adj) {
     foreach my $r1 (sort keys %{ $adj{$r0} }) {
       my $e = $adj{$r0}{$r1};
       confess "$r0 / $r1 : @{ $e->{L} } ?" unless @{ $e->{L} } == 2;
-      $ndikes += $e->{Dikes};
+      $ndykes += $e->{Dykes};
     }
   }
-  #print STDERR "total $ndikes dikes\n";
+  #print STDERR "total $ndykes dykes\n";
+}
+
+sub names () {
+  foreach my $r (sort keys %region) {
+    $region{$r}{Name} = $r;
+  }
 }
 
 sub edge_id_to_other_id ($$) {
@@ -162,10 +223,19 @@ sub edge_id_to_other_id ($$) {
 
 sub o { print @_ or die $!; }
 
+sub plag_prs ($) {
+    my ($t) = @_;
+    $t = $` if $t =~ m/\n/;
+    $t =~ s/ //g;
+    $t =~ s/-//g;
+    return "$t";
+}
+
 sub parse_input_graph () {
   read_in();
   resolve_arefs();
   adjacencies();
+  names();
 }
 
 1;