layout/extractgraph

   1 #!/usr/bin/perl -w
   2 #
   3 # Reads the special comments in the subsegment encoding output from
   4 # layout, determines the segment graph, and outputs a description of
   5 # that graph.
   6
   7 # Approach/algorithm:
   8 #
   9 #  We read the segenco.ps and each time we find a `%L segmentpart'
  10 #  comment we add it to an annotated graph we construct.  Each node in
  11 #  the annotated graph is a tuple consisting of a loc and range of
  12 #  layer levels.  Each edge is a segment part from a %L comment.  Each
  13 #  node has a `front' and a `back', and each edget attach either to
  14 #  one or the other.
  15 #
  16 #  Only segment parts with certain layer kinds are processed: by
  17 #  default, only the empty layer kind.
  18 #
  19 #  When a loc is found in the input, as one end of a segmentpart, it
  20 #  is considered identical to a existing node (if its details are
  21 #  sufficiently similar) or creates a new node (if its details are
  22 #  sufficiently different).  If the segmentpart's end is considered
  23 #  identical to an existing node then the existing node's layer level
  24 #  range is extended, but the existing node's X Y and A are not
  25 #  modified.
  26 #
  27 #  A loc and layer level are compared with a node as follows:
  28 #
  29 #    The difference between each of the loc's details and the node's
  30 #    details is computed.  If any of the differences is at least the
  31 #    min clearance, then the loc/layerb is a new node.  Otherwise, all
  32 #    of the differences must be within the max tolerance and the
  33 #    loc/layer is the same as the node (coming out of the back if the
  34 #    180deg was added to make the angle difference).  Otherwise it is
  35 #    an error.
  36 #
  37 #    The detail differences are:
  38 #       Position difference: horizontal distance between loc and node
  39 #       Angle difference: difference betwen loc's and node's A, or
  40 #        difference minus 180deg between loc's and node's A, whichever
  41 #        is the smaller (both reduced mod 360deg to value with
  42 #        smallest magnitude).
  43 #       Level difference: 0 if layer level is within node's range
  44 #        or distance by which it is outside that range.
  45
  46 use strict qw(vars);
  47 use POSIX;
  48
  49 our %conf;
  50 $conf{MinClearLayer}= 6;
  51 $conf{MaxTolerLayer}= 4;
  52 $conf{MinClearDist}= 0.5;
  53 $conf{MaxTolerDist}= 0.05;
  54 $conf{MinClearAngle}= 5.0;
  55 $conf{MaxTolerAngle}= 0.5;
  56 $conf{LayerKinds}= ','; # comma-separated list as for split /\,/, ..., -1;
  57 $conf{EvenUnknownSegments}= 0;
  58
  59 our @layerkinds;
  60 @layerkinds= split /\,/, $conf{LayerKinds}, -1;
  61
  62 our @nodes;
  63 # $nodes[]{X}
  64 # $nodes[]{Y}
  65 # $nodes[]{A}
  66 # $nodes[]{NodeNum}
  67 # $nodes[]{LayerMin}
  68 # $nodes[]{LayerMax}
  69 # $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
  70
  71 our @edges;
  72 # $edges[]{"Node$far"}= [ \$nodes[], $back ]
  73 # $edges[]{Dist}
  74 # $edges[]{EdgeNum}
  75 # $edges[]{SubSegSpec}
  76
  77 our %segments;
  78 # $segments{$segname}{MovFeats}[$movfeatnum]{Name}
  79 # $segments{$segname}{MovFeats}[$movfeatnum]{Positions}
  80 # $segments{$segname}{MovFeatMap}{$movfeatname}= $movfeatnum
  81
  82 sub comment ($) {
  83     print "/* $_[0] */\n";
  84 }
  85
  86 sub sqr ($) { return $_[0]*$_[0]; }
  87
  88 sub find_node (@) {
  89     my ($lni,$isdest,$l,$x,$y,$a) = @_;
  90     my ($any_outside_toler, $any_outside_clear, $updlayer);
  91     my ($ni, $nodei, $node, %diff, $back, $d, $k, $pinfo);
  92     $pinfo= sprintf "%.2f %.2f %.2f", $x,$y,$a;
  93     $a -= 360.0 * floor($a / 360.0);
  94     for ($nodei=0; $nodei<@nodes; $nodei++) {
  95         $node= $nodes[$nodei];
  96         $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
  97                        ($d = $l - $node->{LayerMax}) > 0 ? $d :
  98                        0);
  99         $diff{Dist}= sqrt(sqr($x - $node->{X}) +
 100                           sqr($y - $node->{Y}));
 101         $diff{Angle}= $a - $node->{A};                    # <-360,360>
 102         if ($diff{Angle} < 0) { $diff{Angle} += 360; }    # [0,360>
 103         $back= $diff{Angle} >= 90 && $diff{Angle} < 270;  # $back <=> [90,270>
 104         if ($back) { $diff{Angle} -= 180; }               # [0,90> or [270,360>
 105         $back= !!$isdest != !!$back; # logical xor
 106         $back += 0;
 107         if ($diff{Angle} > 180) { $diff{Angle} -= 360; }  # [-90,90>
 108         $any_outside_clear= 0;
 109         $any_outside_toler= 0;
 110         foreach $k (keys %diff) {
 111             if (abs($diff{$k}) >= $conf{"MinClear$k"}) {
 112                 $any_outside_clear=1; last;
 113             } elsif (abs($diff{$k}) <= $conf{"MaxToler$k"}) {
 114             } else {
 115                 $any_outside_toler=1;
 116             }
 117         }
 118         if ($any_outside_clear) {
 119         } elsif ($any_outside_toler) {
 120             die ("mismatch/clash:\n".
 121                  " $lni has L=$l XY=$x,$y A=$a\n".
 122                  " $node->{LineInfo} has ".
 123                  "L=$node->{LayerMin}..$node->{LayerMax}".
 124                  " XY=$node->{X},$node->{Y} A=$node->{A}\n ");
 125         } else {
 126             $updlayer= ($diff{Layer} < 0 ? "Min" :
 127                         $diff{Layer} > 0 ? "Max" :
 128                         '');
 129             if ($updlayer) {
 130                 $node->{"Layer$updlayer"}= $l;
 131                 $node->{LineInfo}.="($l<-$lni)";
 132             }
 133             comment("nodulated $lni ex.$nodei/$back ($pinfo)");
 134             return ($node,$back);
 135         }
 136     }
 137     $node= { X => $x, Y => $y, A => $a, NodeNum => scalar(@nodes),
 138              LayerMin => $l, LayerMax => $l, LineInfo => $lni };
 139     $back= $isdest;
 140     push @nodes, $node;
 141     comment("nodulated $lni new$#nodes/$back ($pinfo)");
 142     return ($node,$back);
 143 }
 144
 145 sub readin () {
 146     my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist);
 147     my ($edgenum,$node,$back,$far,@nodeinfo,@endnums,$edge);
 148     while (<>) {
 149         next unless m/^\%L /;
 150         die unless m/^\%L (\w+)\b/;
 151         next unless $1 eq 'segmentpart';
 152         die unless
 153             m/^\%L segmentpart (\d+) ([A-Za-z_]*)(\d+) (\S+) ([-.eE0-9 ]+)$/;
 154         ($edgenum, $layerkind, $level, $subsegspec, $numbers) =
 155             ($1,$2,$3,$4,$5);
 156         next unless grep { $layerkind eq $_ } @layerkinds;
 157         next unless $subsegspec =~ m,^[^/], or $conf{EvenUnknownSegments};
 158         @numbers = map { $_ + 0 } split / /, $numbers;
 159         $dist= shift @numbers;
 160         @numbers == 6 or die;
 161         $edge= { EdgeNum => $edgenum,
 162                  Dist => $dist,
 163                  SubSegSpec => $subsegspec };
 164         for ($far=0; $far<2; $far++) {
 165             @endnums= @numbers[($far*3)..($far*3+2)];
 166             ($node,$back)= find_node("$.:$far",$far,$level,@endnums);
 167             $edge->{"Node$far"}= [ $node, $back ];
 168             push @{ $node->{"Edges$back"} }, [ $edge, $far ];
 169         }
 170         push @edges, $edge;
 171     }
 172 }
 173
 174 sub o ($@) {
 175     print join('',@_) or die $!;
 176 }
 177
 178 sub pr ($$) {
 179     my ($kind,$ref) = @_;
 180     my ($n);
 181     $n= $ref->{"${kind}Num"};
 182     return sprintf "%s%d", lc($kind), $n;
 183 }
 184
 185 sub pr_edgeend ($) {
 186     my ($edgeend) = @_;
 187     my ($edge,$end) = @$edgeend;
 188     my ($endnum);
 189     $endnum= $end ^ !!($edge->{SubSegSpec} =~ m/^\-/);
 190     return pr(Edge,$edge).".ends[$endnum]";
 191 }
 192
 193 sub segments () {
 194     my ($edge, $sss);
 195     my ($segname, $movfeatpos, $movfeat, $movpos);
 196     my ($movfeatnum, $movfeatref);
 197     for $edge (@edges) {
 198         $sss= $edge->{SubSegSpec};
 199         $sss =~ m,^\-?(\w*)/(([A-Za-z]*)(\d*))$, or die "$sss ?";
 200         ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
 201         if (!exists $segments{$segname}) {
 202             $segments{$segname}= {
 203                 MovFeatMap => { '' => 0 },
 204                 MovFeats => [ { Name => '', Positions => 1 } ]
 205             };
 206         }
 207         $movfeatnum= $segments{$segname}{MovFeatMap}{$movfeat};
 208         if (!defined $movfeatnum) {
 209             $movfeatnum= @{ $segments{$segname}{MovFeats} };
 210             push @{ $segments{$segname}{MovFeats} },
 211                 { Name => $movfeat, Positions => 0 };
 212             $segments{$segname}{MovFeatMap}{$movfeat}= $movfeatnum;
 213         }
 214         $movfeatref= $segments{$segname}{MovFeats}[$movfeatnum];
 215         if (length $movfeat && $movpos >= $movfeatref->{Positions}) {
 216             $movfeatref->{Positions}= $movpos + 1;
 217         }
 218     }
 219 }
 220
 221 sub writeout () {
 222     my ($node, $edge, $i, $side, $sideedges);
 223     my ($end, $endnum, $sss, $reverse, $nodeside, $connectnum, $j, $edgeend);
 224     my ($segname, $segment, $movfeats, $movfeat, $delim);
 225     my ($movfeatpos, $movpos, $maxedgenum);
 226     o("\n");
 227     o("#include \"graph-data.h\"\n");
 228     for $node (@nodes) { o("static Node ",pr(Node,$node),";\n"); }
 229     for $edge (@edges) { o("static Edge ",pr(Edge,$edge),";\n"); }
 230     o("\n");
 231     for $segname (keys %segments) {
 232         $segment= $segments{$segname};
 233         $movfeats= $segment->{MovFeats};
 234         o("static MovFeat movfeats_$segname","[];\n");
 235         o("static Segment segment_$segname= {");
 236         o(" \"$segname\",");
 237         o(" ",scalar(@$movfeats),", movfeats_$segname");
 238         o(" };\n");
 239         o("static MovFeat movfeats_$segname","[]= {");
 240         $delim= "";
 241         for $movfeat (@$movfeats) {
 242             o("$delim\n");
 243             o("  { &segment_$segname, ");
 244             o(length $movfeat->{Name} ? "\"$movfeat->{Name}\"" : 0);
 245             o(", ", $movfeat->{Positions}+0);
 246             o(" }");
 247             $delim= ",";
 248         }
 249         o("\n};\n");
 250     }
 251     o("\n");
 252     for ($i=0; $i<@nodes; $i++) {
 253         $node= $nodes[$i];
 254         o("static Node ",pr(Node,$node),"= { \"$i\",\n");
 255         o("  ".($i>0 ? '&'.pr(Node,$nodes[$i-1]) : '0').
 256           ", ".($i<$#nodes ? '&'.pr(Node,$nodes[$i+1]) : '0'));
 257         o(", {");
 258         $delim= '';
 259         for ($side=0; $side<2; $side++) {
 260             o("$delim\n    { &".pr(Node,$node).", $side,");
 261             $sideedges= $node->{"Edges$side"};
 262             if (defined $sideedges && @$sideedges) {
 263                 o("\n      ",
 264                   '&'.pr_edgeend($sideedges->[0]),
 265                   ", ",
 266                   '&'.pr_edgeend($sideedges->[$#$sideedges]));
 267             } else {
 268                 o(' 0, 0');
 269             }
 270             o(" }");
 271             $delim= ',';
 272         }
 273         o("\n  }\n};\n");
 274     }
 275     o("\n");
 276     $maxedgenum=-1;
 277     for ($i=0; $i<@edges; $i++) {
 278         $edge= $edges[$i];
 279         o("static Edge ",pr(Edge,$edge),"= { \"$edge->{EdgeNum}\",\n");
 280         if ($edge->{EdgeNum} > $maxedgenum) {
 281             $maxedgenum= $edge->{EdgeNum};
 282         }
 283         o("  $edge->{Dist}, ");
 284         $sss= $edge->{SubSegSpec};
 285         o("/* $sss */ ");
 286         $reverse= !!($sss =~ s/^\-//);
 287         $sss =~ m,^(\w*)/(([A-Za-z]*)(\d*))$, or die;
 288         ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
 289         o("&movfeats_${segname}","[",
 290           $segments{$segname}{MovFeatMap}{$movfeat},
 291           "], ",
 292           (length $movfeat ? $movpos : 0),
 293           ", {");
 294         $delim= '';
 295         for ($endnum=0; $endnum<2; $endnum++) {
 296             $end= $endnum ^ $reverse;
 297             o("$delim\n    {");
 298             $nodeside= $edge->{"Node$end"};
 299             $node= $nodeside->[0]; $side= $nodeside->[1];
 300             $sideedges= $node->{"Edges$side"};
 301             undef $connectnum;
 302             for ($j=0; $j<@$sideedges; $j++) {
 303                 $edgeend= $sideedges->[$j];
 304                 if ($edgeend->[0] == $edge &&
 305                     $edgeend->[1] == $end) {
 306                     die if defined $connectnum;
 307                     $connectnum= $j;
 308                 }
 309             }
 310             die unless defined $connectnum;
 311             o(" ".($connectnum > 0 ?
 312                    '&'.pr_edgeend($sideedges->[$connectnum-1]) : '0'),
 313               ", ".($connectnum < $#$sideedges ?
 314                     '&'.pr_edgeend($sideedges->[$connectnum+1]) : '0'));
 315             o(",\n      &".pr(Edge,$edge),", $endnum, ",
 316               "&".pr(Node,$node).".sides[$side]");
 317             o(" }");
 318             $delim= ',';
 319         }
 320         o("\n  }\n};\n");
 321     }
 322     o("\n");
 323     o("NodeList all_nodes= { ",
 324       (@nodes ? '&'.pr(Node,$nodes[0]) : 0), ", ",
 325       (@nodes ? '&'.pr(Node,$nodes[$#nodes]) : 0),
 326       " };\n");
 327     o("int next_nodenum= ".scalar(@nodes).";\n".
 328       "int next_edgenum= ".($maxedgenum+1).";\n");
 329 }
 330
 331 o("/*autogenerated - do not edit*/\n\n");
 332 readin();
 333 segments();
 334 writeout();
 335
 336
 337 #    ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A},
 338 #     $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) =
 339 #    $node[0]
 340
 341 #(\w+(?:(?:\/([A-Za-z]+)(\d+))?)?)