From: ian <ian>
Date: Sun, 13 Mar 2005 17:10:35 +0000 (+0000)
Subject: wip; working on elimtrivial; considering referencey data structure instead
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=23d40dc9d933830e3b77a27b6b5392ac47794d29;p=trains.git

wip; working on elimtrivial; considering referencey data structure instead
---

diff --git a/layout/extractgraph b/layout/extractgraph
index 3873ddb..59981ec 100755
--- a/layout/extractgraph
+++ b/layout/extractgraph
@@ -1,4 +1,4 @@
-#!/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
@@ -43,14 +43,20 @@
 #       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}
@@ -58,6 +64,9 @@ our @nodes;
 # $nodes[$nodenum]{LayerMin}
 # $nodes[$nodenum]{LayerMax}
 
+our @links;
+# $links[]= [ $nodenum0, $back0, $nodenum1, $back1, $dist, $subsegspec ];
+
 sub comment ($) {
     print "/* $_[0] */\n";
 }
@@ -65,8 +74,9 @@ sub comment ($) {
 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 :
@@ -77,6 +87,8 @@ sub find_node (@) {
 	$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;
@@ -91,39 +103,70 @@ sub find_node (@) {
 	}
 	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]