#!/usr/bin/perl -w # # Reads the special comments in the subsegment encoding output from # layout, determines the segment graph, and outputs a description of # that graph. # Approach/algorithm: # # We read the segenco.ps and each time we find a `%L segmentpart' # comment we add it to an annotated graph we construct. Each node in # the annotated graph is a tuple consisting of a loc and range of # layer levels. Each edge is a segment part from a %L comment. Each # node has a `front' and a `back', and each edget attach either to # one or the other. # # Only segment parts with certain layer kinds are processed: by # default, only the empty layer kind. # # When a loc is found in the input, as one end of a segmentpart, it # is considered identical to a existing node (if its details are # sufficiently similar) or creates a new node (if its details are # sufficiently different). If the segmentpart's end is considered # identical to an existing node then the existing node's layer level # range is extended, but the existing node's X Y and A are not # modified. # # A loc and layer level are compared with a node as follows: # # The difference between each of the loc's details and the node's # details is computed. If any of the differences is at least the # min clearance, then the loc/layerb is a new node. Otherwise, all # of the differences must be within the max tolerance and the # loc/layer is the same as the node (coming out of the back if the # 180deg was added to make the angle difference). Otherwise it is # an error. # # The detail differences are: # Position difference: horizontal distance between loc and node # Angle difference: difference betwen loc's and node's A, or # difference minus 180deg between loc's and node's A, whichever # is the smaller (both reduced mod 360deg to value with # smallest magnitude). # Level difference: 0 if layer level is within node's range # or distance by which it is outside that range. use strict qw(vars); our %conf; $conf{MinClearLayer}= 6; $conf{MaxTolerLayer}= 4; $conf{MinClearDist}= 0.5; $conf{MaxTolerDist}= 0.05; $conf{MinClearAngle}= 5.0; $conf{MaxTolerAngle}= 0.5; $conf{LayerKinds}= ','; # comma-separated list as for split /\,/, ..., -1; our @layerkinds; @layerkinds= split /\,/, $conf{LayerKinds}, -1; our @nodes; # $nodes[]{X} # $nodes[]{Y} # $nodes[]{A} # $nodes[]{LayerMin} # $nodes[]{LayerMax} # $nodes[]{"Edges$back"}[] = [ \$edges[], $far ] our @edges; # $edges[]{"Node$far"}= [ \$nodes[], $back ] # $edges[]{Dist} # $edges[]{SubSegSpec} sub comment ($) { print "/* $_[0] */\n"; } sub sqr ($) { return $_[0]*$_[0]; } sub find_node (@) { my ($lni,$isdest,$l,$x,$y,$a) = @_; my ($any_outside_toler, $any_outside_clear, $updlayer); my ($ni, $node, %diff, $back, $d, $k); for $node (@nodes) { $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d : ($d = $l - $node->{LayerMax}) > 0 ? $d : 0); $diff{Dist}= sqrt(sqr($x - $node->{X}) + sqr($y - $node->{Y})); $diff{Angle}= $a - $node->{A}; # <-360,360> if ($diff{Angle} < 0) { $diff{Angle} += 360; } # [0,360> $back= $diff{Angle} >= 90 && $diff{Angle} < 270; # $back <=> [90,270> $back= !!$isdest != !!$back; # logical xor $back += 0; if ($back) { $diff{Angle} -= 180; } # [0,90> or [270,360> if ($diff{Angle} > 180) { $diff{Angle} -= 360; } # [-90,90> $any_outside_clear= 0; $any_outside_toler= 0; foreach $k (keys %diff) { if (abs($diff{$k}) >= $conf{"MinClear$k"}) { $any_outside_clear=1; last; } elsif (abs($diff{$k}) <= $conf{"MaxToler$k"}) { } else { $any_outside_toler=1; } } if ($any_outside_clear) { } elsif ($any_outside_toler) { die ("mismatch/clash:\n". " $lni has L=$l XY=$x,$y A=$a\n". " $node->{LineInfo} has ". "L=$node->{LayerMin}..$node->{LayerMax}". " XY=$node->{X},$node->{Y} A=$node->{A}\n "); } else { $updlayer= ($diff{Layer} < 0 ? "Min" : $diff{Layer} > 0 ? "Max" : ''); if ($updlayer) { $node->{"Layer$updlayer"}= $l; $node->{LineInfo}.="($l<-$lni)"; } trace("node $lni existing ".pnode($node)."/$back"); return ($node,$back); } } $node= { X => $x, Y => $y, A => $a, LayerMin => $l, LayerMax => $l, LineInfo => $lni }; $back= 0; push @nodes, $node; trace("node $lni created ".pnode($node)."/$back"); return ($node,$back); } sub readin () { my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist); my ($pti,@nodeinfo); while (<>) { next unless m/^\%L /; die unless m/^\%L (\w+)\b/; next unless $1 eq 'segmentpart'; die unless m/^\%L segmentpart ([A-Za-z_]*)(\d+) (\S+) ([-.eE0-9 ]+)$/; ($layerkind, $level, $subsegspec, $numbers) = ($1,$2,$3,$4); next unless grep { $layerkind eq $_ } @layerkinds; @numbers = map { $_ + 0 } split / /, $numbers; $dist= shift @numbers; @numbers == 6 or die; $edge= { Dist = $dist, SubSegSpec= $subsegspec }; for ($far=0; $far<2; $far++) { @endnums= @numbers[($far*3)..($far*3+2)]; ($node,$back)= find_node("$.:$far",$far,$level,@endnums); $edge{"Node$far"}= [ $node, $back ]; push @{ $node->{"Edges$back"} }, [ $edge, $far ]; } push @edges, $edge; } } readin(); splitcontin(); elimtrivial(); # ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A}, # $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) = # $node[0] #(\w+(?:(?:\/([A-Za-z]+)(\d+))?)?)