segment labelling work-in-progress - yet to do are labels and graph colouring

[trains.git] / layout / extractgraph

diff --git a/layout/extractgraph b/layout/extractgraph
index d34be3ed2ffc1e90f13a523abdbf141754795a39..5c71d597929dcca66fb15165cd75ff8bf53187af 100755 (executable)
--- a/layout/extractgraph
+++ b/layout/extractgraph
@@ -44,6 +44,7 @@
 #        or distance by which it is outside that range.
 
 use strict qw(vars);
+use POSIX;
 
 our %conf;
 $conf{MinClearLayer}= 6;
@@ -62,6 +63,7 @@ our @nodes;
 # $nodes[]{X}
 # $nodes[]{Y}
 # $nodes[]{A}
+# $nodes[]{NodeNum}
 # $nodes[]{LayerMin}
 # $nodes[]{LayerMax}
 # $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
@@ -69,6 +71,7 @@ our @nodes;
 our @edges;
 # $edges[]{"Node$far"}= [ \$nodes[], $back ]
 # $edges[]{Dist}
+# $edges[]{EdgeNum}
 # $edges[]{SubSegSpec}
 
 our %segments;
@@ -85,8 +88,11 @@ 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) {
+    my ($ni, $nodei, $node, %diff, $back, $d, $k, $pinfo);
+    $pinfo= sprintf "%.2f %.2f %.2f", $x,$y,$a;
+    $a -= 360.0 * floor($a / 360.0);
+    for ($nodei=0; $nodei<@nodes; $nodei++) {
+       $node= $nodes[$nodei];
        $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
                       ($d = $l - $node->{LayerMax}) > 0 ? $d :
                       0);
@@ -95,9 +101,9 @@ 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>
+       if ($back) { $diff{Angle} -= 180; }               # [0,90> or [270,360>
        $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;
@@ -124,33 +130,37 @@ sub find_node (@) {
                $node->{"Layer$updlayer"}= $l;
                $node->{LineInfo}.="($l<-$lni)";
            }
-           comment("nodulated $lni ex.$node/$back");
+           comment("nodulated $lni ex.$nodei/$back ($pinfo)");
            return ($node,$back);
        }
     }
-    $node= { X => $x, Y => $y, A => $a,
+    $node= { X => $x, Y => $y, A => $a, NodeNum => scalar(@nodes),
             LayerMin => $l, LayerMax => $l, LineInfo => $lni };
-    $back= 0;
+    $back= $isdest;
     push @nodes, $node;
-    comment("nodulated $lni new$node/$back");
+    comment("nodulated $lni new$#nodes/$back ($pinfo)");
     return ($node,$back);
 }
 
 sub readin () {
     my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist);
-    my ($node,$back,$far,@nodeinfo,@endnums,$edge);
+    my ($edgenum,$node,$back,$far,@nodeinfo,@endnums,$edge);
     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);
+       die unless
+           m/^\%L segmentpart (\d+) ([A-Za-z_]*)(\d+) (\S+) ([-.eE0-9 ]+)$/;
+       ($edgenum, $layerkind, $level, $subsegspec, $numbers) =
+           ($1,$2,$3,$4,$5);
        next unless grep { $layerkind eq $_ } @layerkinds;
        next unless $subsegspec =~ m,^[^/], or $conf{EvenUnknownSegments};
        @numbers = map { $_ + 0 } split / /, $numbers;
        $dist= shift @numbers;
        @numbers == 6 or die;
-       $edge= { Dist => $dist, SubSegSpec => $subsegspec };
+       $edge= { EdgeNum => $edgenum,
+                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);
@@ -167,9 +177,9 @@ sub o ($@) {
 
 sub pr ($$) {
     my ($kind,$ref) = @_;
-    $ref= "$ref";
-    $ref =~ y/()/__/;
-    return lc $ref.lc $kind;
+    my ($n);
+    $n= $ref->{"${kind}Num"};
+    return sprintf "%s%d", lc($kind), $n;
 }
 
 sub pr_edgeend ($) {
@@ -212,7 +222,7 @@ sub writeout () {
     my ($node, $edge, $i, $side, $sideedges);
     my ($end, $endnum, $sss, $reverse, $nodeside, $connectnum, $j, $edgeend);
     my ($segname, $segment, $movfeats, $movfeat, $delim);
-    my ($movfeatpos, $movpos);
+    my ($movfeatpos, $movpos, $maxedgenum);
     o("\n");
     o("#include \"graph-data.h\"\n");
     for $node (@nodes) { o("static Node ",pr(Node,$node),";\n"); }
@@ -221,12 +231,12 @@ sub writeout () {
     for $segname (keys %segments) {
        $segment= $segments{$segname};
        $movfeats= $segment->{MovFeats};
-       o("static MovFeat movfeats_${segname}[];\n");
+       o("static MovFeat movfeats_$segname","[];\n");
        o("static Segment segment_$segname= {");
        o(" \"$segname\",");
        o(" ",scalar(@$movfeats),", movfeats_$segname");
        o(" };\n");
-       o("static MovFeat movfeats_${segname}[]= {");
+       o("static MovFeat movfeats_$segname","[]= {");
        $delim= "";
        for $movfeat (@$movfeats) {
            o("$delim\n");
@@ -238,13 +248,20 @@ sub writeout () {
        }
        o("\n};\n");
     }
-    o("\n");
+    o("Segment *all_segments[]= {\n");
+    for $segname (keys %segments) {
+       o("  &segment_$segname,\n");
+    }
+    o("  0\n".
+      "};\n".
+      "\n");
     for ($i=0; $i<@nodes; $i++) {
        $node= $nodes[$i];
-       o("static Node ",pr(Node,$node),"= { \n");
+       o("static Node ",pr(Node,$node),"= { \"$i\",\n");
        o("  ".($i>0 ? '&'.pr(Node,$nodes[$i-1]) : '0').
          ", ".($i<$#nodes ? '&'.pr(Node,$nodes[$i+1]) : '0'));
-       o(", {");
+       o(",\n  $node->{X}, $node->{Y}, $node->{A},".
+         "  $node->{LayerMin}, $node->{LayerMax}, {");
        $delim= '';
        for ($side=0; $side<2; $side++) {
            o("$delim\n    { &".pr(Node,$node).", $side,");
@@ -263,15 +280,20 @@ sub writeout () {
        o("\n  }\n};\n");
     }
     o("\n");
-    for $edge (@edges) {
-       o("static Edge ",pr(Edge,$edge),"= {\n");
+    $maxedgenum=-1;
+    for ($i=0; $i<@edges; $i++) {
+       $edge= $edges[$i];
+       o("static Edge ",pr(Edge,$edge),"= { \"$edge->{EdgeNum}\",\n");
+       if ($edge->{EdgeNum} > $maxedgenum) {
+           $maxedgenum= $edge->{EdgeNum};
+       }
        o("  $edge->{Dist}, ");
        $sss= $edge->{SubSegSpec};
+       o("/* $sss */ ");
        $reverse= !!($sss =~ s/^\-//);
-       if ($reverse) { o("/*reverse*/ "); }
        $sss =~ m,^(\w*)/(([A-Za-z]*)(\d*))$, or die;
        ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
-       o("&movfeats_${segname}[",
+       o("&movfeats_${segname}","[",
          $segments{$segname}{MovFeatMap}{$movfeat},
          "], ",
          (length $movfeat ? $movpos : 0),
@@ -297,7 +319,7 @@ sub writeout () {
                   '&'.pr_edgeend($sideedges->[$connectnum-1]) : '0'),
              ", ".($connectnum < $#$sideedges ?
                    '&'.pr_edgeend($sideedges->[$connectnum+1]) : '0'));
-           o(",\n      &".pr(Edge,$edge),", $end, ",
+           o(",\n      &".pr(Edge,$edge),", $endnum, ",
              "&".pr(Node,$node).".sides[$side]");
            o(" }");
            $delim= ',';
@@ -305,8 +327,12 @@ sub writeout () {
        o("\n  }\n};\n");
     }
     o("\n");
-    o("Node *nodes_head= ",(@nodes ? '&'.pr(Node,$nodes[0]) : 0),";\n");
-    o("Node *nodes_tail= ",(@nodes ? '&'.pr(Node,$nodes[$#nodes]) : 0),";\n");
+    o("NodeList all_nodes= { ",
+      (@nodes ? '&'.pr(Node,$nodes[0]) : 0), ", ",
+      (@nodes ? '&'.pr(Node,$nodes[$#nodes]) : 0),
+      " };\n");
+    o("int next_nodenum= ".scalar(@nodes).";\n".
+      "int next_edgenum= ".($maxedgenum+1).";\n");
 }
 
 o("/*autogenerated - do not edit*/\n\n");