#!/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);

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;

our @layerkinds;
@layerkinds= split /\,/, $conf{LayerKinds}, -1;

our @nodes;
# $nodes[]{X}
# $nodes[]{Y}
# $nodes[]{A}
# $nodes[]{LayerMin}
# $nodes[]{LayerMax}
# $nodes[]{"Edges$back"}[] = [ \$edges[], $far ]

our @edges;
# $edges[]{"Node$far"}= [ \$nodes[], $back ]
# $edges[]{Dist}
# $edges[]{SubSegSpec}

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, $node, %diff, $back, $d, $k);
    for $node (@nodes) {
	$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>
	$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;
	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)";
	    }
	    trace("node $lni existing ".pnode($node)."/$back");
	    return ($node,$back);
	}
    }
    $node= { X => $x, Y => $y, A => $a,
	     LayerMin => $l, LayerMax => $l, LineInfo => $lni };
    $back= 0;
    push @nodes, $node;
    trace("node $lni created ".pnode($node)."/$back");
    return ($node,$back);
}

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;
	$edge= { 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 extendsplits () {
    # Whenever we have a node which has one or more moveable feature
    # subsegments, part of the same moveable feature, on one side, and
    # fixed portion of the same segment on the other, we eliminate
    # the fixed portion and add its length to both the moveables,
    # so that we have one subsegspec for the whole of each position:
    #
    #    <---l---> <----l'---->             <--------(l+l')------>
    #
    #   *----A1---*----A1/P0--*  becomes  *--------A1/P0----------*
    #              `---A1/P1---*           `-------A1/P1-----------*
    #
    #               <----l''--->            <--------(l+l'')------>

    $pass= 0;
    for (;;) {
	$pass++;
	trace("extendsplits pass $pass");
	$any_found= 0;
	for $node (@nodes) {
	    for ($rightback=0; $rightback<2; $rightback++) {
		$leftback= 1-$rightback;
		$tracep= "extendsplits pass=$pass ".pnode($node)."/$rightback";
		if (@{ $node->{"Edges$leftback"} } != 1) {
		    trace("$tracep >1 left edge");
		    next;
		}
		($leftedge,$leftthisfar)= @{ $node->{"Edges$leftback"}[0] };
		$leftthatfar= 1-$leftthisfar;
		$fixedseg= $leftedge->{SubSegSpec};
		@any_wrong= ();
		for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
 		    ($rightedge,$rightthisfar) = @$rightedgethisfar;
		    if ($rightedge->{SubSegSpec} !~ m,^(\-?\w+)/\w+$,) {
			@any_wrong= ($rightedge, $leftback, "not moveable");
		    } elsif ($1 ne $fixedseg) {
			@any_wrong= ($rightedge, $leftback, "other segment");
		    }
		    last if @any_wrong;
		}
		if (@any_wrong) {
		    trace("$tracep $any_wrong[2] ".
			  pedge($any_wrong[0])."::$any_wrong[1]");
		    next;
		}
		$any_found++;
		$dist= $leftedge->{Dist};
		($leftnode,$leftnoderightback)=
		    @{ $leftedge->{"Node$leftthatfar"} };
		deleteedge($leftedge);
		for $rightedgethisfar (@{ $node->{"Edges$rightback"} }) {
 		    ($rightedge,$rightthisfar) = @$rightedgethisfar;
		    replumbedge($rightedge,$rightthisfar,
				$leftnode,$leftnoderightback);
		    

		    $rightedge->{Dist} += $leftedge->{Dist};
		    $rightedge->{"Node$rightthisfar"}=
		
		$leftnode->{"Edges$leftnoderightback"} =
		    [ grep {
			($grepnode, $grepback) = @$_;
			!($grepnode == $node &&
			  $grepback == $leftnoderightback);
		    }
		     @{ $leftnode->{"Edges$leftnoderightback"} }
		     ];
			
		    

    }
    

sub elimtrivial () {
    # eliminate trivial nodes: ones which have only two edges, which
    # come in on opposite sides, and have the same subsegspec
    
    for $lk (@links) {
	$nodeentries[$lk->[0]][$lk->[1]]++;
	$nodeentries[$lk->[1]][$lk->[2]]++;
    }
    for ($nodenum=0; $nodenum<@nodes; $nodenum++) {
	
}

readin();
splitcontin();
elimtrivial();


#    ($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+))?)?)