#!/usr/bin/perl -w

use strict qw(vars);

our (%segs);
# $segs{$seg}{Inv}
# $segs{$seg}{BoOb}
# $segs{$seg}{Posns}
# $segs{$seg}{FeatCount}              does not include Fixed
# $segs{$seg}{Feats}{$pt}{Kind}       Point or Fixed
# $segs{$seg}{Feats}{$pt}{Weight}     ) for Point only
# $segs{$seg}{Feats}{$pt}{Posns}      ) for Point only
# $segs{$seg}{Feats}{$pt}{BoOb}       ) for Point only
# $segs{$seg}{Feats}{$pt}{Fixed}      position, for Fixed only
# $segs{$seg}{Ends}[$combpos][$end] = [ $node,$side ]
# $nodes{$node}[$side]{Seg}

our ($mode,$invertible);
$mode= 'barf';

sub line_barf () { die; }

sub begin_points () { }
sub line_points () {
    my ($seg,$pt,@boob,$bodef);
    m,^\s+(\w+)/([A-Za-z]+)\s+((\d+)\.\d+)\s+(\d*\.\d+)$, or die "$_ ?";
    ($seg,$pt,$boob[0],$bodef,$boob[1])=($1,$2,$3,$4,$5);
    $boob[1] =~ s/^\./$bodef./;
    die "$_ ?" unless exists $segs{$seg};
    die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
    $segs{$seg}{Feats}{$pt}= {
	Kind => Point,
	Weight => $segs{$seg}{Posns},
	Posns => 2,
	BoOb => [ @boob ]
	};
    $segs{$seg}{Posns} *= 2;
    $segs{$seg}{FeatCount}++;
}

sub begin_fixed () { }
sub line_fixed () {
    my ($seg,$pt,$pos);
    m,^\s+(\w+)/([A-Za-z]+)(\d+)$, or die "$_ ?";
    ($seg,$pt,$pos)=($1,$2,$3);
    die "$_ ?" unless exists $segs{$seg};
    die "$_ ?" if exists $segs{$seg}{Feats}{$pt};
    $segs{$seg}{Feats}{$pt}= {
	Kind => Fixed,
	Fixed => $pos
	};
}

sub begin_segment () { }
sub line_segment () {
    my ($seg,$boob);
    m/^\s+(\w+)\s+(\d+\.\d+)$/ or die "$_ ?";
    ($seg,$boob)=($1,$2);
    die "$_ ?" if exists $segs{$seg};
    $segs{$seg}= {
	BoOb => $boob,
	Inv => $invertible,
	Posns => 1,
	Feats => { },
	FeatCount => 0
    };
}

sub begin_endwiring () {
}

#	o("static const SegPosCombInfo spci_${seg}[]= {");
#	$delim='';
#	for ($comb=0; $comb < $segv->{Posns}; $comb++) {
#	}

sub line_endwiring () {
    my (@ns,$seg,$subspec,$dist);
    m,^\s*segment\s+(\w+\.\d+)\s+(\w+\.\d+)\s+(\w+)(?:/((?:[A-Za-z]+\d+)+)\*\d+)?\s+([0-9.]+)$, or die "$_ ?";
    ($ns[0],$ns[1],$seg,$subspec,$dist)=($1,$2,$3,$4,$5);
    if (!exists $segs{$seg}) {
	print STDERR "ditching unwired $seg$subspec\n";
	return;
    }
    $segr= $segs{$seg};
    @subsegil= $subspec =~ m/([A-Za-z]+)(\d+)/g;
    while (@subsegil) {
	($feat,$pos,@subsegil) = @subsegil;
	die "$feat ?" unless exists $segr->{Feats}{$feat};
	$featr= $segr->{Feats}{$feat};
	if (exists $featr->{Fixed}) {
	    die "$pos $featr->{Fixed} ?" unless $pos == $featr->{Fixed};
	} else {
	    die "$pos $featr->{Posns} ?" unless $pos < $featr->{Posns};
	    $featposwant{$feat}= $pos;
	}
    }
    $combpos= 0;
    for $feat (keys %{ $segr->{Feats} }) {
	$featr= $segr->{Feats}{$feat};
	next if exists $featr->{Fixed}
	die "$feat ?" if !exists $featposwant{$feat};
	$combpos += $featposwant{$feat} * $featr->{Weight};
    }
    for ($end=0; $end<2; $end++) {
	$ns[$end] =~ m/^([a-z]\w+)\.([01])$;
	($node,$side)=($1,$2);
	$nsr= $nodes{$node}[$side];
	if (!exists $nsr->{Seg}) {
	    $nsr->{Seg}= $seg;
	} elsif ($seg ne $nsr->{Seg}) {
	    die "$seg $nsr->{Seg} ?";
	}
	die "$seg $combpos ?" if @{ $segr->{Ends}[$combpos] };
	$segr->{Ends}[$combpos][$end]= [ $node, $side ];
    }
}

sub o ($) {
    print STDOUT $_[0] or die $!;
}

sub so_oboob ($) {
    my ($obj) = @_;
    my ($boob);
    $boob= $obj->{BoOb};
    $boob =~ m/^([1-9]\d)*\.([1-9]\d*)$/ or die "$boob ?";
    return sprintf "%d,%d",$1,$2;
}

sub mainread () {
    while (<>) {
	next if m/^\#/;
	chomp;
	s/\s+$//;
	next unless m/\S/;
	last if m/^end$/;
	if (m/^(invertible|vanilla|points|fixed|endwiring)$/) {
	    $mode= $1;
	    $invertible= ($mode eq 'invertible');
	    $mode= 'segment' if $mode =~ m/^(?:vanilla|invertible)$/;
	    &{"begin_$mode"};
	} else {
	    &{"line_$mode"};
	}
    }
}

sub writeout () {
    my ($seg,$segv,$pt,$ptv, $delim);
    o("/* autogenerated - do not edit */\n\n");
    @segs;
    for $seg (keys %segs) {
	$segs{$seg}{Num}= @segs;
	push @segs, $seg;
    }
    for ($segn=0; $segn<@segs; $segn++) {
	$segv= $segs{$seg};
	next unless $segv->{FeatCount};
	o("static const MovFeatInfo mfi_${seg}[]= {");
	$delim='';
	for $pt (keys %{ $segv->{Feats} }) {
	    $ptv= $segv->{Feats}{$pt};
	    next if exists $ptv->{Fixed};
	    o("$delim\n");
	    o("  { \"$seg/$pt\", $ptv->{Posns}, $ptv->{Weight} }");
	    $delim=',';
	}
	o("\n};\n");
    }
    o("static const SegmentInfo info_segments[".scalar(@segs)."]= {");
    $delim= '';
    foreach $seg (@segs) {
	$segr= $segs{$seg};
	o("$delim\n");
	o("  { \"$seg\", $segr->{Inv},\n".
	  "    $segr->{FeatCount}, ".
	  ($segr->{FeatCount} ? "mfi_${seg}" : 0).",".
	  " $segr->{Posns}, POSCOMBS, ".so_oboob($segr->{BoOb})." }");
	$delim= ',';
    }
    o("\n};\n");
}

mainread();
writeout();