#!/usr/bin/perl -w

=head1 NAME

tg2pic - translate simple task graph language into .pic output for LaTeX

=head1 EXAMPLES

Given a file in.tg containing:
    task 0 0 a 1
    task 0 1 b 2
    task 1 0 c 2
    task 1 1 d 1
    join 0 0 1 0
    join 0 0 1 1
    join 0 1 1 1

run
    tg2pic in.tg > out.pic

to generate an output file containing a picture, ready to be included as
a figure in a LaTeX document.

=head1 DESCRIPTION

This script translates a graph described using a simple language
into native LaTeX picture environment commands.  The input graph can
be directed or undirected, and vertices can be labelled.  For task
graphs, additional methods of representation are provided.

Pictures are drawn on a grid with non-negative coordinates.  Tasks are
represented by circles, possibly containing a task label.  Precedence
constraints are represented by lines between the circles.

In the input, blank lines (lines containing only whitespace) are ignored.
The picture language has the following commands:

=over 4

=item C<newpic>

Denotes the start of a new picture.  It may be omitted for the first
picture in the input.

=item C<nocircles>

Omits task circles; effective until next picture.

=item C<circlesize> B<n>

Sets $circle_diam to n units (default 10).
The last circlesize directive in a file affects the whole file.

=item C<scale> B<n>

Reduces all dimensions by factor n.  This starts at 1, no reduction.
Only a single scaling factor is applied globally, to all pictures.
This is obtained by multiplying all scale factors in the file together.

=item C<task> B<y> B<x> B<text>

Places a circle containing text at grid location (x,y).
If no text argument is supplied, places an empty circle.

=item C<box> B<y> B<x> B<text>

Places a square box containing text at grid location (x,y).
If no text argument is supplied, places an empty box.

=item C<notask> B<y> B<x> B<text>

Places text at (x,y); useful for graph labels.
Where a text argument is supplied, it is typeset in math mode.
If no text argument is supplied, places nothing at (x,y); this is useful
for lining up graphs.

=item C<join> B<y1> B<x1> B<y2> B<x2>

Joins circles at locations (x1,y1) and (x2,y2).

=item C<dashjoin> B<y1> B<x1> B<y2> B<x2>

Joins circles at locations (x1,y1) and (x2,y2) using dashed line.

=item C<arrow> B<y1> B<x1> B<y2> B<x2>

Joins circles at locations (x1,y1) and (x2,y2) with an arrow.

=item C<looparrow> B<y> B<x> B<loc>

Draws a selfloop with an arrow, at location (x,y), at position
specified by loc: l for left, r for right, t for top, b for bottom.

=item C<bar> B<y> B<x> B<dl> B<dr> B<j>

Draws bar above (x,y) with left and right end curves.
Curves up if dl/dr is +, down (-), same (.), none (0).
Bar is raised if j is +, lowered (-), same (.).

=back

=head1 AUTHOR

Andras Salamon <andras@dns.net>

=cut

# $DEBUG = 1;

# constant definitions
$x_pix = 24;				# x-units between grid elements
$y_pix = 32;				# y-units between grid elements
$x_loffset = 12;			# left margin
$y_boffset = 18;			# bottom margin
$x_offsets = $x_loffset + 12;		# x margins
$y_offsets = $y_boffset + 18;		# y margins
$circle_diam = 10;			# size of task circle
$circle_radius = 0.5*$circle_diam;
$unitlength = 2.4;			# in points, default is 1
$x_barround = 0.25*$x_pix;
$barlen = 0.5*$x_pix;
$barraise = 2;
$nd = 4.0;				# dashes per dashed segment
$dd = 0.7;				# dash density: ratio of dash to space
$ldhd = 0.8*$circle_diam;		# size of l/r selfloop
$ldvd = 0.75*$ldhd;			# size of t/b selfloop
$llhd = 0.2*$circle_diam;		# size of line in l/r selfloop
$llvd = 0.1*$circle_diam;		# size of line in t/b selfloop

sub notenough {
    my $arg = shift;
    die( 'Not enough arguments for ' . $arg . ', quitting' );
}

sub toomany {
    my $arg = shift;
    warn( 'Too many arguments for ' . $arg . ', ignoring surplus' );
}

sub scale_x {
    my $arg = shift;
    return( $arg * $x_pix + $x_loffset );
}

# note inverted y-scale: given top-to-bottom, printed bottom-to-top
sub scale_y {
    my $arg = shift;
    return( ($max_y - $arg) * $y_pix + $y_boffset );
}

sub scale_x1 {
    my ($x1, $y1, $x2, $y2) = @_;
    $y1 = $max_y - $y1;
    $y2 = $max_y - $y2;
    $dx = ($x2 - $x1) * $x_pix;
    $dy = ($y2 - $y1) * $y_pix;
    $hyp = sqrt( $dx*$dx + $dy*$dy );
    return( $x1 * $x_pix + $x_loffset + $dx * $circle_radius / $hyp );
}

sub scale_y1 {
    my ($x1, $y1, $x2, $y2) = @_;
    $y1 = $max_y - $y1;
    $y2 = $max_y - $y2;
    $dx = ($x2 - $x1) * $x_pix;
    $dy = ($y2 - $y1) * $y_pix;
    $hyp = sqrt( $dx*$dx + $dy*$dy );
    print '% y1 y2 dy = ' . "$y1 $y2 $dy\n" if $DEBUG;
    return( $y1 * $y_pix + $y_boffset + $dy * $circle_radius / $hyp );
}

# assume here that $u = abs( $u ); $v = abs( $v );
sub gcd {
    my ($u, $v) = @_;
    my $r;
    while ($v) {
	$r = $u % $v;
	$u = $v;
	$v = $r;
    }
    return( $u );
}

sub xy_x {
    my ($x1, $y1, $x2, $y2) = @_;
    $y1 = $max_y - $y1;
    $y2 = $max_y - $y2;
    $dx = ($x2 - $x1) * $x_pix;
    $dy = ($y2 - $y1) * $y_pix;
    $g = gcd( abs( $dy ), abs( $dx ) );
    return( $dx / $g );
}

sub xy_y {
    my ($x1, $y1, $x2, $y2) = @_;
    $y1 = $max_y - $y1;
    $y2 = $max_y - $y2;
    $dx = ($x2 - $x1) * $x_pix;
    $dy = ($y2 - $y1) * $y_pix;
    $g = gcd( abs( $dy ), abs( $dx ) );
    return( $dy / $g );
}

sub xlength {
    my ($x1, $y1, $x2, $y2) = @_;
    $y1 = $max_y - $y1;
    $y2 = $max_y - $y2;
    $dx = ($x2 - $x1) * $x_pix;
    $dy = ($y2 - $y1) * $y_pix;
    return ( abs( $dy ) - $circle_diam ) if (! $dx );
    return( abs( $dx - $dx * $circle_diam / $hyp ) );
}

# keep track of whether a newpic command is needed
# the first one can be left out
$newpic = 0;
push( @do, 'newpic' );

$max_x = 0;
$max_y = 0;

while (<>) {
#     tr/A-Z/a-z/;
    @toks = split;
    # skip blank lines
    next if ( @toks == 0 );
    ($h = shift( @toks )) =~ tr/A-Z/a-z/;
    if ( $h eq 'task' or $h eq 'box' ) {
	notenough( $h ) if @toks < 2;
	$label = '';
	$y = shift( @toks );
	$x = shift( @toks );
	$max_x = $x if $x > $max_x;
	$max_y = $y if $y > $max_y;
	$label = shift( @toks ) if @toks;
	toomany( $h ) if @toks;
	push( @do, $h, $y, $x, $label );
    } elsif ( $h eq 'notask' ) {
	notenough( $h ) if @toks < 2;
	$label = '';
	$y = shift( @toks );
	$x = shift( @toks );
	$max_x = $x if $x > $max_x;
	$max_y = $y if $y > $max_y;
	$label = shift( @toks ) if @toks;
	toomany( $h ) if @toks;
	# don't actually draw anything if there is a notask with no label
	# this can be useful to increase the size of the diagram
	push( @do, $h, $y, $x, $label ) if $label ne '';
    } elsif ( $h eq 'join' or $h eq 'dashjoin' or $h eq 'arrow' ) {
	notenough( $h ) if @toks < 4;
	$y1 = shift( @toks );
	$x1 = shift( @toks );
	$y2 = shift( @toks );
	$x2 = shift( @toks );
	toomany( $h ) if @toks;
	push( @do, $h, $y1, $x1, $y2, $x2 );
    } elsif ( $h eq 'looparrow' ) {
	notenough( $h ) if @toks < 3;
	$y = shift( @toks );
	$x = shift( @toks );
	$loc = shift( @toks );
	toomany( $h ) if @toks;
	$loc = 't' unless ( $loc eq 'l' or $loc eq 'r' or $loc eq 'b' );
	push( @do, $h, $y, $x, $loc );
    } elsif ( $h eq 'bar' ) {
	notenough( $h ) if @toks < 5;
	$y = shift( @toks );
	$x = shift( @toks );
	$dl = shift( @toks );
	$dl = '.' unless ( $dl eq '+' || $dl eq '-' || $dl eq '0' );
	$dr = shift( @toks );
	$dr = '.' unless ( $dr eq '+' || $dr eq '-' || $dr eq '0' );
	$j = shift( @toks );
	$j = '.' unless ( $j eq '+' || $j eq '-' );
	toomany( $h ) if @toks;
	push( @do, $h, $y, $x, $dl, $dr, $j );
    } elsif ( $h eq 'newpic' ) {
	push( @do, $h ) if ( $newpic );
	push( @max, $max_x, $max_y ) if ( $newpic );
	$max_x = 0;
	$max_y = 0;
    } elsif ( $h eq 'nocircles' ) {
	push ( @do, $h );
    } elsif ( $h eq 'scale' ) {
	notenough( $h ) if @toks < 1;
	$scale = shift( @toks );
	$scale = 1 if ( 0 == $scale );
	$unitlength /= $scale;
	toomany( $h ) if @toks;
    } elsif ( $h eq 'circlesize' ) {
	notenough( $h ) if @toks < 1;
	$circle_diam = shift( @toks );
	$circle_radius = $circle_diam / 2;
	toomany( $h ) if @toks;
    } else {
	die( 'Unrecognized command ' . $h . ', quitting' );
    }
    $newpic = 1;
}
push( @max, $max_x, $max_y );

# now print contents of @do

print '\setlength{\unitlength}{' . $unitlength . "pt}\n";
print '\thinlines' . "\n";

# keep track if we have seen a newpic command before
$newpic = 0;
$drawcircles = 1;

while (@do) {
    $h = shift( @do );
    if ( $h eq 'task' or $h eq 'notask' or $h eq 'box' ) {
	$y = shift( @do );
	$x = shift( @do );
	$label = shift( @do );
	if ( $drawcircles and ($h eq 'task') ) {
	    print '\put(' . scale_x( $x ) . ','
		. scale_y( $y ) .  '){\circle{' . $circle_diam . '}}' . "\n";
	}
	if ( $h eq 'box' ) {
	    print '\put(' . (scale_x( $x ) - $circle_radius) . ','
	    . (scale_y( $y ) - $circle_radius) . '){\framebox('
	    . $circle_diam . ',' . $circle_diam . ')[cc]{$' . $label
	    . '$}}' . "\n";
	} elsif ( $label ne '' ) {
	    print '\put(' . scale_x( $x ) . ','
	    . scale_y( $y ) . '){\makebox(0,0)[cc]{$' . $label . '$}}' . "\n";
	}
    } elsif ( $h eq 'join' or $h eq 'dashjoin' or $h eq 'arrow' ) {
	my $cmd = ($h eq 'arrow') ? 'vector' : 'line';
	$y1 = shift( @do );
	$x1 = shift( @do );
	$y2 = shift( @do );
	$x2 = shift( @do );
	my $s = scale_x1( $x1, $y1, $x2, $y2 );
	my $t = scale_y1( $x1, $y1, $x2, $y2 );
	my $u = (scale_x1( $x2, $y2, $x1, $y1 ) - $s)/$nd;
	my $v = (scale_y1( $x2, $y2, $x1, $y1 ) - $t)/$nd;
	print '% join ' . "$y1 $x1 $y2 $x2\n" if $DEBUG;
	if ($h eq 'dashjoin') {
	    print "\\multiput($s,$t)($u,$v){$nd}{\\"
	    . $cmd . '('
	    . xy_x( $x1, $y1, $x2, $y2 ) . ','
	    . xy_y( $x1, $y1, $x2, $y2 ) . '){'
	    . $dd * xlength( $x1, $y1, $x2, $y2 )/$nd . '}}' . "\n";
	} else {
	    print '\put('
	    . scale_x1( $x1, $y1, $x2, $y2 ) . ','
	    . scale_y1( $x1, $y1, $x2, $y2 ) . '){\\' . $cmd . '('
	    . xy_x( $x1, $y1, $x2, $y2 ) . ','
	    . xy_y( $x1, $y1, $x2, $y2 ) . '){'
	    . xlength( $x1, $y1, $x2, $y2 ) . '}}' . "\n";
	}
    } elsif ( $h eq 'looparrow' ) {
	$y = shift( @do );
	$x = shift( @do );
	$loc = shift( @do );
	if ( $loc eq 'l' ) {
	    $xx1 = $x-1; $yy1 = $y; $xd = -1; $yd = 0;
	    $xx2 = $x-1; $yy2 = $y-1;
	    $xx3 = $x-1; $yy3 = $y+1;
	    $ld = $ldhd;
	    $ll = $llhd;
	} elsif ( $loc eq 'r' ) {
	    $xx1 = $x+1; $yy1 = $y; $xd = 1; $yd = 0;
	    $xx2 = $x+1; $yy2 = $y+1;
	    $xx3 = $x+1; $yy3 = $y-1;
	    $ld = $ldhd;
	    $ll = $llhd;
	} elsif ( $loc eq 't' ) {
	    $xx1 = $x; $yy1 = $y-1; $xd = 0; $yd = 1;
	    $xx2 = $x+1; $yy2 = $y-1;
	    $xx3 = $x-1; $yy3 = $y-1;
	    $ld = $ldvd;
	    $ll = $llvd;
	} elsif ( $loc eq 'b' ) {
	    $xx1 = $x; $yy1 = $y+1; $xd = 0; $yd = -1;
	    $xx2 = $x-1; $yy2 = $y+1;
	    $xx3 = $x+1; $yy3 = $y+1;
	    $ld = $ldvd;
	    $ll = $llvd;
	} else {
	    die 'Unexpected looparrow position ' . $loc . ', quitting';
	}
	$x1 = scale_x1( $x, $y, $xx1, $yy1 );
	$y1 = scale_y1( $x, $y, $xx1, $yy1 );
	$x2 = scale_x1( $x, $y, $xx2, $yy2 );
	$y2 = scale_y1( $x, $y, $xx2, $yy2 );
	$x3 = scale_x1( $x, $y, $xx3, $yy3 );
	$y3 = scale_y1( $x, $y, $xx3, $yy3 );
	# notice slight epsilon fiddling
	print '\put(' . $x1 . ',' . ($xd ? $y1-0.01*$xd : $y1) . '){\oval('
	    . $ld .  ',' . $ld . ')[' . $loc . ']}' . "\n";
	# notice slight epsilon fiddling
	print '\put(' . $x2 . ','
	    . (($xd ? $y2-0.015*$xd : $y2) - ($xd>0 ? 0.01 : 0)) . '){\line('
	    . xy_x( $x, $y, $xx1, $yy1 ) . ','
	    . xy_y( $x, $y, $xx1, $yy1 ) . '){'
	    . $ll . '}}' . "\n";
	print '\put(' . ($x3 + $llhd*$xd)
	    . ',' . ($y3 + $llvd*$yd) . '){\vector('
	    . xy_x( $xx1, $yy1, $x, $y ) . ','
	    . xy_y( $xx1, $yy1, $x, $y ) . '){'
	    . $ll . '}}' . "\n";
    } elsif ( $h eq 'newpic' ) {
	if ( $newpic ) {
	    print '\end{picture}' . "\n";
	}
	$max_x = shift( @max );
	$max_y = shift( @max );
	print '\begin{picture}('
	    . ($max_x*$x_pix + $x_offsets) . ','
	    . ($max_y*$y_pix + $y_offsets) . ")\n";
	$newpic = 1;
	$drawcircles = 1;
    } elsif ( $h eq 'nocircles' ) {
	$drawcircles = 0;
    } elsif ( $h eq 'bar' ) {
	$y = shift( @do );
	$x = shift( @do );
	$dl = shift( @do );
	if ( $dl eq '+' ) {
	    $dl = 1;
	} elsif ( $dl eq '-' ) {
	    $dl = -1;
	} elsif ( $dl eq '.' ) {
	    $dl = 0;
	} else {
	    undef( $dl );
	}
	$dr = shift( @do );
	if ( $dr eq '+' ) {
	    $dr = 1;
	} elsif ( $dr eq '-' ) {
	    $dr = -1;
	} elsif ( $dr eq '.' ) {
	    $dr = 0;
	} else {
	    undef( $dr );
	}
	$j = shift( @do );
	if ( $j eq '+' ) {
	    $j = 1;
	} elsif ( $j eq '-' ) {
	    $j = -1;
	} else {
	    $j = 0;
	}
	print '{\thicklines'. "\n";
	$x1 = scale_x( $x - 0.5 );
	$x2 = scale_x( $x + 0.5 );
	$y1 = scale_y( $y - 0.5 );
	$y2 = scale_y( $y - 0.5 ) + $j * $barraise;
	if ( defined( $dl ) ) {
	    if ( $dl != 0 ) {
		print '\qbezier('.
		    $x1 .','. scale_y( $y - 0.5*(1 + $dl) ) .')('.
		    $x1 .','. $y2 .')('.
		    ($x1 + $x_barround) .','. $y2 .')'. "\n";
	    } else {
		print '\put('. $x1 .','. $y2
		    .'){\line(1,0){'. $x_barround .'}}'. "\n";
	    }
	}
	print '\put('. ($x1 + $x_barround) .','.  $y2
	    .'){\line(1,0){'. $barlen .'}}'. "\n";
	if ( defined( $dr ) ) {
	    if ( $dr != 0 ) {
		print '\qbezier('.
		    $x2 .','. scale_y( $y - 0.5*(1 + $dr) ) .')('.
		    $x2 .','. $y2 .')('.
		    ($x2 - $x_barround) .','. $y2 .')'. "\n";
	    } else {
		print '\put('. $x2 .','. $y2
		    .'){\line(-1,0){'. $x_barround .'}}'. "\n";
	    }
	}
	print '}'. "\n";
    } else {
	die( 'Unknown token ' . $h . ' in array, quitting' );
    }
}

print '\end{picture}' . "\n";

exit( 0 );