#!/usr/bin/perl -w

use strict;

#
# Some helpers to create gaf objects
#

package gaf;
use List::Util qw(max min);

sub version {
	print "v 20061020 1\n";
}

our $xoffset = 0;
our $yoffset = 0;
our $xsign = 1;
our $ysign = 1;
our $swapxy = 0;
our @stack;

sub moveto {
	($xoffset, $yoffset) = @_;
}

sub rmoveto {
	$xoffset += $_[0];
	$yoffset += $_[1];
}

sub gsave {
	push @stack, [$xoffset, $yoffset, $xsign, $ysign, $swapxy];
}

sub grestore {
	($xoffset, $yoffset, $xsign, $ysign, $swapxy) = @{pop @stack};
}

sub flipx { if ($swapxy) { $ysign = -$ysign } else { $xsign = -$xsign } }
sub flipy { if ($swapxy) { $xsign = -$xsign } else { $ysign = -$ysign } }
#sub swapxy { $swapxy = !$swapxy; ($xsign, $ysign) = ($ysign, $xsign) }
sub rot90 { $swapxy = !$swapxy; ($xsign, $ysign) = ($ysign, -$xsign) }

sub xy {
	my @xy = ($_[0] * $xsign, $_[1] * $ysign);
	@xy = reverse @xy if $swapxy;
	($xy[0] + $xoffset, $xy[1] + $yoffset)
}

sub xywh {
	my ($x,$y,$w,$h) = @_;
	# find other corner in absolute space
	my ($x2, $y2) = ($x + $w, $y + $h);
	# transform both corners
	($x, $y) = xy($x, $y);
	($x2, $y2) = xy($x2, $y2);
	# convert back to x/y/w/h format
	(min($x, $x2), min($y, $y2), abs($x - $x2), abs($y - $y2))
}

sub angle {
	($_[0] + ($swapxy ? 90 : 0)) % 360;
}

sub round {
	my $size = shift;

	$size = int(($size + 99) / 100) * 100;
}

sub line {
	my %v = (
		x1 => 0, y1 => 0, x2 => 0, y2 => 0,
		color => 3,
		width => 0,
		capstyle => 0,
		dashstyle => 0,
		dashlength => -1,
		dashspace => -1,
		@_
	);
	printf "L %d %d %d %d %d %d %d %d %d %d\n",
		xy($v{x1}, $v{y1}),
		xy($v{x2}, $v{y2}),
		$v{color}, $v{width},
		$v{capstyle}, $v{dashstyle},
		$v{dashlength}, $v{dashspace};
}

sub box {
	my %v = (
		x => 0, y => 0,
		color => 3,
		lwidth => 0,
		capstyle => 0,
		dashstyle => 0,
		dashlength => 0,
		dashspace => 0,
		filltype => 0,
		fillwidth => -1,
		angle1 => -1,
		pitch1 => -1,
		angle2 => -1,
		pitch2 => -1,
		@_
	);
	printf "B %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n",
		xywh($v{x}, $v{y},
		     $v{width}, $v{height}),
		$v{color}, $v{lwidth},
		$v{capstyle}, $v{dashstyle},
		$v{dashlength}, $v{dashspace},
		$v{filltype}, $v{fillwidth},
		$v{angle1}, $v{pitch1},
		$v{angle2}, $v{pitch2};
}


sub circle {
	my %v = (
		x => 0, y => 0,
		color => 3,
		width => 0,
		capstyle => 0,
		dashstyle => 0,
		dashlength => 0,
		dashspace => 0,
		filltype => 0,
		fillwidth => -1,
		angle1 => -1,
		pitch1 => -1,
		angle2 => -1,
		pitch2 => -1,
		@_
	);
	printf "V %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n",
		xy($v{x}, $v{y}),
		$v{radius},
		$v{color}, $v{width},
		$v{capstyle}, $v{dashstyle},
		$v{dashlength}, $v{dashspace},
		$v{filltype}, $v{fillwidth},
		$v{angle1}, $v{pitch1},
		$v{angle2}, $v{pitch2};
}


# 2 _____    5    _   8
#  |_   _|____  _| |_
# 1  | |/ _ \4\/ / __|7
#    | |  __/>  <| |_
# 0  |_|\___/3/\_\\__|6

sub text {
	my %v = (
		x => 0, y => 0,
		color => 9,
		size => 10,
		visibility => 1,
		show_name_value => 1,
		angle => 0,
		alignment => 0,
		@_
	);
	my @dummy = split('\n', $v{str});
	$v{num_lines} = scalar(@dummy);

	#$v{alignment} =~ y/012678/678012/ if $xsign < 0;
	#$v{alignment} =~ y/258036/036258/ if $ysign < 0;

	$v{alignment} =~ y/012678/678012/ if $xsign < 0;
	$v{alignment} =~ y/258036/036258/ if $ysign < 0;

	# wrong!
	#$v{alignment} =~ y/258147036/876543210/ if $swapxy;

	printf "T %d %d %d %d %d %d %d %d %d\n%s\n",
		xy($v{x}, $v{y}),
		$v{color}, $v{size},
		$v{visibility}, $v{show_name_value},
		angle($v{angle}), $v{alignment},
		$v{num_lines}, $v{str};
}

sub textwidth {
	my $s = shift;

	$s =~ s/.*?=//;
	my $narrow = ($s =~ y/I1i:;!.,\/][}{|//d);
	length($s) * 115 + $narrow * 50
}

sub hidden_attribute {
	my %v = (
		x => 0,
		y => 0,
		visibility => 0,
		show_name_value => 0,
		color => 5,
		@_
	);
	text(%v);
}

sub pin {
	my %v = (
		x1 => 0, y1 => 0, x2 => 0, y2 => 0,
		color => 1,
		pintype => 0,
		whichend => 1,
		@_
	);
	printf "P %d %d %d %d %d %d %d\n",
		xy($v{x1}, $v{y1}),
		xy($v{x2}, $v{y2}),
		$v{color}, $v{pintype},
		$v{whichend};
}

sub attributes {
	if (@_) {
		print "{\n";
		foreach my $a (@_) {
			text(size => 8, color => 5, %{$a});
		}
		print "}\n";
	}
}

#
# Every pin in this symbol is represented by an instance of Pin
#
package Pin;

our @realsides = ('top', 'right', 'bottom', 'left');
our @sides = (@realsides, 'labels', 'attr');

our %counts;
our $npins;

sub new {
	my $class = shift;
	my $s = shift;
	my $l = shift;

	no warnings "uninitialized";
	my $idx = $counts{$s}++;
	my $pinseq = ++$npins;

	bless { side => $s,
		label => $l,
		idx => $idx,
		bus => 0,	# default
		pinnumber => 0,	# default
		pinseq => $pinseq,
		style => 'pin',
		@_		# overrides defaults
	}, $class
}

sub print {
	my $self = shift;

	printf "%3d %s %d %d %s `%s'\n", $self->{pinnumber}, $self->{side}, $self->{idx}, $self->{bus}, $self->{style}, $self->{label};
}

sub width {
	my $self = shift;

	gaf::textwidth($self->{label});
}

sub label {
	my $self = shift;

	my $l = $self->{label};
	# keep "primary" pin designator by edge
	$l = join('/', reverse split('/', $l)) if $self->{side} =~ /right|top/;
	$l
}

#
# A collection of pins is inserted into a Layout.  Subclasses of Layout
# do the heavy lifting.
#
package Layout;

sub new {
	my $class = shift;
	my $pins = shift;

	bless { pins => $pins,
		@_		# overrides defaults
	}, $class
}

#
# Layout for one side of my layout style
#
package Layout::BjjSide;
use List::Util qw(max min);

sub new {
	my $class = shift;
	my $side = shift;
	my $pins = shift;

	bless { side => $side,
		pins => $pins,
		@_		# overrides defaults
	}, $class
}

sub busses {
	my $self = shift;

	my %seen = (0=>1);	# ignore bus 0
	grep {!$seen{$_}++} map { $_->{bus} } @{$self->{pins}};
}

sub nbus {
	my $self = shift;

	scalar (grep { $_->{bus} == 0 } @{$self->{pins}}) +
	scalar ($self->busses)
}

sub height {
	my $self = shift;

	return 0 unless $self->npins;
	my $nbus = $self->nbus;
	($self->npins - 1) * $Layout::Bjj::pinspacing +
	($nbus - 1) * $Layout::Bjj::pinspacing;
}

sub width {
	my $self = shift;

	max(0, map { $_->width } @{$self->{pins}})
}

sub npins {
	my $self = shift;

	scalar @{$self->{pins}}
}

sub init_y {
	my $self = shift;

	my $lastbus;
	my $y = 0;
	my $ps = $Layout::Bjj::pinspacing;

	foreach my $pin (@{$self->{pins}}) {
		$y += $ps if (defined $lastbus and $pin->{bus} != $lastbus);
		$lastbus = $pin->{bus} || -1;

		$pin->{y} = $y;
		$y += $ps;
	}
	$y -= $ps;
	# flip since gschem has math-like coords (not screen-like)
	foreach my $pin (@{$self->{pins}}) {
		$pin->{y} = $y - $pin->{y};
	}
}

sub render {
	my $self = shift;

	foreach my $pin (@{$self->{pins}}) {
		gaf::pin(y1 => $pin->{y}, y2 => $pin->{y}, x2 => 300);
		gaf::attributes(
			{ str => "pinlabel=" . $pin->label,
			  y => $pin->{y}, x => -50, alignment => 7 },
			{ str => "pinnumber=" . $pin->{pinnumber},
			  y => $pin->{y} + 25, x => 50,
			  alignment => $gaf::swapxy ? 2 : 0, size => 8 },
			{ str => "pinseq=" . $pin->{pinseq},
			  y => $pin->{y} + 25, x => 50,
			  alignment => $gaf::swapxy ? 2 : 0, size => 8,
			  visibility => 0 }
		);
	}
}

#
# Layout in my style by treating each side as a Layout::BjjSide
#
package Layout::Bjj;
use vars qw(@ISA);
@ISA = qw(Layout);
use List::Util qw(max min);

our $boxpadx = 0;
our $boxpady = 100;
our $gapx = 200;
our $gapy = 200;
our $pinspacing = 200;

sub new {
	my $class = shift;

	my $self = $class->SUPER::new(@_);
	my $pins = $self->{pins};
	my %sides;
	for my $side (@Pin::sides) {
		my @pinsside = grep { $_->{side} eq $side } @{$pins};
		$self->{$side} = Layout::BjjSide->new($side, \@pinsside);
	}
	$self
}

sub print {
	my $self = shift;

	foreach my $s (keys %{$self->{sides}}) {
		my $side = $self->{sides}->{$s};
		print $side->{side}, " has ", join(" ",$side->busses), "\n";
	}
}

sub layout {
	my $self = shift;

	# do initial distribution along sides
	map { $self->{$_}->init_y } @Pin::realsides;

	my $name_center = $self->{bottom}->npins > 0;
	$self->{name_center} = $name_center;

	my $width = max($self->{left}->width + $self->{right}->width +
			($name_center ? $self->{labels}->width : 0),
			$self->{top}->height, $self->{bottom}->height);
	$width += $gapx if ($self->{left}->npins and $self->{right}->npins);

	my $height = max($self->{top}->width + $self->{bottom}->width,
			$self->{left}->height, $self->{right}->height,
			($name_center ? $self->{labels}->height : 0));
	$height += $gapy if ($self->{top}->npins and $self->{bottom}->npins);

	$width = gaf::round($width) + $boxpadx * 2;
	$height = gaf::round($height) + $boxpady * 2;
	$self->{width} = $width;
	$self->{height} = $height;

	my $yoffset = $self->{labels}->height;
	$self->{yoffset} = $yoffset;
}

sub render {
	my $self = shift;

	gaf::gsave;

	# Move a bit to make room for lefthand pins and labels
	gaf::moveto(300, $self->{yoffset});
	gaf::box(width => $self->{width}, height => $self->{height});

	# Labels appear at the lower left of the part box if possible
	gaf::gsave;
	my $a;
	if ($self->{name_center}) {
		gaf::rmoveto($self->{width} / 2,
			     ($self->{height} + $self->{labels}->height) / 2);
		$a = 4;
	} else {
		gaf::rmoveto(0, -50);
		$a = 2;
	}
	foreach my $label (@{$self->{labels}->{pins}}) {
		gaf::text(str => $label->{label}, color => 5, alignment => $a);
		gaf::rmoveto(0, -$pinspacing);
	}
	gaf::grestore;

	# Attributes are hidden next to the labels (note that they
	# may extend into negative coords)
	gaf::gsave;
	gaf::rmoveto(-100, -50);
	foreach my $attr (@{$self->{attr}->{pins}}) {
		gaf::hidden_attribute(str => $attr->{label}, alignment => 8);
		gaf::rmoveto(0, -$pinspacing);
	}
	gaf::grestore;

	gaf::gsave;
	gaf::rmoveto($self->{width}, $boxpady + $pinspacing / 2);
	$self->{right}->render;
	gaf::grestore;

	gaf::gsave;
	gaf::rmoveto(0, $boxpady + $pinspacing / 2);
	gaf::flipx;
	$self->{left}->render;
	gaf::grestore;

	gaf::gsave;
	gaf::rmoveto($self->{width} - ($boxpadx + $pinspacing / 2), $self->{height});
	gaf::rot90;
	$self->{top}->render;
	gaf::grestore;

	gaf::gsave;
	gaf::rmoveto($self->{width} - ($boxpadx + $pinspacing / 2), 0);
	gaf::rot90;
	gaf::flipy;
	$self->{bottom}->render;
	gaf::grestore;

	gaf::grestore;
}

package ::main;

my $side = "none";
my $bus = 0;
my $nbus = 0;
my @pins;

#
# Parse input
#
while(<>)
{
	chomp;
	next if /^#/;

	if (/^\[(.*)\]/) {
		$side = $1;
		$bus = 0;
		next;
	}

	if (/^\.bus/) {
		$bus = ++$nbus;
		next;
	}

	if (/^$/) {
		$bus = 0;
		next;
	}

	my $s = $side;
	$s = "attr" if $side eq "labels" and s/^!\s+//;

	my $pin;

	if ($side eq "labels") {
		$pin = Pin->new($s, $_, style => $s);
	} else {
		die "missing pin number" unless s/(\d+)\s*//;
		my $n = $1;

		my $style = "";
		$style = $1 if s/^([!>])\s+//;

		$pin = Pin->new($s, $_, pinnumber => $n, bus => $bus);
		if ($style eq '!') {
			$pin->{style} = 'invert';
		} elsif ($style eq '>') {
			$pin->{style} = 'clock';
		}
	}

	push @pins, $pin;
}

#map { $_->print} @pins;

my $layout = Layout::Bjj->new(\@pins);
$layout->layout;
#$layout->print;

gaf::version;
$layout->render;