#!/usr/bin/perl -w

#
# Convert an outputed neato file into a png image
# (does intelligent mashing/expanding)
#
# takes neato output file on stdin, spits png image out on stdout.
#

use GD;
use Getopt::Std;
#
# Configure variables
#
my $TB		= "@prefix@";
my $ICONDIR     = "$TB/www";

my  $optlist = "z:";
if (! getopts($optlist, \%options)) {
    die("Usage:\nrender [-z zoomfactor]\n");
    
}

# if $embiggen == 1, node fonts will be rendered bigger.
# if $embiggen == 2, node and link fonts will be rendered bigger.

my $embiggen = 0; 

my $zoom = 1;
if ( defined($options{"z"} ) ) {
    my $zf = $options{"z"};
    if ($zf =~ /^([\.0-9]+)/) {
	$zoom = $1;
    } else {
	die("Bad argument to -z.. must be float.");
    }
}

if ($zoom >= 1.5) { $embiggen = 1; }
if ($zoom >= 1.75) { $embiggen = 2; }

%props = ();
%nodes = ();
%linklabels = ();
@links = ();

#parse input file

while (<>) {
  if (/^\s*(\w+)\s\[([^\]]*)\]/) {
    # this line is a property set
    ($cmd, $props) = ($1, $2);
    $props =~ s/[\=\,]/ /g;

    while (($props =~ s/^\s*(\w+)\s+((\"[^\"]*\")|(\w+))\s*//)) {
	# add each property to %props
        ($k, $v) = ($1, $2);
	$v =~ s/\"//g;
	$props{$k} = $v;
#	print "property $k gets value $v\n";
    } 

    if ($cmd =~ /^node$/) {
#	print "node property $props\n";
    } elsif ($cmd =~ /^graph$/) {
#	print "graph thingee (ignored)\n";
    } else {
	# there is a name here, not "node" or "graph"
        # so it terminates the node.. store props away.
	$nodes{$cmd} = {%props}; 
	%props = ();
    }
  } elsif (/^\s*(\w+)\s\-\-\s(\w+)\s/) {
    # a link.
    ($a, $b) = ($1, $2);
    push( @links, $a . " " . $b );
    if (/label\s*\=\s*\"([^\"]*)\"/) {
	$linklabels{ "$a $b" } = $1;
    } elsif (/label\s*\=\s*(\w+)/) {
	$linklabels{ "$a $b" } = $1;
    }
  }
}


%nodepos = ();

($fontw, $fonth) = (gdSmallFont->width, gdSmallFont->height);

# load position hash for nodes

foreach $i (keys %nodes) {
    if (exists $nodes{$i}{"pos"}) {
	$s = $nodes{$i}{"pos"};
	$s =~ /^\s*(\d+)\s+(\d+)/;    
	$nodepos{ $i } = [$1, $2]; 	
    }
}

# "ideal" width and height

$idealw = 500;
$idealh = 500;


$maxX = 1000;
$minX = 0;
$maxY = 1000;
$minY = 0;

$xSquishable = 1;
$ySquishable = 1;

# while we are above the ideal width or height,
# and there exist empty rows or columns,
# take out rows or columns of whitespace.

while ((($maxX - $minX) > $idealw && $xSquishable) || 
       (($maxY - $minY) > $idealh && $ySquishable)) {

    if ($maxX - $minX > $idealw) {   
	$totalsub = 0;
	$lastvert = 0;
	foreach $j (sort {$nodepos{ $a }[0] <=> $nodepos{ $b }[0]} keys %nodepos) 
	{
	    $vert = $nodepos{ $j }[0];
	    if ($vert - $lastvert > 36) {
#		$totalsub += ($vert - $lastvert - 36);
		$totalsub += 1;
#		warn " now eating $totalsub vert\n";
	    }
	    $nodepos{ $j }[0] -= $totalsub;
	    $lastvert = $vert;
	}
    
	if ($totalsub > 0) { $xSquishable = 1; } else { $xSquishable = 0; }
    }

    if ($maxY - $minY > $idealh) {
	$totalsub = 0;
	$lastvert = 0;
	foreach $j (sort {$nodepos{ $a }[1] <=> $nodepos{ $b }[1]} keys %nodepos) 
	{
	    $vert = $nodepos{ $j }[1];
	    if ($vert - $lastvert > 36) {
#		$totalsub += ($vert - $lastvert - 36);
		$totalsub += 1;
#		warn "now eating $totalsub horiz\n";
	    }
	    $nodepos{ $j }[1] -= $totalsub;
	    $lastvert = $vert;
	}
	
	if ($totalsub > 0) { $ySquishable = 1; } else { $ySquishable = 0; }
    }

    $maxX = 0;
    $maxY = 0;
    $minX = 1000000;
    $minY = 1000000;
    
    # get min and max X and Y
    foreach $i (keys %nodepos) {
	($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);
	$halflabel = ((length( $i ) - 0.5) * $fontw) / 2;
	if ($x + $halflabel > $maxX) { $maxX = $x + $halflabel; }
	if ($y + $fonth> $maxY) { $maxY = $y + $fonth; }
	if ($x - $halflabel < $minX) { $minX = $x - $halflabel; }
	if ($y < $minY) { $minY = $y; }
    }     
}

$xbig = $maxX - $minX;
$ybig = $maxY - $minY;

$xscale = 1.0;
$yscale = 1.0;


# recompute new ideal.. minimum size.
$nodecount = (keys %nodepos);
$idealarea = 4200 * $nodecount;
$idealw = sqrt( $idealarea );
if ($idealw > 500) { $idealw = 500; }
$idealh = $idealw;

# if it is too small, scale everything up so it takes the
# "ideal" amount of space

if ($xbig < $idealw) {
    $xscale = ($idealw / $xbig);
    $xbig = $idealw;
}

if ($ybig < $idealh) {
    $yscale = ($idealh / $ybig);
    $ybig = $idealh;
}

foreach $i (keys %nodepos) {
  ($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);
  $x -= $minX;
  $y -= $minY;

  $x *= $xscale;
  $y *= $yscale;

  $x += 20;
  $y += 20;
  $nodepos{ $i } = [$x,$y];	
}

# Uhh, Zoom Zip..
foreach $i (keys %nodepos) {
  ($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);
  $x *= $zoom;
  $y *= $zoom;
  $nodepos{ $i } = [$x,$y];	
}

# start constructing the image

$im = new GD::Image(($xbig + 60) * $zoom, ($ybig + 70) * $zoom);

$nodeicon = GD::Image->newFromPng("$ICONDIR/nodeicon.png") || warn "nodeicon.png not found";
$lanicon  = GD::Image->newFromPng("$ICONDIR/lanicon.png") || warn "lanicon.png not found";

%colors = ();

$colors{"black"} =  $im->colorAllocate(0,0,0);
$colors{"darkblue"} =  $im->colorAllocate(0,0,96);
$colors{"darkred"} =  $im->colorAllocate(128,0,0);
$colors{"red"} =  $im->colorAllocate(192,0,0);
$colors{"blue"} =  $im->colorAllocate(0,0,192);
$colors{"paleblue"} =  $im->colorAllocate(127,127,192);
$colors{"green"} =  $im->colorAllocate(0,96,0);
$colors{"orange"} =  $im->colorAllocate(255, 128, 0);
$colors{"white"} =  $im->colorAllocate(255,255,255);
$colors{"gray80"} = $im->colorAllocate(210,210,210);
$colors{"gray75"} = $im->colorAllocate(191,191,191);
$colors{"gray50"} = $im->colorAllocate(127,127,127);
$colors{"gray25"} = $im->colorAllocate(63,63,63);

# set clear background
$bgcolor = $im->colorAllocate(254, 254, 254);

$im->transparent($bgcolor);
#$im->interlaced('true');
$im->fill( 1, 1, $bgcolor );

#$im->rectangle( 0,0,99,99, $gray50 );

# render shadows

foreach $i (keys %nodes) {
  ($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);
  $im->filledRectangle( $x - 12, $y - 12, 
 	                $x + 20, $y + 20, $colors{"gray80"});
} 

# render links

foreach $i (@links) {
  ($a, $b) = ($i =~ /(\w+)\s(\w+)/);

  ($x1, $y1) = ($nodepos{ $a }[0], $nodepos{ $a }[1]);
  ($x2, $y2) = ($nodepos{ $b }[0], $nodepos{ $b }[1]);  

  if (exists $linklabels{ $i }) {
      my $foo   = $linklabels{ $i };
      my $red   = $colors{"red"};
      my $green = $colors{"green"};      
      my $blue  = $colors{"blue"};
      my $black = $colors{"black"};

      if ($foo =~ /^\!rs/) {
	  $im->setStyle($red); 
      } elsif ($foo =~ /^\!bs/) {
	  $im->setStyle($blue); 
      } elsif ($foo =~ /^\!ks/) {
	  $im->setStyle($black); 
      } elsif ($foo =~ /^\!ro/) {
	  $im->setStyle($red, gdTransparent);
      } elsif ($foo =~ /^\!bo/) {
	  $im->setStyle($blue, gdTransparent);
      } elsif ($foo =~ /^\!ko/) {
	  $im->setStyle($black, gdTransparent);
      } elsif ($foo =~ /^\!ra/) {
	  $im->setStyle($red, $red, gdTransparent);
      } elsif ($foo =~ /^\!ba/) {
	  $im->setStyle($blue, $blue, gdTransparent);
      } elsif ($foo =~ /^\!ka/) {
	  $im->setStyle($black, $black, gdTransparent);
      } else {
	  $im->setStyle($colors{"paleblue"}); 
      }
  } else {
      $im->setStyle($colors{"paleblue"}); 
  }
  
  #$im->line( $x1, $y1, $x2, $y2, $colors{"paleblue"} );
  
  $im->line( $x1, $y1, $x2, $y2, gdStyled );
}

# render nodes.
# if colors match certain colors, use icons instead
# (hack)

foreach $i (keys %nodes) {
  ($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);

  $cname = $nodes{$i}{"color"};
  $c = $colors{ $cname } || $colors{"blue"};

  if ($cname eq "red") {
      $im->rectangle( $x - 16, $y - 16, $x + 16, $y + 16, $colors{"darkred"} );
      $im->rectangle( $x - 15, $y - 15, $x + 15, $y + 15, $colors{"darkred"} );
  } else {
      $im->rectangle( $x - 16, $y - 16, $x + 16, $y + 16, $colors{"gray25"} );
      $im->rectangle( $x - 15, $y - 15, $x + 15, $y + 15, $colors{"gray25"} );
  }

  $im->filledRectangle( $x - 14, $y - 14, 
			$x + 14, $y + 14, $colors{"white"} );

  if ($nodeicon && ($cname eq "skyblue" || 
		    $cname eq "steelblue" ||
		    $cname eq "blue" ||
		    $cname eq "red")) {
    $im->copy($nodeicon, $x-16, $y-16, 0, 0, 32, 32);
  } elsif ($lanicon && $cname eq "green") {
    $im->copy($lanicon, $x-16, $y-16, 0, 0, 32, 32);
  } else {
  $im->filledRectangle( $x - 6, $y - 6, 
			$x + 6, $y + 6, $c );
  }
} 

# render text.
# this is done in a second pass so no text is obscured by
# boxes.

foreach $i (@links) {
    if (exists $linklabels{ $i }) {
	($a, $b) = ($i =~ /(\w+)\s(\w+)/);
	($x1, $y1) = ($nodepos{ $a }[0], $nodepos{ $a }[1]);
	($x2, $y2) = ($nodepos{ $b }[0], $nodepos{ $b }[1]);  
	($x, $y) = ( ($x1 + $x2) / 2, ($y1 + $y2) / 2 );

	$linklabels{ $i } =~ s/^\!..//;
	
	my @lines = split " ", $linklabels{ $i };

	$y -= (0.5 * (@lines * gdTinyFont->height)); 

	my $linenum = 0;
	foreach $j (@lines) {
	    $xpos = $x - ((length($j) - 0.5) * (($embiggen == 2) ? gdSmallFont->width : gdTinyFont->width) / 2); 
	    
	    $im->string(($embiggen == 2) ? gdSmallFont : gdTinyFont, $xpos + 1, $y, 
			$j, $bgcolor);
	    $im->string(($embiggen == 2) ? gdSmallFont : gdTinyFont, $xpos - 1, $y, 
			$j, $bgcolor);
	    $im->string(($embiggen == 2) ? gdSmallFont : gdTinyFont, $xpos, $y - 1, 
			$j, $bgcolor);
	    $im->string(($embiggen == 2) ? gdSmallFont : gdTinyFont, $xpos, $y + 1, 
			$j, $bgcolor);
	    $im->string(($embiggen == 2) ? gdSmallFont : gdTinyFont, $xpos, $y, 
			$j, $colors{"darkblue"}); 
	    $y += ($embiggen == 2) ? gdSmallFont->height : gdTinyFont->height; 
	}
    }
}
    
foreach $i (keys %nodes) {
  ($x, $y) = ($nodepos{ $i }[0], $nodepos{ $i }[1]);

# my $nm = $i;
  my $nm = $nodes{$i}{"label"};

  @lines = ();

  $nm .= " ";

  $nm =~ s/^(\S+)//;

  push @lines, $1;

  while ( $nm =~ s/^(.{1,12})\s// ) {
    push @lines, $1;
  }

  push @lines, $nm;

  # my @lines = split " ", $nm;

  my $linenum = 0;
  foreach $j (@lines) {
#     warn "$j $x $y!";
      if ($linenum++ == 0) {
	  $xpos = $x - ((length($j) - 0.5) * ($embiggen ? gdMediumBoldFont->width : gdSmallFont->width) / 2);

	  $im->string($embiggen ? gdMediumBoldFont : gdSmallFont, 
		      $xpos + 1, $y + 20, $j, $bgcolor);
	  $im->string($embiggen ? gdMediumBoldFont : gdSmallFont, 
		      $xpos - 1, $y + 20, $j, $bgcolor);
	  $im->string($embiggen ? gdMediumBoldFont : gdSmallFont, 
		      $xpos, $y + 19, 
		      $j, $bgcolor);
	  $im->string($embiggen ? gdMediumBoldFont : gdSmallFont, 
		      $xpos, $y + 21, 
		      $j, $bgcolor);
	  $im->string($embiggen ? gdMediumBoldFont : gdSmallFont, 
		      $xpos, $y + 20, 
		      $j, $colors{"black"}); 
	  $y += $embiggen ? gdMediumBoldFont->height : gdSmallFont->height; 
      } else {
	  $xpos = $x - ((length($j) - 0.5) * ($embiggen ? gdSmallFont->width : gdTinyFont->width) / 2); 

	  $im->string(($embiggen) ? gdSmallFont : gdTinyFont, 
		      $xpos + 1, $y + 20, 
		      $j, $bgcolor);
	  $im->string(($embiggen) ? gdSmallFont : gdTinyFont, 
		      $xpos - 1, $y + 20, 
		      $j, $bgcolor);
	  $im->string(($embiggen) ? gdSmallFont : gdTinyFont, 
		      $xpos, $y + 19, 
		      $j, $bgcolor);
	  $im->string(($embiggen) ? gdSmallFont : gdTinyFont, 
		      $xpos, $y + 21, 
		      $j, $bgcolor);
	  $im->string(($embiggen) ? gdSmallFont : gdTinyFont, 
		      $xpos, $y + 20, 
		      $j, $colors{"black"}); 
	  $y += ($embiggen) ? gdSmallFont->height : gdTinyFont->height; 
      }
  }
} 

#write it to stdout

binmode STDOUT;
print $im->png;