3 # Reads the special comments in the subsegment encoding output from
4 # layout, determines the segment graph, and outputs a description of
9 # We read the segenco.ps and each time we find a `%L segmentpart'
10 # comment we add it to an annotated graph we construct. Each node in
11 # the annotated graph is a tuple consisting of a loc and range of
12 # layer levels. Each edge is a segment part from a %L comment. Each
13 # node has a `front' and a `back', and each edget attach either to
16 # Only segment parts with certain layer kinds are processed: by
17 # default, only the empty layer kind.
19 # When a loc is found in the input, as one end of a segmentpart, it
20 # is considered identical to a existing node (if its details are
21 # sufficiently similar) or creates a new node (if its details are
22 # sufficiently different). If the segmentpart's end is considered
23 # identical to an existing node then the existing node's layer level
24 # range is extended, but the existing node's X Y and A are not
27 # A loc and layer level are compared with a node as follows:
29 # The difference between each of the loc's details and the node's
30 # details is computed. If any of the differences is at least the
31 # min clearance, then the loc/layerb is a new node. Otherwise, all
32 # of the differences must be within the max tolerance and the
33 # loc/layer is the same as the node (coming out of the back if the
34 # 180deg was added to make the angle difference). Otherwise it is
37 # The detail differences are:
38 # Position difference: horizontal distance between loc and node
39 # Angle difference: difference betwen loc's and node's A, or
40 # difference minus 180deg between loc's and node's A, whichever
41 # is the smaller (both reduced mod 360deg to value with
42 # smallest magnitude).
43 # Level difference: 0 if layer level is within node's range
44 # or distance by which it is outside that range.
50 $conf{MinClearLayer}= 6;
51 $conf{MaxTolerLayer}= 4;
52 $conf{MinClearDist}= 0.5;
53 $conf{MaxTolerDist}= 0.05;
54 $conf{MinClearAngle}= 5.0;
55 $conf{MaxTolerAngle}= 0.5;
56 $conf{LayerKinds}= ','; # comma-separated list as for split /\,/, ..., -1;
57 $conf{EvenUnknownSegments}= 0;
60 @layerkinds= split /\,/, $conf{LayerKinds}, -1;
69 # $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]
72 # $edges[]{"Node$far"}= [ \$nodes[], $back ]
75 # $edges[]{SubSegSpec}
78 # $segments{$segname}{MovFeats}[$movfeatnum]{Name}
79 # $segments{$segname}{MovFeats}[$movfeatnum]{Positions}
80 # $segments{$segname}{MovFeatMap}{$movfeatname}= $movfeatnum
83 print "/* $_[0] */\n";
86 sub sqr ($) { return $_[0]*$_[0]; }
89 my ($lni,$isdest,$l,$x,$y,$a) = @_;
90 my ($any_outside_toler, $any_outside_clear, $updlayer);
91 my ($ni, $nodei, $node, %diff, $back, $d, $k, $pinfo);
92 $pinfo= sprintf "%.2f %.2f %.2f", $x,$y,$a;
93 $a -= 360.0 * floor($a / 360.0);
94 for ($nodei=0; $nodei<@nodes; $nodei++) {
95 $node= $nodes[$nodei];
96 $diff{Layer}= (($d = $l - $node->{LayerMin}) < 0 ? $d :
97 ($d = $l - $node->{LayerMax}) > 0 ? $d :
99 $diff{Dist}= sqrt(sqr($x - $node->{X}) +
100 sqr($y - $node->{Y}));
101 $diff{Angle}= $a - $node->{A}; # <-360,360>
102 if ($diff{Angle} < 0) { $diff{Angle} += 360; } # [0,360>
103 $back= $diff{Angle} >= 90 && $diff{Angle} < 270; # $back <=> [90,270>
104 if ($back) { $diff{Angle} -= 180; } # [0,90> or [270,360>
105 $back= !!$isdest != !!$back; # logical xor
107 if ($diff{Angle} > 180) { $diff{Angle} -= 360; } # [-90,90>
108 $any_outside_clear= 0;
109 $any_outside_toler= 0;
110 foreach $k (keys %diff) {
111 if (abs($diff{$k}) >= $conf{"MinClear$k"}) {
112 $any_outside_clear=1; last;
113 } elsif (abs($diff{$k}) <= $conf{"MaxToler$k"}) {
115 $any_outside_toler=1;
118 if ($any_outside_clear) {
119 } elsif ($any_outside_toler) {
120 die ("mismatch/clash:\n".
121 " $lni has L=$l XY=$x,$y A=$a\n".
122 " $node->{LineInfo} has ".
123 "L=$node->{LayerMin}..$node->{LayerMax}".
124 " XY=$node->{X},$node->{Y} A=$node->{A}\n ");
126 $updlayer= ($diff{Layer} < 0 ? "Min" :
127 $diff{Layer} > 0 ? "Max" :
130 $node->{"Layer$updlayer"}= $l;
131 $node->{LineInfo}.="($l<-$lni)";
133 comment("nodulated $lni ex.$nodei/$back ($pinfo)");
134 return ($node,$back);
137 $node= { X => $x, Y => $y, A => $a, NodeNum => scalar(@nodes),
138 LayerMin => $l, LayerMax => $l, LineInfo => $lni };
141 comment("nodulated $lni new$#nodes/$back ($pinfo)");
142 return ($node,$back);
146 my ($layerkind, $level, $subsegspec, $numbers, @numbers, $dist);
147 my ($edgenum,$node,$back,$far,@nodeinfo,@endnums,$edge);
149 next unless m/^\%L /;
150 die unless m/^\%L (\w+)\b/;
151 next unless $1 eq 'segmentpart';
153 m/^\%L segmentpart (\d+) ([A-Za-z_]*)(\d+) (\S+) ([-.eE0-9 ]+)$/;
154 ($edgenum, $layerkind, $level, $subsegspec, $numbers) =
156 next unless grep { $layerkind eq $_ } @layerkinds;
157 next unless $subsegspec =~ m,^[^/], or $conf{EvenUnknownSegments};
158 @numbers = map { $_ + 0 } split / /, $numbers;
159 $dist= shift @numbers;
160 @numbers == 6 or die;
161 $edge= { EdgeNum => $edgenum,
163 SubSegSpec => $subsegspec };
164 for ($far=0; $far<2; $far++) {
165 @endnums= @numbers[($far*3)..($far*3+2)];
166 ($node,$back)= find_node("$.:$far",$far,$level,@endnums);
167 $edge->{"Node$far"}= [ $node, $back ];
168 push @{ $node->{"Edges$back"} }, [ $edge, $far ];
175 print join('',@_) or die $!;
179 my ($kind,$ref) = @_;
181 $n= $ref->{"${kind}Num"};
182 return sprintf "%s%d", lc($kind), $n;
187 my ($edge,$end) = @$edgeend;
189 $endnum= $end ^ !!($edge->{SubSegSpec} =~ m/^\-/);
190 return pr(Edge,$edge).".ends[$endnum]";
195 my ($segname, $movfeatpos, $movfeat, $movpos);
196 my ($movfeatnum, $movfeatref);
198 $sss= $edge->{SubSegSpec};
199 $sss =~ m,^\-?(\w*)/(([A-Za-z]*)(\d*))$, or die "$sss ?";
200 ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
201 if (!exists $segments{$segname}) {
202 $segments{$segname}= {
203 MovFeatMap => { '' => 0 },
204 MovFeats => [ { Name => '', Positions => 1 } ]
207 $movfeatnum= $segments{$segname}{MovFeatMap}{$movfeat};
208 if (!defined $movfeatnum) {
209 $movfeatnum= @{ $segments{$segname}{MovFeats} };
210 push @{ $segments{$segname}{MovFeats} },
211 { Name => $movfeat, Positions => 0 };
212 $segments{$segname}{MovFeatMap}{$movfeat}= $movfeatnum;
214 $movfeatref= $segments{$segname}{MovFeats}[$movfeatnum];
215 if (length $movfeat && $movpos >= $movfeatref->{Positions}) {
216 $movfeatref->{Positions}= $movpos + 1;
222 my ($node, $edge, $i, $side, $sideedges);
223 my ($end, $endnum, $sss, $reverse, $nodeside, $connectnum, $j, $edgeend);
224 my ($segname, $segment, $movfeats, $movfeat, $delim);
225 my ($movfeatpos, $movpos, $maxedgenum);
227 o("#include \"graph-data.h\"\n");
228 for $node (@nodes) { o("static Node ",pr(Node,$node),";\n"); }
229 for $edge (@edges) { o("static Edge ",pr(Edge,$edge),";\n"); }
231 for $segname (keys %segments) {
232 $segment= $segments{$segname};
233 $movfeats= $segment->{MovFeats};
234 o("static MovFeat movfeats_$segname","[];\n");
235 o("static Segment segment_$segname= {");
237 o(" ",scalar(@$movfeats),", movfeats_$segname");
239 o("static MovFeat movfeats_$segname","[]= {");
241 for $movfeat (@$movfeats) {
243 o(" { &segment_$segname, ");
244 o(length $movfeat->{Name} ? "\"$movfeat->{Name}\"" : 0);
245 o(", ", $movfeat->{Positions}+0);
252 for ($i=0; $i<@nodes; $i++) {
254 o("static Node ",pr(Node,$node),"= { $i,\n");
255 o(" ".($i>0 ? '&'.pr(Node,$nodes[$i-1]) : '0').
256 ", ".($i<$#nodes ? '&'.pr(Node,$nodes[$i+1]) : '0'));
259 for ($side=0; $side<2; $side++) {
260 o("$delim\n { &".pr(Node,$node).", $side,");
261 $sideedges= $node->{"Edges$side"};
262 if (defined $sideedges && @$sideedges) {
264 '&'.pr_edgeend($sideedges->[0]),
266 '&'.pr_edgeend($sideedges->[$#$sideedges]));
277 for ($i=0; $i<@edges; $i++) {
279 o("static Edge ",pr(Edge,$edge),"= { $edge->{EdgeNum},\n");
280 if ($edge->{EdgeNum} > $maxedgenum) {
281 $maxedgenum= $edge->{EdgeNum};
283 o(" $edge->{Dist}, ");
284 $sss= $edge->{SubSegSpec};
286 $reverse= !!($sss =~ s/^\-//);
287 $sss =~ m,^(\w*)/(([A-Za-z]*)(\d*))$, or die;
288 ($segname, $movfeatpos, $movfeat, $movpos) = ($1,$2,$3,$4);
289 o("&movfeats_${segname}","[",
290 $segments{$segname}{MovFeatMap}{$movfeat},
292 (length $movfeat ? $movpos : 0),
295 for ($endnum=0; $endnum<2; $endnum++) {
296 $end= $endnum ^ $reverse;
298 $nodeside= $edge->{"Node$end"};
299 $node= $nodeside->[0]; $side= $nodeside->[1];
300 $sideedges= $node->{"Edges$side"};
302 for ($j=0; $j<@$sideedges; $j++) {
303 $edgeend= $sideedges->[$j];
304 if ($edgeend->[0] == $edge &&
305 $edgeend->[1] == $end) {
306 die if defined $connectnum;
310 die unless defined $connectnum;
311 o(" ".($connectnum > 0 ?
312 '&'.pr_edgeend($sideedges->[$connectnum-1]) : '0'),
313 ", ".($connectnum < $#$sideedges ?
314 '&'.pr_edgeend($sideedges->[$connectnum+1]) : '0'));
315 o(",\n &".pr(Edge,$edge),", $endnum, ",
316 "&".pr(Node,$node).".sides[$side]");
323 o("NodeList all_nodes= { ",
324 (@nodes ? '&'.pr(Node,$nodes[0]) : 0), ", ",
325 (@nodes ? '&'.pr(Node,$nodes[$#nodes]) : 0),
327 o("int next_nodenum= ".scalar(@nodes).";\n".
328 "int next_edgenum= ".($maxedgenum+1).";\n");
331 o("/*autogenerated - do not edit*/\n\n");
337 # ($pts[0]{X}, $pts[0]{Y}, $pts[0]{A},
338 # $pts[1]{X}, $pts[1]{Y}, $pts[1]{A}) =
341 #(\w+(?:(?:\/([A-Za-z]+)(\d+))?)?)