#!/usr/bin/perl -w

use strict;
use lib ".";
use Geda;
use Sch;
use Pcb;
use Opt;
use Data::Dumper;

if (@ARGV < 1) { Opt::Usage("find refdes and source attributes in .sch files"); }

my ($db_sym, $db_sch, $db_fp, $db_pcb) = Geda::get_files();

my %sym_found;
my %src_found;
my %pcb_found;

sub sym_get_pins($$) {
    my $file = shift;
    my $ratt = shift;

    my @line = Common::read_file($file);
    my $data = Sch::sch_parse(@line);
    my %Hash = Sch::data2Hash($data);
    my $Hash = \%Hash;
    my %Attr = Sch::get_glb_attr($data, \%Hash);

    my $refdes    = $$ratt{refdes};
    my $graphical = $Attr{graphical}[0] // $$ratt{graphical};
    my $NET = $Attr{net};
    my %num2net = ();
    for my $Net (@$NET) {
	my ($net,$spec,@rest) = split(/:/, $Net);
	#print "<$spec> <@rest>\n";
	if (!defined($spec) || @rest != 0) {
	    warn("strange net attribute <$Net>");
	    return;
	}
	my @lst = split(/,/,$spec);
	for my $num (@lst) {
	    if (!defined($num2net{$num})) { $num2net{$num} = []; }
	    push @{$num2net{$num}}, $net;
	}

    }
    for my $k (sort { $a <=> $b } keys %num2net) {
	my @v = @{$num2net{$k}};
	if (@v < 1) {
	    delete($num2net{$k});
	    next;
	} if (@v != 1) {
	    print "Multiple net for pin $k: ", join(" ", @v), "\n";
	}
	$num2net{$k} = $v[0];
    }

    my @net = ();
    my @ix = @{$$Hash{P}};
    for my $ix (@ix) {
	my $fld = $$data[$ix]{fld};
	my ($type, $x1, $y1, $x2, $y2, $color, $pintype, $whichend) = @$fld;
	my $ratt = $$data[$ix]{rev_att};
	my $label  = $$ratt{pinlabel}  // "";
	my $pinnum = $$ratt{pinnumber} // "";
	my $net    = $$ratt{net}       // "";
	my ($x,$y) = ($x1,$y1);
	if ($whichend) {
	    ($x,$y) = ($x2,$y2);
	}
	if ($num2net{$pinnum}) {
	    $net = $num2net{$pinnum};
	}
	#if (!defined($refdes)) { print Dumper($net); }
	my $ref = {};
	$$ref{netname} = [];
	$$ref{pin} = [ [ $refdes, $pinnum, $label, $net, $graphical ] ];
	$$ref{point} = [ [ $x, $y ] ];
	push @net, $ref;
    }
    @net;
}

## [ x, y ] routines
sub pt_Cmp($$) {
    my $a = shift;
    my $b = shift;
    if (!defined($a) && !defined($b)) {
	return 0;
    } elsif (!defined($a)) {
	return -1;
    } elsif (!defined($b)) {
	return 1;
    }
    return $$a[0] <=> $$b[0]  ||  $$a[1] <=> $$b[1];
}
sub pt_cmp { pt_Cmp($a,$b); }

sub net_sort_line(@) {
    my @net = @_;
    for my $r (@net) {
	my $point = $$r{point};
	$$r{point} = [ sort { pt_cmp } @$point ];
    }
    @net;
}
sub cmp_net {
    my @A = @{$$a{point}};
    my @B = @{$$b{point}};
    for (my $ix = 0; $ix < @A+1; $ix++) {
	my $tt = pt_Cmp($A[$ix],$B[$ix]);
	return $tt if ($tt);
    }
}
sub net_sort(@) {
    my @net = @_;
    @net = sort cmp_net @net;
}
sub net_ishow($$@) {
    my $hdr = shift;
    my $iarr = shift;
    my @net = @_;

    if ($hdr) { print $hdr; }
    if (!defined($iarr)) { $iarr = [ 0 .. $#net ]; }
    #else { print Dumper($iarr); }
    for my $ix (@$iarr) {
	my $ref = $net[$ix];
	my @point   = @{$$ref{point}};
	my @netname = @{$$ref{netname}};
	my @pin     = @{$$ref{pin}};
	printf "%3d:", $ix;
	printf " n:%2d p:%2d", @netname+0, @pin+0;
	for my $r (@point) {
	    printf " / %6d %6d", $$r[0], $$r[1];
	}
	if (@netname) {	print " n:[ ", join(" ", @netname), " ]"; }
	if (@pin) {
	    print " p:[ ";
	    for (my $px = 0; $px < @pin; $px++) {
		if ($px > 0) { print ", "; }
		my @arr = @{$pin[$px]};
		if (defined($arr[0])) { print $arr[0]; }
		print ":$arr[1]/$arr[2]/$arr[3]";
		if (defined($arr[4])) { print " graphical"; }
	    }
	    print " ]";
	}
	print "\n";
    }
}
sub net_show($@) {
    my $hdr = shift;
    my @net = @_;
    net_ishow($hdr, undef, @net);
}

sub net_getN($$$) {
    my $data = shift;
    my $Hash = shift;
    my $Attr = shift;

    my @net_ix = @{$$Hash{N}};
    my @net = ();
    for my $ix (@net_ix) {
	my ($type, $x1, $y1, $x2, $y2, $color) = @{$$data[$ix]{fld}};
	my $ratt = $$data[$ix]{rev_att};
	my $netname = $$ratt{netname};
	my $net = {};
	if (defined($netname)) { $$net{netname} = [ $netname ]; }
	else { $$net{netname} = []; }
	$$net{point} = [ [ $x1+0, $y1+0 ], [ $x2+0, $y2+0 ] ];
	$$net{pin} = [];
	push @net, $net;
    }
    @net = net_sort_line(@net);
}
sub net_getC($$$) {
    my $data = shift;
    my $Hash = shift;
    my $Attr = shift;

    my @net = ();
    my @sym_ix = @{$$Hash{C}};
    for my $ix (@sym_ix) {
	my ($type, $x, $y, $selectable, $angle, $mirror, $basename) = @{$$data[$ix]{fld}};
	my $ratt = $$data[$ix]{rev_att};
	my $sym_file = Common::filedb_BNtoFull($db_sym, $basename);

	my @list = sym_get_pins($sym_file, $ratt);
	for my $ref (@list) {
	    my $pin = $$ref{point};
	    $$pin[0][0] += $x;
	    $$pin[0][1] += $y;
	    #my ($refdes, $pinnum, $label, $net, $graphical) = @{$$ref{pin}[0]};
	}
	push @net, @list;
    }
    @net;
}

sub Net_add($@) {
    my $Hash = shift;
    my @arr = @_;

    #print "Net_add:\n";
    #print Dumper(@arr);
    for (my $ix = 0; $ix < @arr; $ix++ ) {
	my $x = $arr[$ix][0];
	my $y = $arr[$ix][1];
	$$Hash{$x}{$y} = 1;
    }
}
sub Net_merge(@) {
    my @net = @_;

    if (@net < 2) {
	return @net;
    }

    my @res = ();

    while (@net) {
	my $tst = shift @net;
	my %Hash = (); # index into @res
	#print "tst:\n";
	#net_show("tst\n",$tst);
	#print Dumper(@{$$tst{point}});
	Net_add(\%Hash, @{$$tst{point}});

	my @tst_set = @net;
	my @out = ();
	while (@tst_set) {
	    my $r = shift @tst_set;
	    my $in = 0;

	    for (my $ix = 0; $ix < @{$$r{point}}; $ix++ ) {
		my $x = $$r{point}[$ix][0];
		my $y = $$r{point}[$ix][1];
		if ($Hash{$x} && $Hash{$x}{$y}) {
		    $in = 1;
		    last;
		}
	    }
	    if ($in) {
		#print "merge:\n";
		#print Dumper($$tst{pin});
		#print Dumper($$r{pin});
		push @{$$tst{netname}}, @{$$r{netname}};
		push @{$$tst{pin}}, @{$$r{pin}} if (@{$$r{pin}});
		#print Dumper($$tst{pin});
		Net_add(\%Hash, @{$$r{point}});
		push @out, @tst_set;
		@tst_set = @out;
		@out = ();
	#net_show("r\n",$r);
	    } else {
		push @out, $r;
	    }
	}
	@net = @out;
	my @arr = ();
	#print "Hash:\n"; print Dumper(\%Hash); print "\n";
	for my $x (sort {$a<=>$b} keys %Hash) {
	    for my $y (sort {$a<=>$b} keys %{$Hash{$x}}) {
		push @arr, [ $x, $y ];
	    }
	}
	$$tst{point} = [ @arr ];
	push @res, $tst;
    }

    @res;
}
sub Net_vert(@) {
    my @net = @_;

    my %vert = ();

    for (my $ix = 0; $ix < @net; $ix++) {
	my $r = $net[$ix];
	my $x = $$r{point}[0][0] + 0;
	if ( @{$$r{point}} == 2 && $x == $$r{point}[1][0]+0 ) {
	    if (!defined($vert{$x})) {
		$vert{$x} = [];
	    }
	    push @{$vert{$x}}, $ix;
	}
    }
    for my $x (keys %vert) {
	@{$vert{$x}} = sort { $net[$a]{point}[0][1] <=> $net[$b]{point}[0][1] } @{$vert{$x}};
    }

    %vert;
}
sub Net_horiz(@) {
    my @net = @_;

    my %horiz = ();

    for (my $ix = 0; $ix < @net; $ix++) {
	my $r = $net[$ix];
	my $y = $$r{point}[0][1] + 0;
	if ( @{$$r{point}} == 2 && $y == $$r{point}[1][1]+0 ) {
	    if (!defined($horiz{$y})) {
		$horiz{$y} = [];
	    }
	    push @{$horiz{$y}}, $ix;
	}
    }
    for my $y (keys %horiz) {
	@{$horiz{$y}} = sort { $net[$a]{point}[0][0] <=> $net[$b]{point}[0][0] } @{$horiz{$y}};
    }

    %horiz;
}

#sub run($$);
sub run($$) {
    my $file = shift;
    my $rd = shift;

    my @line = Common::read_file($file);
    my $data = Sch::sch_parse(@line);
    my %Hash = Sch::data2Hash($data);
    my $Hash = \%Hash;
    my %Attr = Sch::get_glb_attr($data, \%Hash);
    my $Attr = \%Attr;

    my @net = ();
    push @net, net_getN($data,$Hash,$Attr);
    push @net, net_getC($data,$Hash,$Attr);

    @net = net_sort(@net);
    net_show("\@net =\n", @net);

    ### TODO merge the nets if possible

    #@net = net_squash(@net);
    #@net = Net_merge(@net);
    my %vert  = Net_vert(@net);
    my %horiz = Net_horiz(@net);

    print "vertical\n";
    for my $x (sort { $a <=> $b } keys %vert) {
	net_ishow(undef, $vert{$x}, @net);
    }
    print "horizontal\n";
    for my $y (sort { $a <=> $b } keys %horiz) {
	net_ishow(undef, $horiz{$y}, @net);
    }
    #net_show("b\n", @net);
}

for my $file (@ARGV) {
    if ($file !~ m/\.sch/) {
	warn("only run this program on .sch files");
	next;
    }

    run($file, "");
}

__END__

sub Net_add(@) {
    my @net = @_;

    my @Net = ();
    my %Net = ();
    for (my $ix = 0; $ix < @net; $ix++) {
	my ($netname, $sta, $end) = @{$net[$ix]};

	if      (defined($Net{$sta[0]}) && defined(my $net = $Net{$sta[0]}{$sta[1]})) {
	    if (defined($Net{$end[0]}) && defined(my $net = $Net{$end[0]}{$end[1]})) {
		
	    }
	    NetIns($Net[$net], $end);
	} elsif (defined($Net{$end[0]}) && defined(my $net = $Net{$end[0]}{$end[1]})) {
	    NetIns($Net[$net], $sta);
	} else {
	    push @Net, $net[ix];
	    $Net{$sta[0]}{$sta[1]} = $#Net;
	    $Net{$end[0]}{$end[1]} = $#Net;
	}
    }
    [ \@Net, \%Net ];
}

sub net_merge($$) {
    my $A = shift;
    my $B = shift;

    if ($$A[0] eq $$B[0]) { # same net name
	return 1;
    }

    while (@org) {
	my $A = shift @org;
	push @net, $A;
	while (@org) {
	    my $B = shift @org;
	    if ( net_merge($A, $B) ) {
		push @rst, $B;
	    }
	}
	@org = @rst;
    }

}



    for my $sym (@ref_pin) {
	my ($basename, $refdes, $src) = @$sym;
	$sym_found{$basename}++;
	my $pcb = $src;
	$pcb =~ s/\.sch/.pcb/;
	$src_found{$src}++;
	if (!defined($pcb_found{$pcb})) {
	    $pcb_found{$pcb} = [];
	}
	push @{$pcb_found{$pcb}}, "$rd$refdes";
	my $src_file = Common::filedb_BNtoFull($db_sch, $src);
	run($src_file, $refdes);
    }

for my $k (sort keys %sym_found) {
    my $file = Common::filedb_BNtoFull($db_sym, $k);
    print "$file\n";
}
print "\n";
for my $k (sort keys %src_found) {
    my $file = Common::filedb_BNtoFull($db_sch, $k);
    print "$file\n";
}
print "\n";
for my $k (sort keys %pcb_found) {
    my @val = @{$pcb_found{$k}};
    my $file = Common::filedb_BNtoFull($db_pcb, $k);
    if ($file) { print "$file  "; }
    else { print "$k missing  "; }
    print  "<", join("/", @val), ">\n";
}


sub chknet($$@) {
    my $pn = shift;
    my $net = shift;
    my $netname = shift;
    my @point = @_; # [ [x,y], ... ]

    my $index = undef;
    for my $p (@point) {
	my ($x, $y) = @$p;
	if ( defined($$pn{$x}) && defined(my $ix =  $$pn{$x}{$y}) ) {
	    $index = $ix;
	    last;
	}
    }
    if (defined($index)) {
	my $ref = $$net[$index];
	if ($$ref[0] && $netname) {
	    warn("duplicate net names: $$ref[0] && $netname");
	}
	if (!defined($$ref[0])) { $$ref[0] = $netname; }
	$netname = shift @$ref;
	push @$ref, ( @point );
	@$ref = sort { $$a[0] <=> $$b[0] && $$a[1] <=> $$b[1] } @$ref;
	unshift @$ref, $netname;
	my $ix = $#{$net};
	for my $p (@point) {
	    my ($x, $y) = @$p;
	    $$pn{$x}{$y} = $ix;
	}
	#print "ack $index\n";
    } else {
	push @$net, [ $netname, @point ];
	my $ix = $#{$net};
	for my $p (@point) {
	    my ($x, $y) = @$p;
	    $$pn{$x}{$y} = $ix;
	}
	#print "$ix\n";
    }
}

