wip

diff --git a/parse-input-graph b/parse-input-graph
index 8b5a16d0d011cf8a4482604e8f9b23c216030adb..8bf53fc8e495bc7a2d45c6e5226feef3fe18b6d0 100755 (executable)
--- 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();