-#!/usr/bin/perl
+#!/usr/bin/perl -w
#
# Reads the special comments in the subsegment encoding output from
# layout, determines the segment graph, and outputs a description of
# 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}= 2.0;
-$conf{MaxTolerDist}= 0.2;
+$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[$nodenum]{X}
# $nodes[$nodenum]{Y}
# $nodes[$nodenum]{LayerMin}
# $nodes[$nodenum]{LayerMax}
+our @links;
+# $links[]= [ $nodenum0, $back0, $nodenum1, $back1, $dist, $subsegspec ];
+
sub comment ($) {
print "/* $_[0] */\n";
}
sub sqr ($) { return $_[0]*$_[0]; }
sub find_node (@) {
- my ($l,$x,$y,$a) = @_;
- my ($any_outside_tol);
+ my ($lni,$isdest,$l,$x,$y,$a) = @_;
+ my ($any_outside_toler, $any_outside_clear, $updlayer);
+ my ($ni, $node, %diff, $back, $d, $k);
for ($ni=0; $ni<@nodes; $ni++) {
$node= $nodes[$ni];
$diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
$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;
}
if ($any_outside_clear) {
} elsif ($any_outside_toler) {
- die "$l,$x,$y,$a vs. $node->{LayerMin}..$node->{LayerMax}".
- ",$node->{X},$node->{Y},$node->{A}".
- " at <> line $node->{LineNum} and";
+ 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 {
- if ($diff{Layer} < 0) { $node->{LayerMin}= $l }
- if ($diff{Layer} > 0) { $node->{LayerMax}= $l }
- comment("nodulated ex.#$ni/$back $l,$x,$y,$a");
+ $updlayer= ($diff{Layer} < 0 ? "Min" :
+ $diff{Layer} > 0 ? "Max" :
+ '');
+ if ($updlayer) {
+ $node->{"Layer$updlayer"}= $l;
+ $node->{LineInfo}.="($l<-$lni)";
+ }
+ comment("nodulated $lni ex.#$ni/$back");
return ($ni,$back);
}
}
$node= { X => $x, Y => $y, A => $a,
- LayerMin => $l, LayerMax => $l, LineNum => $. };
+ LayerMin => $l, LayerMax => $l, LineInfo => $lni };
push @nodes, $node;
- comment("nodulated new#$ni/0 $l,$x,$y,$a");
+ comment("nodulated $lni new#$ni/0");
return ($#nodes,0);
}
-
-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 $_ } split /\,/, $conf{LayerKinds}, -1;
- @numbers = map { $_ + 0 } split / /, $numbers;
- $dist= shift @numbers;
- @numbers == 6 or die;
- for ($pti=0; $pti<2; $pti++) {
- ($node[$pti], $back[$pti])=
- find_node($level, @numbers[($i*3)..($i*3+2)]);
+
+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;
+ @nodeinfo= ();
+ for ($pti=0; $pti<2; $pti++) {
+ push @nodeinfo,
+ find_node("$.:$pti", $pti,
+ $level, @numbers[($pti*3)..($pti*3+2)]);
+ }
+ push @links, [ @nodeinfo, $dist, $subsegspec ];
+ comment("link @{ $links[$#links] }");
}
}
+sub elimtrivial () {
+ my (@nodeentries); # $nodeentries[$nodenum][$back] = count
+ # eliminate trivial nodes: ones which have only two edges, which
+ # come in on opposite sides
+ for $lk (@links) {
+ $nodeentries[$lk->[0]][$lk->[1]]++;
+ $nodeentries[$lk->[1]][$lk->[2]]++;
+ }
+ for ($nodenum=0; $nodenum<@nodes; $nodenum++) {
+
+}
+
+readin();
+elimtrivial();
+
+
# ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A},
# $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) =
# $node[0]