+# 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;
use Exporter;
our @ISA = qw(Exporter);
-our @EXPORT = qw(parse_input_graph o plag_prs %region);
+our @EXPORT = qw(parse_input_graph o plag_prs %region %c);
+
+our %c;
+require 'misc-data.pl';
our %region;
# $region{NAME}{Colour}
# $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}[]
$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;
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
}
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 () {