-#!/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);
+use POSIX;
+
+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;
+$conf{EvenUnknownSegments}= 0;
+
+our @layerkinds;
+@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[]{NodeNum}
+# $nodes[]{LayerMin}
+# $nodes[]{LayerMax}
+# $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
+
+our @edges;
+# $edges[]{"Node$far"}= [ \$nodes[], $back ]
+# $edges[]{Dist}
+# $edges[]{EdgeNum}
+# $edges[]{SubSegSpec}
+
+our %segments;
+# $segments{$segname}{MovFeats}[$movfeatnum]{Name}
+# $segments{$segname}{MovFeats}[$movfeatnum]{Positions}
+# $segments{$segname}{MovFeatMap}{$movfeatname}= $movfeatnum
sub comment ($) {
print "/* $_[0] */\n";
sub sqr ($) { return $_[0]*$_[0]; }
sub find_node (@) {
- my ($l,$x,$y,$a) = @_;
- my ($any_outside_tol);
- for ($ni=0; $ni<@nodes; $ni++) {
- $node= $nodes[$ni];
+ my ($lni,$isdest,$l,$x,$y,$a) = @_;
+ my ($any_outside_toler, $any_outside_clear, $updlayer);
+ 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);
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 ($diff{Angle} > 180) { $diff{Angle} -= 360; } # [-90,90>
$any_outside_clear= 0;
$any_outside_toler= 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");
- return ($ni,$back);
+ $updlayer= ($diff{Layer} < 0 ? "Min" :
+ $diff{Layer} > 0 ? "Max" :
+ '');
+ if ($updlayer) {
+ $node->{"Layer$updlayer"}= $l;
+ $node->{LineInfo}.="($l<-$lni)";
+ }
+ comment("nodulated $lni ex.$nodei/$back ($pinfo)");
+ return ($node,$back);
}
}
- $node= { X => $x, Y => $y, A => $a,
- LayerMin => $l, LayerMax => $l, LineNum => $. };
+ $node= { X => $x, Y => $y, A => $a, NodeNum => scalar(@nodes),
+ LayerMin => $l, LayerMax => $l, LineInfo => $lni };
+ $back= $isdest;
push @nodes, $node;
- comment("nodulated new#$ni/0 $l,$x,$y,$a");
- return ($#nodes,0);
+ comment("nodulated $lni new$#nodes/$back ($pinfo)");
+ return ($node,$back);
+}
+
+sub readin () {
+ my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist);
+ 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 (\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= { 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);
+ $edge->{"Node$far"}= [ $node, $back ];
+ push @{ $node->{"Edges$back"} }, [ $edge, $far ];
+ }
+ push @edges, $edge;
+ }
+}
+
+sub o ($@) {
+ print join('',@_) or die $!;
+}
+
+sub pr ($$) {
+ my ($kind,$ref) = @_;
+ my ($n);
+ $n= $ref->{"${kind}Num"};
+ return sprintf "%s%d", lc($kind), $n;
+}
+
+sub pr_edgeend ($) {
+ my ($edgeend) = @_;
+ my ($edge,$end) = @$edgeend;
+ my ($endnum);
+ $endnum= $end ^ !!($edge->{SubSegSpec} =~ m/^\-/);
+ return pr(Edge,$edge).".ends[$endnum]";
+}
+
+sub segments () {
+ my ($edge, $sss);
+ my ($segname, $movfeatpos, $movfeat, $movpos);
+ my ($movfeatnum, $movfeatref);
+ for $edge (@edges) {
+ $sss= $edge->{SubSegSpec};
+ $sss =~ m,^\-?(\w*)/(([A-Za-z]*)(\d*))$, or die "$sss ?";
+ ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
+ if (!exists $segments{$segname}) {
+ $segments{$segname}= {
+ MovFeatMap => { '' => 0 },
+ MovFeats => [ { Name => '', Positions => 1 } ]
+ };
+ }
+ $movfeatnum= $segments{$segname}{MovFeatMap}{$movfeat};
+ if (!defined $movfeatnum) {
+ $movfeatnum= @{ $segments{$segname}{MovFeats} };
+ push @{ $segments{$segname}{MovFeats} },
+ { Name => $movfeat, Positions => 0 };
+ $segments{$segname}{MovFeatMap}{$movfeat}= $movfeatnum;
+ }
+ $movfeatref= $segments{$segname}{MovFeats}[$movfeatnum];
+ if (length $movfeat && $movpos >= $movfeatref->{Positions}) {
+ $movfeatref->{Positions}= $movpos + 1;
+ }
+ }
}
-
-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 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, $maxedgenum);
+ o("\n");
+ o("#include \"graph-data.h\"\n");
+ for $node (@nodes) { o("static Node ",pr(Node,$node),";\n"); }
+ for $edge (@edges) { o("static Edge ",pr(Edge,$edge),";\n"); }
+ o("\n");
+ for $segname (keys %segments) {
+ $segment= $segments{$segname};
+ $movfeats= $segment->{MovFeats};
+ 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","[]= {");
+ $delim= "";
+ for $movfeat (@$movfeats) {
+ o("$delim\n");
+ o(" { &segment_$segname, ");
+ o(length $movfeat->{Name} ? "\"$movfeat->{Name}\"" : 0);
+ o(", ", $movfeat->{Positions}+0);
+ o(" }");
+ $delim= ",";
+ }
+ o("\n};\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),"= { \"$i\",\n");
+ o(" ".($i>0 ? '&'.pr(Node,$nodes[$i-1]) : '0').
+ ", ".($i<$#nodes ? '&'.pr(Node,$nodes[$i+1]) : '0'));
+ 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,");
+ $sideedges= $node->{"Edges$side"};
+ if (defined $sideedges && @$sideedges) {
+ o("\n ",
+ '&'.pr_edgeend($sideedges->[0]),
+ ", ",
+ '&'.pr_edgeend($sideedges->[$#$sideedges]));
+ } else {
+ o(' 0, 0');
+ }
+ o(" }");
+ $delim= ',';
+ }
+ o("\n }\n};\n");
+ }
+ o("\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/^\-//);
+ $sss =~ m,^(\w*)/(([A-Za-z]*)(\d*))$, or die;
+ ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
+ o("&movfeats_${segname}","[",
+ $segments{$segname}{MovFeatMap}{$movfeat},
+ "], ",
+ (length $movfeat ? $movpos : 0),
+ ", {");
+ $delim= '';
+ for ($endnum=0; $endnum<2; $endnum++) {
+ $end= $endnum ^ $reverse;
+ o("$delim\n {");
+ $nodeside= $edge->{"Node$end"};
+ $node= $nodeside->[0]; $side= $nodeside->[1];
+ $sideedges= $node->{"Edges$side"};
+ undef $connectnum;
+ for ($j=0; $j<@$sideedges; $j++) {
+ $edgeend= $sideedges->[$j];
+ if ($edgeend->[0] == $edge &&
+ $edgeend->[1] == $end) {
+ die if defined $connectnum;
+ $connectnum= $j;
+ }
+ }
+ die unless defined $connectnum;
+ o(" ".($connectnum > 0 ?
+ '&'.pr_edgeend($sideedges->[$connectnum-1]) : '0'),
+ ", ".($connectnum < $#$sideedges ?
+ '&'.pr_edgeend($sideedges->[$connectnum+1]) : '0'));
+ o(",\n &".pr(Edge,$edge),", $endnum, ",
+ "&".pr(Node,$node).".sides[$side]");
+ o(" }");
+ $delim= ',';
+ }
+ o("\n }\n};\n");
+ }
+ o("\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");
+readin();
+segments();
+writeout();
+
+
# ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A},
# $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) =
# $node[0]
~ijackson / trains.git / blobdiff