generate-board

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Carp;
   5 use Data::Dumper;
   6 use Math::GSL::Vector;
   7 use Math::GSL::Matrix;
   8
   9 BEGIN { unshift @INC, qw(.); }
  10
  11 use Parse;
  12
  13 our $facesf;
  14 our %vxname2pos; # $vxname2pos{VXNAME} = Math::GSL::Vector
  15
  16 # ----- region names from plag, incl. reverse mapping -----
  17
  18 our %prs2region;
  19
  20 sub prep_region_rmap () {
  21   foreach my $rn (keys %region) {
  22     my $prs = plag_prs($rn);
  23     die if $prs2region{$prs};
  24     $prs2region{$prs} = $rn;
  25   }
  26
  27   # bodgery for the sea and land
  28   $prs2region{'NZ | L'} = 'NZ';
  29   $prs2region{'L | NZ'} = 'NZ';
  30 }
  31
  32 our $sre = qr{(?:(\")|(?=\w))(.*)\1$}; # 2 captures, $2 is the name
  33
  34 sub prs2r ($) { $prs2region{$_[0]} // confess "@_ ?" }
  35 sub prs2rr ($) { $region{prs2r($_[0])} }
  36
  37 #----- file reader for plag output -----
  38
  39 sub read_faces () {
  40   # Sets
  41   #  $region{NAME}{Adj}[]{Ends}[]{VxName}
  42   #  $region{NAME}{Adj}[]{Ends}[]{Pos}
  43   #  $region{NAME}{Polygon}{Pos}
  44   #
  45   # also incidentally
  46   #  $region{NAME}{Adj}[]{Ends}[]{Adjoins}
  47   #  $region{NAME}{Polygon}{Adjoins}
  48   # which should be ignored
  49
  50   open P, "<", $facesf or die $!;
  51   while (<P>) { last if m/^\&faces$/; }
  52   my $rr;
  53   my @edges;
  54   my $process_rr = sub {
  55     my $last_ai;
  56     if ($rr->{Name} eq 'NZ') {
  57       # We combined L and NZ; now we must split them again
  58       # in fact, we just throw away L entirely.
  59       # Here, when processing NZ, we keep only vertices that
  60       # are part of NZ.
  61       @edges = grep {
  62         my $evxname = $_->{VxName};
  63         my @eregions = split / \| ?/, $evxname;
  64         grep { $_ eq 'NZ' } @eregions
  65       } @edges;
  66     }
  67     $rr->{Polygon} = [ @edges ];
  68     if ($rr->{Name} ne 'NZ') {
  69       for my $ei (0..$#edges) {
  70         my $ej = $ei % @edges;
  71         if (!defined $last_ai) {
  72           my $ai;
  73           for my $ai (0..$#{ $rr->{Adj} }) {
  74             next unless $rr->{Adj}[$ai]{Name} eq $edges[$ei]{Adjoins};
  75             $last_ai = $ai+1;
  76           }
  77           confess $edges[$ei]{Adjoins}.' ?' unless defined $last_ai;
  78         }
  79         my $ai = ($last_ai-1+@edges) % @edges;
  80         $last_ai = $ai;
  81         my $adj = $rr->{Adj}[$ai];
  82         confess Dumper($rr, \@edges, $ei, $ej, $adj, $last_ai, $ai)." ?"
  83             unless $adj->{Name} eq $edges[$ei]{Adjoins};
  84
  85         for my $endi (0..1) {
  86           $adj->{Ends}[$endi] = $edges[ ($ei + $endi) % @edges ];
  87         }
  88       }
  89     }
  90     @edges = ();
  91     $rr = undef;
  92   };
  93   my $vxname;
  94   for (;;) {
  95     $!=0; $_=<P> // confess $!;
  96     last if m/^\&$/;
  97     if (m/^$sre$/) {
  98       my $new_face= $2;
  99       $process_rr->() if $rr;
 100       $rr= prs2rr($new_face);
 101     } elsif (m/^\s+$sre$/) {
 102       confess unless $rr;
 103       $vxname = $2;
 104       push @edges, { VxName => $vxname };
 105     } elsif (m/^\s+\^adjoins\s+$sre$/) {
 106       $edges[-1]{Adjoins} = prs2r($2);
 107     } elsif (m/^\s+\^\@([-e.0-9]+)\,([-e.0-9]+)$/) {
 108       my $pos = Math::GSL::Vector->new([$1,$2]);
 109       confess unless defined $vxname;
 110       $edges[-1]{Pos} = $pos;
 111       $vxname2pos{$vxname} = $pos;
 112     }
 113   }
 114   $process_rr->();
 115 }
 116
 117 #----- main program -----
 118
 119 ($facesf, @ARGV) = @ARGV or die;
 120 parse_input_graph();
 121 prep_region_rmap();
 122 read_faces();
 123
 124 print Dumper(\%region);
 125
 126 # Local variables:
 127 # cperl-indent-level: 2
 128 # End.