#!/usr/bin/perl

# ./chow_parts.pl -c pin_count.txt -p pin_list.txt -P part_list.txt -R -e equivalent_names.txt -s thing
# ./chow_parts.pl -c pin_count.txt -p pin_list.txt -P part_list.txt -R -e equivalent_names.txt


require "getopts.pl";

use strict;

&Getopts('Rp:P:s:e:c:CV');

use vars qw($opt_p $opt_P $opt_R $opt_s $opt_e $opt_c $opt_C $opt_V);

my ($global, $nets, $net_list, $positions, $part_list, $packages);
$global->{'black'} = 0;
$global->{'magenta'} = 5;
$global->{'cyan'} = 3;
$global->{'red'} = 4;
$global->{'pink'} = 29;
$global->{'border'} = 400;
$global->{'row_length'} = 50;
$global->{'column_length'} = 28;
$global->{'pin_hole_size'} = 60;
$global->{'row_size'} = 200;
$global->{'col_size'} = 800;
$global->{'col_pad'} = 100;

$global->{'verbose_toggle'} = 0;
if(length($opt_V) > 0) {
    $global->{'verbose_toggle'} = 1;
}

my $eqiv_names;
if(length($opt_e) > 0) {
    open(F_IN, $opt_e) || die "cant open: $opt_e";
    while() {
	s/\n//;
        if (/^NET:/) {
           s/NET: //;
           my @l = split(/\s/);
           my $name = shift(@l);
           foreach my $e (@l) {
	     $eqiv_names->{$e} = $name;
          }
        }
        if (/^PIN:/) {
           s/PIN: //;
           my($part, $pin1, $pin2) = split(/::/);
	   $global->{'equiv_pin_name'}->{$part}->{$pin1} = $pin2;
        }
    }
    close(F_IN);
}

if(length($opt_p) > 0) {
    ($nets, $net_list) = collect_nets($opt_p, $eqiv_names);
}
else {
    die "must supply a pin list with -p";
}

if(length($opt_c) > 0) {
    $packages = collect_package_info($opt_c);
}
else {
    die "must supply a pin_count list with -c";
}

if(length($opt_P) > 0) {
    ($positions, $part_list) = get_positions($opt_P, $packages);
}
else {
    die "must supply a pin list with -p";
}

$global->{'report_toggle'} = 0;
if(length($opt_R) > 0) {
    $global->{'report_toggle'} = 1;
}

$global->{'collision_toggle'} = 0;
if(length($opt_C) > 0) {
    $global->{'collision_toggle'} = 1;
}

check_parts($positions, $part_list, $nets, $net_list);

my $show_this;
if(length($opt_s) > 0) {
    open(F_IN, $opt_s) || die "cant open: $opt_s";
    while() {
	s/\n//;
	s/\s*//;
	$show_this->{$_} = 1;
    }
    close(F_IN);
}
else {
    # show 'em all
    foreach my $part (@$part_list) {
	$show_this->{$part} = 1;
    }
}

if ($global->{'report_toggle'} == 1) {
    report_nets($nets, $net_list, $positions, $show_this);
}
else {
    draw_circuit($part_list, $positions);
}


sub report_nets {
    my($nets, $net_list, $positions, $show, $names) = @_;
    my $net;
    my ($i, %done, @l, @columns, %collision);
    my ($row, $col, $device, $pin, $coord);

    my $go;
    
    foreach $net (@$net_list) {
	$go = 0;

	for($i = 0; $i < $nets->{$net}->{'count'}; $i++) {
	    $device = $nets->{$net}->{$i}->{'device'};
	    $pin = $nets->{$net}->{$i}->{'pin'};

	    ($col, $row) = get_board_position($device, $pin, $positions);

	    if (length($col) > 0) {
		 $coord = $col . "_" . $row;

                 if ($global->{'collision_toggle'}) {
		      print  "COLLISION: pin $pin of device $device has pin positions that collide with: $collision{$coord} at col: $col row $row\n" if (length($collision{$coord}) > 0) 
                 }
	        $collision{$coord} = $device;
	    }

	    $go++ if ($show->{$device} == 1);
	    if (length($col) > 0 ) {
		push(@l, $col . " " . $row . " " . $device . "_" . $pin);
		push(@columns, $col) if ($done{$col} != 1);
		$done{$col} = 1;
	    }
	}

	if ($go != 0 ) {
	    print "NET: $net\n";
	    foreach my $col (sort_by_column(@columns)) {

		foreach my $item (get_list($col, @l)) {

		    ($row, $device) = split(/\s/, $item);

		    ($device, $pin) = split('_',$device);

                    $col = "__" if ($col eq "NONE");

		    if ($positions->{$device}->{'dontreport'} != 1) {
			printf("   %s :: %s :: %s_%s\n",
			       $col,
			       $row,
			       $device,
			       $pin);
		    }
		}
	    }
	}

	@l = ();
    }
}

sub sort_by_column {
    my(@l) = @_;
    my($e, @l2);

    foreach $e (sort @l) {
	push (@l2, $e) if (length($e) == 1);
    }
    foreach $e (sort @l) {
	push (@l2, $e) if (length($e) == 2);
    }
    foreach $e (sort @l) {
	push (@l2, $e) if ($e eq "NONE");
    }

    return(@l2);
}

sub get_list {
    my($c, @l) = @_;

    my($col, $row, $device, @l2);

    foreach my $item (sort @l) {
	($col, $row, $device) = split(/\s/, $item);

	push(@l2, $row . " " . $device) if ($c eq $col);
    }

    return(sort numerically @l2);
}


sub get_board_position {
    my ($part, $pin, $positions) = @_;
    my ($pin_num, $pin_cols);

    my ($row, $col);
    if ($positions->{$part}->{'no_position'} == 0) {
	$col = $positions->{$part}->{'col'};
	$row = $positions->{$part}->{'row'};

	# $pin_num is the number of pins on one side of the part
        # $pin_cols is how many columns
        # like a DIL14 has 7 pins two columns
	
        if (length($positions->{$part}->{'pin_num'}) != 0) {
             $pin_num = $positions->{$part}->{'pin_num'};
             $pin_cols = $positions->{$part}->{'pin_cols'}; 
        }	
        else {
             print "THERE's NO PINCOUNT FOR PART: $part\n";
        }
	# are pins on the left or right side of the part?

        # note: this assumes pin_cols = 1 or pin_cols = 2.
	if ($pin > $pin_num && $pin_cols > 1) { # its on the right
	    # this is the next letter
	    $col = num2letter(letter2num($col) + 1);
	    # and we have to count up from the bottom.

	    $row = $row + $pin_num - ($pin - $pin_num);
	}
	else { # its on the left side
	    $row = $row + $pin - 1;
	}

	# print " --> $col $row\n";
    }
    else {
  	$col = "NONE";
        $row = $pin;
    }

    return($col, $row);
}

sub collect_nets {
    my $f = shift;
    my $eqiv_names = shift;

    my $start = 0;
    my ($pin, $device, $net, $pin_name, $null);
    my ($count, %done, @net_list, %net_struct);

    open(F_IN, $f) || die "cant open $f";
    while() {
	last if(/^Part\s*Pad\s*Pin/);
    }

    while() {
	s/\n//;

	if (length($_) < 2) {
	    # nuffin
	}
	elsif(!/^\s/) {
	    s/\s*\*.*//;
	    split(/\s+/);
	    $device = $_[0];
	    $pin = $_[1];
	    $null = $_[2];
	    $null = $_[3];
	    $net = $_[4];

	    if (length($eqiv_names->{$net}) > 0) {
		$net = $eqiv_names->{$net};
	    }

	    $pin_name = create_pin_name($pin, $device);

	    push(@net_list, $net) if ($done{$net} != 1);
	    $done{$net} = 1;
	    $count = 0;

	    if (length($net) > 0) {

		$net_struct{$net}->{'count'} = 0 if (length($net_struct{$net}->{'count'}) == 0);
	        # print "PIN: $device :: $pin :: $net :: $pin_name :: $net_struct{$net}->{'count'} \n";
		$net_struct{$net}->{$net_struct{$net}->{'count'}}->{'device'} = $device;
		$net_struct{$net}->{$net_struct{$net}->{'count'}}->{'pin'} = $pin_name;
		$net_struct{$net}->{'count'}++;
	    }
	}
	else {
	    s/\s*\*.*//;
	    s/^\s*//;
	    split(/\s+/);
	    $pin = $_[0];
	    $null = $_[1];
	    $null = $_[2];
	    $net = $_[3];
	    $pin_name = create_pin_name($pin, $device);

	    if (length($eqiv_names->{$net}) > 0) {
		$net = $eqiv_names->{$net};
	    }

	    push(@net_list, $net) if ($done{$net} != 1);
	    $done{$net} = 1;

	    if (length($net) > 0) {

		$net_struct{$net}->{'count'} = 0 if (length($net_struct{$net}->{'count'}) == 0);
		$net_struct{$net}->{$net_struct{$net}->{'count'}}->{'device'} = $device;
		$net_struct{$net}->{$net_struct{$net}->{'count'}}->{'pin'} = $pin_name;
		$net_struct{$net}->{'count'}++;

	    }
	}

    }

    @net_list = sort_on_count((\%net_struct, \@net_list));

    return(\%net_struct, \@net_list);
}

sub sort_on_count {
    my($s, $l) = @_;

    my (@q, $x, @r);

    foreach my $x (@$l) {

	push(@q, $s->{$x}->{'count'} . " " . $x);

    }

    @q = reverse(sort numerically @q);
    foreach my $x (@q) {

	$x =~ s/.* //;

	push(@r, $x);
    }
    return(@r);
}

sub create_pin_name {
    my $pin = shift;
    my $device = shift;
    my ($n);

    if (length($global->{'equiv_pin_name'}->{$device}->{$pin}) > 0) {
	$n = $global->{'equiv_pin_name'}->{$device}->{$pin};
    }
    elsif ($pin =~ /\D/) {
 	print "PIN: $pin contains non-numerical value in device: $device\n";
    }
    else {
        $n = $pin;
    }

    return($n);
}

sub check_parts {
    my($positions, $part_list, $nets, $net_list) = @_;

    my ($i, %done, $device, @l);

    foreach my $net (@$net_list) {

	for($i = 0; $i < $nets->{$net}->{'count'}; $i++) {
	    $device = $nets->{$net}->{$i}->{'device'};

	    push(@l, $device) if ($done{$device} != 1);
	    $done{$device} = 1;
	}
    }

    foreach $device (@l) {
	if (length($positions->{$device}->{'col'}) == 0 &&
	    length($positions->{$device}->{'min_col'}) == 0) {
            if ($global->{'verbose_toggle'}) {
              print "No position for this device: $device\n";
            }
	}

    }

    foreach my $device (@$part_list) {
	if ($done{$device} != 1) {
	    print "No net for this device: $device\n";
	}
    }
}

sub collect_package_info {
    my $f = shift;
    my ($s, $package, $num, $cols);

    # all this does is collect the pin counts for packages
    open(F_IN, $f) || die "cant open: $f";
    while() {
	s/\n//;
	if (length($_) != 0 ) {
           ($package, $num) = split(/\s+/);
           if ($num =~ /-/) {
              $s->{$package}->{'pin_num'} = $num;
              ($num, $cols) = split(/-/, $num);
              $s->{$package}->{'pin_num'} = $num;
              $s->{$package}->{'pin_cols'} = $cols;
           }
           else {
              $s->{$package}->{'pin_num'} = $num;
              $s->{$package}->{'pin_cols'} = 1;
           }
        }
    }
    return($s);
}

sub get_positions {
    my $f = shift;
    my $package_info = shift;
    my ($p, $x, $y, $z, @l, %done, $row, $col);
    my ($pin_num, $pin_cols, $part, $pos, $package);

    open(F_IN, $f) || die "cant open: $f";
    while() {
	s/\n//;
	last if(/^Part     Value/);
    }

    while() {
	s/\;.*//;
	s/\n//;
	if (/\S/) {
	    s/\n//;
	    $part = substr($_,0,9);
	    $pos = substr($_,9,18);
	    $package = substr($_,46,14);

            ($x, $pos) = split(/\s/,$pos);

	    $part =~ s/\s+//;
	    $package =~ s/\s+//;

	    if (!($pos =~ /-/)) {
                $pos = "";
	    }

            if (length($package_info->{$package}->{'pin_num'}) != 0) {
                $pin_num = $package_info->{$package}->{'pin_num'};
                $pin_cols = $package_info->{$package}->{'pin_cols'}; 
            }	
            else {
                print "THERE's NO PACKAGE FOR PART: $part WITH PACKAGE: $package\n";
                exit(1);
            }

	    if ($pos =~ /\-/) { # it contained a dash and is a position

		($col, $row) = split(/\-/, $pos);

		$p->{$part}->{'col'} = $col;
		$p->{$part}->{'row'} = $row;

		if (length($p->{$part}->{'min_row'}) > 0) {
		    $p->{$part}->{'min_row'} = min($p->{$part}->{'min_row'}, $row);
		    $p->{$part}->{'max_row'} = max($p->{$part}->{'max_row'}, $row);
		}
		else {
		    $p->{$part}->{'min_row'} = $row;
		    $p->{$part}->{'max_row'} = $row;
		}
                $p->{$part}->{'pin_num'}= $pin_num;
                $p->{$part}->{'pin_cols'}= $pin_cols;
                $p->{$part}->{'no_position'}= 0;
             }
             else {
                $p->{$part}->{'no_position'}= 1;
             }
	}

        push(@l, $part) if ($done{$part} != 1 && $p->{$part}->{'dontreport'} != 1);

        $done{$part} = 1;
    }
    close(F_IN);

    return($p, \@l);
}

sub letter2num {
    my $l = shift;

    # life would be easier if the people that made the board didnt remove 
    #  "I" from their alphabet

    my $x;

    $x->{'A'} = 0;
    $x->{'B'} = 1;
    $x->{'C'} = 2;
    $x->{'D'} = 3;
    $x->{'E'} = 4;
    $x->{'F'} = 5;
    $x->{'G'} = 6;
    $x->{'H'} = 7;
    $x->{'J'} = 8;
    $x->{'K'} = 9;
    $x->{'L'} = 10;
    $x->{'M'} = 11;
    $x->{'N'} = 12;
    $x->{'P'} = 13;
    $x->{'R'} = 14;
    $x->{'S'} = 15;
    $x->{'T'} = 16;
    $x->{'U'} = 17;
    $x->{'W'} = 18;
    $x->{'X'} = 19;
    $x->{'Y'} = 20;
    $x->{'Z'} = 21;
    $x->{'AA'} = 22;
    $x->{'BB'} = 23;
    $x->{'CC'} = 24;
    $x->{'DD'} = 25;
    $x->{'EE'} = 26;
    $x->{'FF'} = 27;

    return($x->{$l});
}

sub num2letter {
    my $n = shift;

    my $x;

    $x->{0} = "A";
    $x->{1} = "B";
    $x->{2} = "C";
    $x->{3} = "D";
    $x->{4} = "E";
    $x->{5} = "F";
    $x->{6} = "G";
    $x->{7} = "H";
    $x->{8} = "J";
    $x->{9} = "K";
    $x->{10} = "L";
    $x->{11} = "M";
    $x->{12} = "N";
    $x->{13} = "P";
    $x->{14} = "R";
    $x->{15} = "S";
    $x->{16} = "T";
    $x->{17} = "U";
    $x->{18} = "W";
    $x->{19} = "X";
    $x->{20} = "Y";
    $x->{21} = "Z";
    $x->{22} = "AA";
    $x->{23} = "BB";
    $x->{24} = "CC";
    $x->{25} = "DD";
    $x->{26} = "EE";
    $x->{27} = "FF";

    return($x->{$n});
}
sub draw_circuit {
    my($part_list, $positions) = @_;

    fig_header();
    draw_holes();
    draw_devices($part_list, $positions);
}

sub draw_devices {
    my($parts, $positions) = @_;
    my($num, $col1, $col2, $x1, $x2, $y1, $y2);

    # I have probably broken this by making use of pin_num and pin_cols 
    # in other functions, but didnt change this code to use pin_num and pin_cols.

    foreach my $part (@$parts) {

	if (length($global->{$part}->{'pin_num'}) > 0) {
	    $num = $global->{$part}->{'pin_num'};
	}
	else {
	    $num = 2;
	}

	if (length($positions->{$part}->{'row'})) {
	    $num++ if ($num / 2 != int($num/2)); # odd

	    $num = ($num / 2) - 1;

	    $col1 = $positions->{$part}->{'col'};
	    $col2 = num2letter(letter2num($col1) + 1);

	    $x1 = col2x($col1) - ($global->{'col_pad'} / 2);
	    $x2 = col2x($col2) + ($global->{'col_pad'} / 2);
	    $y1 = row2y($positions->{$part}->{'row'})  
	    - ($global->{'row_size'} / 2);
	    $y2 = row2y($positions->{$part}->{'row'} + $num)
	    + ($global->{'row_size'} / 2);

	}
	else {
	    $col1 = $positions->{$part}->{'min_col'};
	    $col2 = $positions->{$part}->{'max_col'};

	    $x1 = col2x($col1) - ($global->{'col_pad'} / 2);
	    $x2 = col2x($col2) + ($global->{'col_pad'} / 2);
	    $y1 = row2y($positions->{$part}->{'min_row'})  
	    - ($global->{'row_size'} / 2);
	    $y2 = row2y($positions->{$part}->{'max_row'})
	    + ($global->{'row_size'} / 2);

	}

	my $c = $global->{'black'};

	printf("2 2 0 1 %d %d 100 0 -1 0.000 0 0 -1 0 0 5\n", 
	       $c, $c);

	printf("\t $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1\n");

	printf("4 1 0 50 0 16 12 0.0000 4 135 285 %d %d %s\\001\n",
	       $x1 + (($x2 - $x1) / 2),
	       $y1 + $global->{'row_size'}, 
	       $part)

    }

}

sub draw_holes {
    my($i, $j);

    my $c = $global->{'black'};

    my $r = $global->{'pin_hole_size'} / 2;

    my ($x1, $x2, $x3, $x, $y, $y1, $y2, $y3);

    for($i=0;$i<$global->{'column_length'};$i++) {
	for($j=1;$j<$global->{'row_length'};$j++) {
	    $x = col2x(num2letter($i));
	    $y = row2y($j);

	    $x1 = $x - $r;
	    $x2 = $x;
	    $x3 = $x + $r;

	    $y1 = $y - $r;
	    $y2 = $y;
	    $y3 = $y + $r;

	    printf("2 2 0 1 %d %d 100 0 20 0.000 0 0 -1 0 0 5\n", 
		       $c, $c);

	    printf("\t $x1 $y2 $x2 $y1 $x3 $y2 $x2 $y3 $x1 $y2\n");


	    if ($j / 2 == int($j / 2)) {
		if ($i == 0) {
		    printf("4 2 0 50 0 16 12 0.0000 4 135 285 %d %d %s\\001\n",
			   col2x(num2letter($i)) - ($global->{'col_pad'}/2),
			   row2y($j) +  ($global->{'row_size'} / 3),
			   $j);
		}
		if ($i / 2 != int($i / 2)) {
		    printf("4 0 0 50 0 16 12 0.0000 4 135 285 %d %d %s\\001\n",
			   col2x(num2letter($i)) + $global->{'col_pad'},
			   row2y($j) +  ($global->{'row_size'} / 3),
			   $j);
		}
	    }
	}

	printf("4 1 0 50 0 16 12 0.0000 4 135 285 %d %d %s\\001\n",
	       col2x(num2letter($i)),
	       row2y(1) - ($global->{'row_size'} / 2),
	       num2letter($i));

	printf("4 1 0 50 0 16 12 0.0000 4 135 285 %d %d %s\\001\n",
	       col2x(num2letter($i)),
	       row2y($global->{'row_length'}),
	       num2letter($i));

    }
}

sub row2y {
    my $y = shift;
    
    return (int($y * $global->{'row_size'}) + $global->{'border'});
}

sub col2x {
    my $x = shift;
    
    $x = letter2num($x);
    
    my $half = $x / 2;

    if ($half == int($half)) { # even

	$x = $half * ($global->{'col_size'} + $global->{'col_pad'});
	$x -= $global->{'col_pad'};
	
    }
    else {
	$x = $half * ($global->{'col_size'} + $global->{'col_pad'});
    }

    return (int($x + $global->{'border'}));
}

sub numerically {
    $a <=> $b;
}

sub fig_header {
    my $self = shift;
    my($i, $j);

    print "\#FIG 3.2\n";
    print "Landscape\n";
    print "Center\n";
    print "Inches\n";
    print "Letter  \n";
    print "100.00\n";
    print "Single\n";
    print "-2\n";
    print "1200 2\n";

}

sub max {
    my($x,$y) = @_;
    return ($x >= $y) ? $x :$y;
}
        
sub min {
    my($x,$y) = @_;
    return ($x < $y) ? $x :$y;
}

sub max_alpha {
    my($x,$y) = @_;

    $x = letter2num($x);
    $y = letter2num($y);

    my $r = $x;
    $r = $y if ($y > $x);

    return (num2letter($r));
}
        
sub min_alpha {
    my($x,$y) = @_;

    $x = letter2num($x);
    $y = letter2num($y);

    my $r = $x;
    $r = $y if ($y < $x);

    return (num2letter($r));
}