#!/usr/bin/perl
# -*- perl -*-
# Copyright 2002 DJ Delorie <dj@delorie.com>
# Distributed under the terms of the GNU General Public License

$design = shift;
if ($ARGV[0]) {
    $trackfile = $design;
    $psfile = shift;
} else {
    $trackfile = "$design.ndir/trackeript";
    $psfile = "$design.ddir/all.ps";
}

if ( ! -f $trackfile ) {
    print STDERR "$trackfile not found\n";
    exit 1;
}

mkdir("$design.ddir", 0777) unless -d "$design.ddir";

open(T, "$trackfile");
open(PS, ">$psfile");

&init_ps();

while (<T>) {
    s/[\r\n]+$//;
    ($type, @rest) = split(' ');
    &job_header(@rest) if $type eq "j";
    &route_record(@rest) if $type eq "r";
    &pin_record(@rest) if $type =~ /[puv]/;
    &pinsize_record(@rest) if $type eq "q";
    &track_record(@rest) if $type eq "t";
    &nogo_record(@rest) if $type eq "n";

    &oroute_record(@rest) if $type eq "R";
    &opin_record(@rest) if $type eq "P";
    &otrack_record(@rest) if $type eq "T";
    &ocorner_record(@rest) if $type eq "C";
    &ovia_record(@rest) if $type eq "V";
}

close(T);
close(PS);

exit 0;

sub init_ps() {
    print PS "%!PS-Adobe\n";
    print PS "0 11 72 mul translate 1 -1 scale\n";
    print PS "0.072 0.072 scale 500 500 translate\n";
    print PS "/l0 { 0 0 0 setrgbcolor } bind def\n";
    print PS "/l1 { 1 0 0 setrgbcolor } bind def\n";
    print PS "/l2 { 0 1 0 setrgbcolor } bind def\n";
    print PS "/l3 { 0 0 1 setrgbcolor } bind def\n";
    print PS "/l4 { 0 0.5 0.5 setrgbcolor } bind def\n";
    print PS "/l5 { 1 0 1 setrgbcolor } bind def\n";
    print PS "/l6 { 1 1 0 setrgbcolor } bind def\n";
    print PS "/l7 { 0.5 0.5 0.5 setrgbcolor } bind def\n";
    print PS "/l8 { 1 0.5 0 setrgbcolor } bind def\n";
    print PS "/t { setlinewidth moveto lineto stroke } bind def\n";
    print PS "/p { 0 360 arc fill } bind def\n";
    print PS "1 setlinecap 1 setlinejoin\n";
    print PS "/pr { /b exch def /w exch def moveto b -2 div w -2 div rmoveto\n";
    print PS "      b 0 rlineto 0 w rlineto b -1 mul 0 rlineto fill } bind def\n";
}

sub job_header {
    my ($minx, $miny, $maxx, $maxy, $minl, $maxl, $nroutes, $grid, $padcl, $trackcl,
	$viacl, $viasym, $viasize, $buried, $deftrack, $deftrackwidth,
	$betwix, $nsels, $stop, $router) = @_;

    printf PS "%d %d translate\n", -$minx, $miny;
    $xscale = 7500/($maxx-$minx);
    $yscale = 10000/($maxy-$miny);
    $xscale = $yscale if $xscale > $yscale;
    print PS "$xscale $xscale scale\n";
    print PS "2 setlinewidth 0 setgray\n";
    printf PS ("%d %d moveto %d %d lineto %d %d lineto %d %d lineto closepath stroke\n",
	       $minx-1, $miny-1, $minx-1, $maxy+1,
	       $maxx+1, $maxy+1, $maxx+1, $miny-1);
}

sub route_record {
}

sub pin_record {
    my ($route, $x, $y, $l1, $l2, $link, $type, $pinno, $nsize) = @_;
    $padx = $x;
    $pady = $y;
}

sub pinsize_record {
    my ($type, $angle, $diameter, $breadth, $l1, $l2) = @_;
    for ($l=$l1; $l<=$l2; $l++) {
	if ($type eq 'c') {
	    print PS "l$l $padx $pady $diameter 2 div p\n";
	} elsif ($type eq 'r') {
	    if ($angle != 90) {
		$t = $diameter;
		$diameter = $breadth;
		$breadth = $t;
	    }
	    print PS "l$l $padx $pady $diameter $breadth pr\n";
	}
	return if $l eq 0;
    }
}

sub track_record {
    my ($img, $width, $x1, $y1, $x2, $y2, $layer, $nc) = @_;
    print PS "$width setlinewidth l$layer $x1 $y1 moveto\n";

    for ($c=0; $c<$nc; $c++) {
	($t, $x, $y) = split(' ', <T>);
	print PS "$x $y lineto\n";
    }
    print PS "$x2 $y2 lineto stroke\n";
}

sub nogo_record {
    my ($layer, $type, $x, $y, $nc) = @_;
    print PS "0.5 setgray $x $y moveto\n";

    for ($c=0; $c<$nc-1; $c++) {
	($t, $x, $y) = split(' ', <T>);
	print PS "$x $y lineto\n";
    }
    print PS "closepath fill\n";
}

#-----------------------------------------------------------------------------

sub oroute_record {
    my($num) = @_;
    print PS "1 setlinewidth\n";
}

sub opin_record {
    my($x,$y) = @_;
    print PS "l0 $x $y 20 0 360 arc stroke\n";
}

sub otrack_record {
    my($num,$lay, $nc) = @_;
    print PS "l$lay\n";
    ($t, $x, $y) = split(' ', <T>);
	$x += $lay;
	$y += $lay;
    print PS "$x $y moveto\n";
    for ($i=1; $i<$nc; $i++) {
	($t, $x, $y) = split(' ', <T>);
	$x += $lay;
	$y += $lay;
	print PS "$x $y lineto\n";
    }
    print PS "stroke\n";
}

sub ovia_record {
    my($sym, $x, $y, $sl, $el, $ontrack) = @_;
    print PS "l0 $x $y 10 0 360 arc stroke\n";
}