#!/usr/contrib/bin/perl -w
# Convert a Spice 3f4 .cir file to mpcirc diagram drawing commands.

# $Log: spice2circ,v $
# Revision 0.2  1996/12/01 02:28:18  tjchol01
# Started to implement subcircuits.
#
# Revision 0.1  1996/12/01 00:43:24  tjchol01

my %knownelems = (
		  "RVAR" => "Rvar",
		  "R" => "R",
		  "CVAR" => "Cvar",
		  "CEL" => "Cel",
		  "C" => "C",
		  "L" => "L",
		  "V" => "V",
		  "I" => "I",
		  "G" => "gm",
		  "E" => "rm",
		  "Q" => "Q"
);
my %knownmodels = (
	      "R" => "Rx",
	      "C" => "Cx",
	      "SW" => "sw",
	      "CSW" => "csw",
	      "URC" => "urc",
	      "LTRA" => "ltra",
	      "D" => "D",
	      "NPN" => "npn",
	      "PNP" => "pnp",
	      "NJF" => "nfet",
	      "PJF" => "pfet",
	      "NMOS" => "namos",
	      "PMOS" => "pamos",
	      "NMF" => "nmfet",
	      "PMF" => "pmfet"
);

my %pinnames = (
		"K" => "ll",			# coupled inductors !!!
		"Q" => "cbe",
		"J" => "dgs",
		"M" => "dgsb",
		"G" => "badc",
		"V" => "ba",
		"S" => "abcd",			# V controlled switch
		"W" => "ab",			# I -||-
		"default" => "ab",
);

my $whitespace = '[ \t(),=]';

my $prolog = <<EOF;
%texlabels := 1;
tracingstats:=1;
prologues:=2;
u:=10bp;
input mpcirc;

beginfig(1)
EOF

my $epilog = <<EOF;
endfig;
end;
EOF

my $progname = "spice2circ";

$| = 1;						# output buffering off

use strict;
#no strict "refs";

my $verbose = 0;
my $debug = 0;

while ($_ = $ARGV[0], /^-/) {			# process options
    shift;
    last if /^--$/;
    if (/^-d/) {
	$debug++;
    } elsif (/^-v/) {
	$verbose++;
    } else {
	print "Usage: $progname [-v] file.cir\n";
	exit 1;
    }
}


my $descr = <>;
exit 1 if (!$descr);				# file not found?
chop $descr;
if ($verbose) {
    print STDERR "Converting: \"$descr\"\n";
}

# output metacirc file
print $prolog;
print "message \"$descr\";\n";
my $lookahead = <>;				# initialize |get_line|
my @lines;
 LINE:
    while ($_ = get_line()) {
	chop;
	last LINE if (/^\.END$/i);
	if (/^($whitespace+)/ || /^$/) {		# skip other comments
	    next LINE;
	}
	push (@lines, $_);
    }

&parsespice (\@lines, \%knownelems, \%knownmodels);
print $epilog;

exit 0;



sub parsespice {
    my @curlines = @{$_[0]};
    my %curelems = %{$_[1]};
    my %curmodels = %{$_[2]};

    my @sublines;
    my ($found, $i, $rline, $section);
    my @newlines;
    my $predraw = "";
    my $postdraw = "";
    $section = 0;				# pre
    my @pins;
    my ($key, $val);
# first pass to read models and comments
LINE:
    foreach (@curlines) {
	if ($rline = /^\*CIRC$/ .. /^\*ENDCIRC$/) {	# commands for mpcirc
	    if ($rline > 1 && $rline !~ /E0$/) {
		s/^\*//;				# get rid of an asterisk
		if (/^PRE/) {
		    $section = 0;
		} elsif (/^POST/) {
		    $section = 1;
		} elsif (/^PROLOG/) {
		    $section = 2;
		} else {
		    if ($section == 0) {
			$predraw .= $_ . "\n";
		    } elsif ($section == 1) {
			$postdraw .= $_ . "\n";
		    } else {
			$prolog .= $_ . "\n";
		    }
		}
	    }
	    next LINE;
	}
	if (/^\*/) {				# skip comments
	    next LINE;
	}

# collect subcircuits
	if ($rline = /^\.SUBCKT$whitespace+(\w+)$whitespace+(.*)$/i .. /^\.ENDS/i) { # subckt
	    push (@sublines, $_);
	    next LINE;
	}

	if (/^\.(\w+)$whitespace+(.*)/) {			# command
	    if (uc $1 eq "MODEL") {
		my ($modelname, $model) = split ("$whitespace+", $2);
		$found = 0;
	      CIRCMODEL:
		foreach (keys %curmodels) {
		    if ($model =~ /^$_(.*)/i) {
			$model = sufcat ($curmodels{$_}, $1);	# allow npn.a models
			$found = 1;
			last CIRCMODEL;
		    }
		}
		warn "Unknown model $model.\n" unless $found;
		$curmodels{$modelname} = $model;
	    }
	    next LINE;
	}
	push (@newlines, $_);
    } # foreach @curlines


    if (@sublines) {
	my @susublines;
	foreach (@sublines) {
	    if ($rline = /^\.SUBCKT$whitespace+(\w+)$whitespace+(.*)$/i .. /^\.ENDS($whitespace|$)/i) { # subckt
#		print "$rline: $_\n";
		if ($rline == 1) {
		    @susublines = ();
		    my $subcktname = $1;
		    @pins = split ("$whitespace+", $2);
		    $pinnames{$subcktname} = substr ("abcdefghijklmnopqrstuvwxyz", 0, $#pins + 1);
		    %curelems = ($subcktname, $subcktname, %curelems); # prepend
#		    print "$subcktname = @pins\n";
		    print "defelem ($subcktname,\n";
		} elsif ($rline =~ /E0/) {
#		    print "XXX\n";
		    &parsespice (\@susublines, \%curelems, \%curmodels); # recurrent call
		    for ($i = 0; $i <= $#pins; $i++) {
			my $le = chr ($i + ord "a");
			print "addpin.$le (", sufcat("z", $pins[$i]), ")(lft);\n";
		    }
		    print ");\n\n";
		} else {
		    push (@susublines, $_);
		}
	    }
	}
    }


    my %elems;
    my %nodes;
    my @wires;
    my $jelem = "J";
    my $jcnt = 0;
    my ($pins, $pincnt);

    foreach (@newlines) {				# second pass: analyze
	my ($elem, @rest) = split ("$whitespace+", $_);
#    print "($elem, @rest)\n";
	my $elemtype = uc substr ($elem, 0, 1);
	if ($elemtype eq "X") {
	    $elemtype = $rest[$#rest];
	}

	$pins = $pinnames{$elemtype};
	if (!$pins) {
	    $pins = $pinnames{"default"};
	}
#	print "zz $pins\n";
	$pincnt = length ($pins);

	my $val = $rest[$pincnt];
#    my $val = join (' ', @rest[$pincnt .. $#rest]);
# introduce models into elem names
	if ($elem =~ /^[QM](.*)/i) {
	    my $model = $curmodels{$val};
	    if (!$model) {
		warn "Undefined model $val\n";
		$model = "npn";			# default transistor type
	    }
	    $elem = sufcat ($model, $1);
	} elsif ($elem =~ /^X(.*)/i) {
	    $elem = sufcat ($elemtype, $1);
	} else {
# find $elem among known, convert to proper case
# and insert `.' only if not followed by a digit
	    $found = 0;
	  CIRCEL:
#showhash(\%curelems);
	    foreach (keys %curelems) {
#		print "$elem -- $_\n";
		if ($elem =~ /^$_(.*)/i) {
		    $elem = sufcat ($curelems{$_}, $1);
		    $found = 1;
		    last CIRCEL if ($found);
		}
	    }
	    warn "Unknown element $elem.\n" unless $found;
	}

	for ($i = 0; $i < $pincnt; $i++) {
	    hpush (\%nodes, $rest[$i], sufcat ($elem, substr ($pins, $i, 1)));
	}
	$elems{$elem} = [$val, @rest[0..$pincnt-1] ];

    } # while LINE

    if ($debug) {
#	showhash (\%curmodels);
	showhasharr (\%elems);
	showhasharr (\%nodes);
    }
    print "sprepare (", join (',', sort keys %elems), ");\n\n";
	print "z0=origin;\n";

	my @dots;
    while (($key, $val) = each %nodes) {	# changes order
	if ($#{$val} > 1) {
	    push (@dots, $key);
#	    my $newj = $jelem . $key;
#	    $elems{$newj} = $key;
#	    foreach (@$val) {
#		push (@wires, "$newj,$_");
#	    }
	} elsif ($#{$val} == 1) {
	    print sufcat("z", $key), " = .5[", join (',', @$val), "];\n";
#	    push (@wires, join (',', @$val));
	}
    }

	print "placenodes ", join (',', keys %nodes), ";\n";


    while (($key, $val) = each %elems) {		# values
	my $v = shift @$val;
	my @n = @$val;
	print "betw ($key) ", join (',', @n), ";\n";
	if ($v) {
	    print sufcat($key, "val"), " = \"$v\";\n";
	}
    }

    print $predraw;
    print "\nedraw;\n\n";
	if (@dots) {
	print "labeledjunction ", join (',', @dots), ";\n";
    }
    print $postdraw;
    print map ("wire.h ($_);\n", @wires);
}


# push an $elem on position $i in hash %$h
sub hpush {
    my ($h, $i, $elem) = @_;
    if (defined $$h{$i}) {
	push(@{$$h{$i}}, $elem);
    } else {
	$$h{$i} = [$elem];
    }

}

# print hash
sub showhash {
    my ($h) = @_;
    my ($key, $val);
    while (($key, $val) = each %{$h}) {	# changes order
	print STDERR "$key: $val\n";
    }
}
sub showhasharr {
    my ($h) = @_;
    my ($key, $val);
    while (($key, $val) = each %{$h}) {	# changes order
	print STDERR "$key: @$val\n";
    }
}

# append suffix
sub sufcat {
    my ($a, $s) = @_;
    my ($aclass, $sclass);

    return $a if ($s eq "");

    $aclass = $a =~ /\d$/;			# ends with a digit
    $sclass = $s =~ /^\d/;			# begins with a digit

    if ($aclass == $sclass) {
	return $a . "." . $s;
    } else {
	return $a . $s;
    }
}

# get a line, combining continuation lines
#  that start with whitespace

sub get_line {
    return "" unless $lookahead;		# EOF in previous call
    my $thisline = $lookahead;
  LINE:
    while ($lookahead = <>) {
	if ($lookahead =~ /^\+(.*)/) {
	    $thisline .= " $1";
	}
	else {
	    last LINE;
	}
    }
    $thisline =~ s/$whitespace+$//g;		# remove trailing whitespace
    $thisline;
}