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
  48 our %conf;
  49 $conf{MinClearLayer}= 6;
  50 $conf{MaxTolerLayer}= 4;
  51 $conf{MinClearDist}= 0.5;
  52 $conf{MaxTolerDist}= 0.05;
  53 $conf{MinClearAngle}= 5.0;
  54 $conf{MaxTolerAngle}= 0.5;
  55 $conf{LayerKinds}= ','; # comma-separated list as for split /\,/, ..., -1;
  56
  57 our @layerkinds;
  58 @layerkinds= split /\,/, $conf{LayerKinds}, -1;
  59
  60 our @nodes;
  61 # $nodes[$nodenum]{X}
  62 # $nodes[$nodenum]{Y}
  63 # $nodes[$nodenum]{A}
  64 # $nodes[$nodenum]{LayerMin}
  65 # $nodes[$nodenum]{LayerMax}
  66
  67 our @links;
  68 # $links[]= [ $nodenum0, $back0, $nodenum1, $back1, $dist, $subsegspec ];
  69
  70 sub comment ($) {
  71     print "/* $_[0] */\n";
  72 }
  73
  74 sub sqr ($) { return $_[0]*$_[0]; }
  75
  76 sub find_node (@) {
  77     my ($lni,$isdest,$l,$x,$y,$a) = @_;
  78     my ($any_outside_toler, $any_outside_clear, $updlayer);
  79     my ($ni, $node, %diff, $back, $d, $k);
  80     for ($ni=0; $ni<@nodes; $ni++) {
  81         $node= $nodes[$ni];
  82         $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
  83                        ($d = $l - $node->{LayerMax}) > 0 ? $d :
  84                        0);
  85         $diff{Dist}= sqrt(sqr($x - $node->{X}) +
  86                           sqr($y - $node->{Y}));
  87         $diff{Angle}= $a - $node->{A};                    # <-360,360>
  88         if ($diff{Angle} < 0) { $diff{Angle} += 360; }    # [0,360>
  89         $back= $diff{Angle} >= 90 && $diff{Angle} < 270;  # $back <=> [90,270>
  90         $back= !!$isdest != !!$back; # logical xor
  91         $back += 0;
  92         if ($back) { $diff{Angle} -= 180; }               # [0,90> or [270,360>
  93         if ($diff{Angle} > 180) { $diff{Angle} -= 360; }  # [-90,90>
  94         $any_outside_clear= 0;
  95         $any_outside_toler= 0;
  96         foreach $k (keys %diff) {
  97             if (abs($diff{$k}) >= $conf{"MinClear$k"}) {
  98                 $any_outside_clear=1; last;
  99             } elsif (abs($diff{$k}) <= $conf{"MaxToler$k"}) {
 100             } else {
 101                 $any_outside_toler=1;
 102             }
 103         }
 104         if ($any_outside_clear) {
 105         } elsif ($any_outside_toler) {
 106             die ("mismatch/clash:\n".
 107                  " $lni has L=$l XY=$x,$y A=$a\n".
 108                  " $node->{LineInfo} has ".
 109                  "L=$node->{LayerMin}..$node->{LayerMax}".
 110                  " XY=$node->{X},$node->{Y} A=$node->{A}\n ");
 111         } else {
 112             $updlayer= ($diff{Layer} < 0 ? "Min" :
 113                         $diff{Layer} > 0 ? "Max" :
 114                         '');
 115             if ($updlayer) {
 116                 $node->{"Layer$updlayer"}= $l;
 117                 $node->{LineInfo}.="($l<-$lni)";
 118             }
 119             comment("nodulated $lni ex.#$ni/$back");
 120             return ($ni,$back);
 121         }
 122     }
 123     $node= { X => $x, Y => $y, A => $a,
 124              LayerMin => $l, LayerMax => $l, LineInfo => $lni };
 125     push @nodes, $node;
 126     comment("nodulated $lni new#$ni/0");
 127     return ($#nodes,0);
 128 }
 129
 130 sub readin () {
 131     my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist);
 132     my ($pti,@nodeinfo);
 133     while (<>) {
 134         next unless m/^\%L /;
 135         die unless m/^\%L (\w+)\b/;
 136         next unless $1 eq 'segmentpart';
 137         die unless m/^\%L segmentpart ([A-Za-z_]*)(\d+) (\S+) ([-.eE0-9 ]+)$/;
 138         ($layerkind, $level, $subsegspec, $numbers) = ($1,$2,$3,$4);
 139         next unless grep { $layerkind eq $_ } @layerkinds;
 140         @numbers = map { $_ + 0 } split / /, $numbers;
 141         $dist= shift @numbers;
 142         @numbers == 6 or die;
 143         @nodeinfo= ();
 144         for ($pti=0; $pti<2; $pti++) {
 145             push @nodeinfo,
 146                 find_node("$.:$pti", $pti,
 147                           $level, @numbers[($pti*3)..($pti*3+2)]);
 148         }
 149         push @links, [ @nodeinfo, $dist, $subsegspec ];
 150         comment("link @{ $links[$#links] }");
 151     }
 152 }
 153
 154 sub elimtrivial () {
 155     my (@nodeentries); # $nodeentries[$nodenum][$back] = count
 156     # eliminate trivial nodes: ones which have only two edges, which
 157     # come in on opposite sides
 158     for $lk (@links) {
 159         $nodeentries[$lk->[0]][$lk->[1]]++;
 160         $nodeentries[$lk->[1]][$lk->[2]]++;
 161     }
 162     for ($nodenum=0; $nodenum<@nodes; $nodenum++) {
 163
 164 }
 165
 166 readin();
 167 elimtrivial();
 168
 169
 170 #    ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A},
 171 #     $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) =
 172 #    $node[0]
 173
 174 #(\w+(?:(?:\/([A-Za-z]+)(\d+))?)?)