From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 13 Jan 2019 23:44:24 +0000 (+0000)
Subject: wip
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?a=commitdiff_plain;h=cfb3888365139154351426ad89fe0dfdbc36edac;p=pandemic-rising-tide.git

wip
---

diff --git a/parse-input-graph b/parse-input-graph
index 8b5a16d..8bf53fc 100755
--- a/parse-input-graph
+++ b/parse-input-graph
@@ -1,10 +1,88 @@
 #!/usr/bin/perl -w
 
 use strict;
+use Carp;
 
 our %region;
-# $region{NAME}{Colour}[]{Name}
+# $region{NAME}{Colour}
+# $region{NAME}{Water}
 # $region{NAME}{Adj}[]{Name}
 # $region{NAME}{Adj}[]{Regexp}
 # $region{NAME}{Adj}[]{Dikes}
 
+sub read_in () {
+    my $ccolour;
+    my $cregion;
+
+    while (<>) {
+	next if m{^\s*\#};
+	next unless m{\S};
+	s{\s+$}{};
+	chomp or confess;
+	if (m{^\w+}) {
+	    $ccolor = $&;
+	    next;
+	}
+	if {my ($name, $water) = m{^\t+(\S.*\S)(?: \[(\d+)\])$}) {
+	    confess unless defined $ccolour;
+	    confess if $region{$name};
+	    $region{$name}{Colour} = $ccolour;
+	    $region{$name}{Water} = $water;
+	    $cregion = $name;
+	    next;
+	}
+	if (my ($aref, $adykes) = m{^\t\t(\S.*\S)(?: (\+\+?)$}) {
+	    my $adj = { Dykes => length $adykes };
+	    if ($aref =~ {\.}) {
+		$aref =~ s{\-}{[^- ]*-};
+		$aref =~ s{\.}{[^- ]* ?};
+		$adj->{Regexp} = $aref;
+	    } else {
+		$adj->{Name} = $aref;
+	    }
+	    push @{ $region{$cregion}{Adj} }, $adj;
+	    next;
+	}
+	confess "$_ ?";
+    }
+}
+
+sub unique_aref ($$) {
+    my ($ra, $adja) = @_;
+    my $re = $adj->{Regexp};
+    return $adj->{Name} unless defined $re;
+    my @found;
+    foreach my $rb (sort keys %region) {
+	next unless $rb =~ m{^$re$};
+	foreach my $adjb (@{ $region{rb}{Adj} }) {
+	    my $adjbn = $adjb->{Name};
+	    next unless defined $adjbn;
+	    next unless $adjbn eq $ra;
+	}
+    }
+    confess "$ra $re @found ?" unless @found==1;
+    print "resolve $ra -> $re  as @found\n";
+    return $found[1];
+}   
+
+sub resolve_arefs () {
+    foreach my $ra (sort keys $region) {
+	foreach my $adj (@{ $region{$ra}{Adj} }) {
+	    next if defined $adj->{Name};
+	    $adj->{ProspectiveName} = unique_aref $ra, $adj;
+	}
+    }
+    foreach my $ra (sort keys $region) {
+	foreach my $adj (@{ $region{$ra}{Adj} }) {
+	    $adj->{Name} //= $adj->{ProspectiveName};
+	}
+    }
+    foreach my $ra (sort keys $region) {
+	foreach my $adj (@{ $region{$ra}{Adj} }) {
+	    confess unless $adj->{Name} eq unique_aref $ra, $adj;
+	}
+    }
+}
+
+read_in();
+resolve_arefs();