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