@layerkinds= split /\,/, $conf{LayerKinds}, -1;
our @nodes;
-# $nodes[$nodenum]{X}
-# $nodes[$nodenum]{Y}
-# $nodes[$nodenum]{A}
-# $nodes[$nodenum]{LayerMin}
-# $nodes[$nodenum]{LayerMax}
+# $nodes[]{X}
+# $nodes[]{Y}
+# $nodes[]{A}
+# $nodes[]{LayerMin}
+# $nodes[]{LayerMax}
+# $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
-our @links;
-# $links[]= [ $nodenum0, $back0, $nodenum1, $back1, $dist, $subsegspec ];
+our @edges;
+# $edges[]{"Node$far"}= [ \$nodes[], $back ]
+# $edges[]{Dist}
+# $edges[]{SubSegSpec}
sub comment ($) {
print "/* $_[0] */\n";
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];
+ for $node (@nodes) {
$diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
($d = $l - $node->{LayerMax}) > 0 ? $d :
0);
$node->{"Layer$updlayer"}= $l;
$node->{LineInfo}.="($l<-$lni)";
}
- comment("nodulated $lni ex.#$ni/$back");
- return ($ni,$back);
+ 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;
- comment("nodulated $lni new#$ni/0");
- return ($#nodes,0);
+ trace("node $lni created ".pnode($node)."/$back");
+ return ($node,$back);
}
sub readin () {
@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)]);
+ $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 @links, [ @nodeinfo, $dist, $subsegspec ];
- comment("link @{ $links[$#links] }");
+ push @edges, $edge;
}
}
+sub extendsplits () {
+ # Whenever we have a node which has one or more moveable feature
+ # subsegments, part of the same moveable feature, on one side, and
+ # fixed portion of the same segment on the other, we eliminate
+ # the fixed portion and add its length to both the moveables,
+ # so that we have one subsegspec for the whole of each position:
+ #
+ # <---l---> <----l'----> <--------(l+l')------>
+ #
+ # *----A1---*----A1/P0--* becomes *--------A1/P0----------*
+ # `---A1/P1---* `-------A1/P1-----------*
+ #
+ # <----l''---> <--------(l+l'')------>
+
+ $pass= 0;
+ for (;;) {
+ $pass++;
+ trace("extendsplits pass $pass");
+ $any_found= 0;
+ for $node (@nodes) {
+ for ($rightback=0; $rightback<2; $rightback++) {
+ $leftback= 1-$rightback;
+ $tracep= "extendsplits pass=$pass ".pnode($node)."/$rightback";
+ if (@{ $node->{"Edges$leftback"} } != 1) {
+ trace("$tracep >1 left edge");
+ next;
+ }
+ ($leftedge,$leftthisfar)= @{ $node->{"Edges$leftback"}[0] };
+ $leftthatfar= 1-$leftthisfar;
+ $fixedseg= $leftedge->{SubSegSpec};
+ @any_wrong= ();
+ for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
+ ($rightedge,$rightthisfar) = @$rightedgethisfar;
+ if ($rightedge->{SubSegSpec} !~ m,^(\-?\w+)/\w+$,) {
+ @any_wrong= ($rightedge, $leftback, "not moveable");
+ } elsif ($1 ne $fixedseg) {
+ @any_wrong= ($rightedge, $leftback, "other segment");
+ }
+ last if @any_wrong;
+ }
+ if (@any_wrong) {
+ trace("$tracep $any_wrong[2] ".
+ pedge($any_wrong[0])."::$any_wrong[1]");
+ next;
+ }
+ $any_found++;
+ $dist= $leftedge->{Dist};
+ ($leftnode,$leftnoderightback)=
+ @{ $leftedge->{"Node$leftthatfar"} };
+ deleteedge($leftedge);
+ for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
+ ($rightedge,$rightthisfar) = @$rightedgethisfar;
+ replumbedge($rightedge,$rightthisfar,
+ $leftnode,$leftnoderightback);
+
+
+ $rightedge->{Dist} += $leftedge->{Dist};
+ $rightedge->{"Node$rightthisfar"}=
+
+ $leftnode->{"Edges$leftnoderightback"} =
+ [ grep {
+ ($grepnode, $grepback) = @$_;
+ !($grepnode == $node &&
+ $grepback == $leftnoderightback);
+ }
+ @{ $leftnode->{"Edges$leftnoderightback"} }
+ ];
+
+
+
+ }
+
+
sub elimtrivial () {
- my (@nodeentries); # $nodeentries[$nodenum][$back] = count
# eliminate trivial nodes: ones which have only two edges, which
- # come in on opposite sides
+ # come in on opposite sides, and have the same subsegspec
+
for $lk (@links) {
$nodeentries[$lk->[0]][$lk->[1]]++;
$nodeentries[$lk->[1]][$lk->[2]]++;
}
readin();
+splitcontin();
elimtrivial();