#!/usr/bin/perl -w
#
# Reads the special comments in the subsegment encoding output from
# layout, determines the segment graph, and outputs a description of
# that graph.

# Approach/algorithm:
#
#  We read the segenco.ps and each time we find a `%L segmentpart'
#  comment we add it to an annotated graph we construct.  Each node in
#  the annotated graph is a tuple consisting of a loc and range of
#  layer levels.  Each edge is a segment part from a %L comment.  Each
#  node has a `front' and a `back', and each edget attach either to
#  one or the other.
#
#  Only segment parts with certain layer kinds are processed: by
#  default, only the empty layer kind.
#
#  When a loc is found in the input, as one end of a segmentpart, it
#  is considered identical to a existing node (if its details are
#  sufficiently similar) or creates a new node (if its details are
#  sufficiently different).  If the segmentpart's end is considered
#  identical to an existing node then the existing node's layer level
#  range is extended, but the existing node's X Y and A are not
#  modified.
#
#  A loc and layer level are compared with a node as follows:
#
#    The difference between each of the loc's details and the node's
#    details is computed.  If any of the differences is at least the
#    min clearance, then the loc/layerb is a new node.  Otherwise, all
#    of the differences must be within the max tolerance and the
#    loc/layer is the same as the node (coming out of the back if the
#    180deg was added to make the angle difference).  Otherwise it is
#    an error.
#
#    The detail differences are:
#       Position difference: horizontal distance between loc and node
#       Angle difference: difference betwen loc's and node's A, or
#        difference minus 180deg between loc's and node's A, whichever
#        is the smaller (both reduced mod 360deg to value with 
#        smallest magnitude).
#       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}= 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[]{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 ($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);
	$diff{Dist}= sqrt(sqr($x - $node->{X}) +
			  sqr($y - $node->{Y}));
	$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 ($diff{Angle} > 180) { $diff{Angle} -= 360; }  # [-90,90>
	$any_outside_clear= 0;
	$any_outside_toler= 0;
	foreach $k (keys %diff) {
	    if (abs($diff{$k}) >= $conf{"MinClear$k"}) {
		$any_outside_clear=1; last;
	    } elsif (abs($diff{$k}) <= $conf{"MaxToler$k"}) {
	    } else {
		$any_outside_toler=1;
	    }
	}
	if ($any_outside_clear) {
	} elsif ($any_outside_toler) {
	    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 {
	    $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, NodeNum => scalar(@nodes),
	     LayerMin => $l, LayerMax => $l, LineInfo => $lni };
    $back= $isdest;
    push @nodes, $node;
    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;
	}
    }
}

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]
 
#(\w+(?:(?:\/([A-Za-z]+)(\d+))?)?)