move stuff into Parse.pm; build system

[pandemic-rising-tide.git] / parse-input-graph

diff --git a/parse-input-graph b/parse-input-graph
index 2d120cb81f5ea8b91e983dcc6688a28e998d8066..c39e583c4b61ca6622923a6b1da16d6524976bcc 100755 (executable)
--- a/parse-input-graph
+++ b/parse-input-graph
@@ -2,161 +2,10 @@
 
 use strict;
 use Carp;
-use Data::Dumper;
-use Graph;
-use List::MoreUtils qw(any);
 
-our %region;
-# $region{NAME}{Colour}
-# $region{NAME}{Water}
-# $region{NAME}{L} # line number
-# $region{NAME}{Adj}[]{Name}
-# $region{NAME}{Adj}[]{Pattern}
-# $region{NAME}{Adj}[]{Regexp}
-# $region{NAME}{Adj}[]{Dikes}
-# $region{NAME}{Adj}[]{L}
+BEGIN { unshift @INC, qw(.); }
 
-our %adj;
-# $adj{EARLIER}{LATER}{Dikes}
-# $adj{EARLIER}{LATER}{L}[]
-# $adj{EARLIER}{LATER}{T}[]
-
-sub read_in () {
-  my $ccolour;
-  my $cregion;
-
-  while (<>) {
-    next if m{^\s*\#};
-    next unless m{\S};
-    s{\s+$}{} or confess;
-    if (m{^\w+}) {
-      $ccolour = $&;
-      next;
-    }
-    if (my ($name, $water) = m{^\t(\S.*\w|L)(?: \[(\d+)\])?$}) {
-      confess unless defined $ccolour;
-      confess "$name ?" if $region{$name};
-      $region{$name}{Colour} = $ccolour;
-      $region{$name}{Water} = $water;
-      $region{$name}{L} = $.;
-      $cregion = $name;
-      next;
-    }
-    if (my ($aref, $adikes) = m{^\t\t(\S.*[A-Za-z.]|L)(?: (\+\+?))?$}) {
-      my $adj = { Dikes => (length $adikes // 0), L => $. };
-      if ($aref =~ m{\.}) {
-       $adj->{Pattern} = $aref;
-       $aref =~ s{\-}{[^- ]*-}g;
-       $aref =~ s{\.+}{
-            length $& eq 1 ? qr{[^- ]* ?} :
-            length $& eq 2 ? qr{.*}       : confess "$aref"
-        }ge;
-       $adj->{Regexp} = $aref;
-      } else {
-       $adj->{Name} = $aref;
-      }
-      push @{ $region{$cregion}{Adj} }, $adj;
-      next;
-    }
-    confess "$_ ?";
-  }
-}
-
-sub unique_aref ($$) {
-  my ($ra, $adja) = @_;
-  my $re = $adja->{Regexp};
-  return $adja->{Name} unless defined $re;
-  my @cands;
-  foreach my $rb (sort keys %region) {
-    #print STDERR "?? $ra -> $re $rb ?\n";
-    foreach my $adjb (@{ $region{$rb}{Adj} }) {
-      my $adjbn = $adjb->{Name};
-      next unless defined $adjbn;
-      #print STDERR "?? $ra -> $re $rb ?? $adjbn\n";
-      next unless $adjbn eq $ra;
-      push @cands, [ $rb, "$region{$rb}{L},$adjb->{L}" ];
-    }
-  }
-  my @found = grep { $_->[0] =~ m{^$re$} } @cands;
-  my $pr = sub {
-    join ' / ', map { "$_->[0] ($_->[1])" } @_;
-  };
-  confess "$adja->{L} $adja->{Pattern} /$re/ | ".$pr->(@cands)
-      ." | ".$pr->(@found)." | ?"
-      unless @found==1;
-  my $r = $found[0][0];
-  #print STDERR "resolve $ra -> $adja->{Pattern} = $r\n";
-  return $r;
-}
-
-sub region_cmp {
-  ($a eq 'L' ) <=> ($b eq 'L' ) or
-  ($a eq 'NZ') <=> ($b eq 'NZ') or
-   $a          cmp  $b
-}
-
-sub resolve_arefs () {
-  #print Dumper(\%region);
-  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;
-    }
-  }
-}
-
-sub adjacencies () {
-  foreach my $ra (sort keys %region) {
-    my $adjs = $region{$ra}{Adj};
-    foreach my $adji (0..$#$adjs) {
-      my $adja = $adjs->[$adji];
-      my $rb = $adja->{Name};
-      my ($r0,$r1) = sort region_cmp ($ra,$rb);
-      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};
-    }
-  }
-  my $ndikes = 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};
-    }
-  }
-  print STDERR "total $ndikes dikes\n";
-}
-
-sub edge_id_to_other_id ($$) {
-  my ($ra, $adjia) = @_;
-  my $adjsa = $region{$ra}{Adj};
-  my $adja = $adjsa->[$adjia];
-  my $rb = $adja->{Name};
-  my $adjsb = $region{$rb}{Adj};
-  foreach my $adjib (0..$#$adjsb) {
-    my $adjb = $adjsb->[$adjib];
-    next unless $adjb->{Name} eq $ra;
-    # $adjb is the same edge seen from the other side
-    return ($rb, $adjib);
-  }
-  confess "$ra $adjia ?";
-}
-
-sub o { print @_ or die $!; }
+use Parse;
 
 sub plag_prs ($) {
     my ($t) = @_;
@@ -179,9 +28,7 @@ sub output_planar_graph () {
 
 }
 
-read_in();
-resolve_arefs();
-adjacencies();
+parse_input_graph();
 output_planar_graph();
 
 # Local variables: