#!/usr/bin/perl -w

# springgraph v0.79, (c) 2002 Darxus@ChaosReigns.com, released under the GPL
# Download current version from:  http://www.chaosreigns.com/code/springgraph/
#
# This program attempts to render .dot files in a fashion similar to neato,
# which is part of graphviz:  http://www.research.att.com/sw/tools/graphviz/.
# I have never looked at any of the code in graphviz.
#
# Example usage:
#
# cat test.dot | ./springgraph.pl -s 3 > springgraph.png
#
# The "-s 3" specifies the scale, and is optional.  All of the node
# locations are multiplied by this.  Increase the scale to eliminate
# node overlaps.  Decrease the scale to make the graph smaller.
#
# Requirements:  GD.pm (http://www.perl.com/CPAN/authors/id/L/LD/LDS/)
# 
# Definition of the .dot files which springgraph renders
# can be found in the graphviz man pages.  A copy is here:
# http://www.unisa.edu.au/eie/csec/graphviz/dot.1.html.  Springgraph only
# supports the fillcolor and label node attributes, and can only handle
# two nodes per edge definition ("node1 -> node2", not "node1 -> node2
# -> node3").
# 
# Springgraph fully supports the .dot files generated by sig2dot
# (http://www.chaosreigns.com/code/sig2dot), which generates .dot files
# from GPG/PGP signature relationships.
# 
# Thanks to the following for help with the math for the arrowheads:
# Mike Joseph <mj@doze.net>
# Walt Mankowski <waltman@pobox.com>
# Jeff Weisberg <jaw+plug@tcp4me.com>
#
# Yes, the placement of the freaking arrowheads was by far the hardest
# part of writing this program.
#
# Thanks to Hartmut Palm for cylinder translation/rotation code in
# VRML.pm:  http://dc.gfz-potsdam.de/~palm/vrmlperl/

# v0.26 May 06 16:12:30 2002 
# v0.27 May 06 18:15:38 2002 cleanup
# v0.44 May 06 23:56:45 2002 
# v0.56 May 07 05:10:02 2002
# v0.60 May 07 23:27:29 2002 arrow heads !! (not filled in due to segfault)
# v0.61 May 07          2002 handle absence of beginning double-quote in fillcolor attribute
# v0.62 May 08 19:44:04 2002 use getopts to get scale argument
# v0.63 May 08 21:29:48 2002 made fillcolor optional again
# v0.64 May 08 22:28:40 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/ER.dot.txt
#                            and http://www.research.att.com/sw/tools/graphviz/examples/undirected/process.dot.txt
#                            (added support for undirected graphs ("--" links)
# v0.65 May 08 22:44:00 2002 render http://www.research.att.com/sw/tools/graphviz/examples/directed/fsm.dot.txt
#                            (do not attempt to draw a line from a node to itself and cause a devision by zero)
# v0.67 May 09 05:53:16 2002 support multiple nodes on one link line, adjusted detection of completion
#                            render http://www.research.att.com/sw/tools/graphviz/examples/directed/unix.dot.txt
#                            (support node names containing spaces)
# v0.68 May 09 17:29:06 2002 cleaned up link line processing a bit (removed extraneous define checks)
# v0.69 May 09 18:23:19 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/inet.dot.txt
#                            (support {} lists in link (edge) lines)
# v0.70 May 10 00:39:20 2002 Strip double-quotes that were getting missed to support sig2dot v0.27.
# v0.71 May 11 20:06:17 2002 don't draw twice, added some 3D math (but not output yet)
# v0.72 May 11 21:31:20 2002 3D output !!! (via -p flag)
# v0.73 May 11 22:34:23 2002 added labels to 3D output
# v0.74 May 12 02:07:29 2002 output 3D output suitable for animation
# v0.75 May 13 01:45:41 2002 beginnings of vrml output (-v) - colored spheres
# v0.76 May 13 04:30:13 2002 added connections between nodes to vrml
#                            output, thanks cylinder translation/rotation
#                            code from VRML.pm by Hartmut Palm:
#                            http://dc.gfz-potsdam.de/~palm/vrmlperl/
# v0.77 May 13 04:41:53 2002 made colors optional in pov and vrml output
# v0.78 May 13 06:31:34 2002 removed extra cylinders from vrml output
# v0.79 May 13 07:20:23 2002 made 2d output background transparent
# v0.80 Mar 19 2003 optimization patch from Marco Bodrato
# v0.81 Aug 20 2003 Caption stderr progress notes
# v0.87 Oct 13 2004 only graph the largest cluster - Darxus
# v0.88 Nov 22 21:27:21 2005 applied clustering fix patch from David Crisinel
#
# TODO
# * inverse exponential movement
# * specification of output pixelcount
# * ljmindmap style averaged random colors (cluster colorization)

use GD;
use Getopt::Std;
use strict;
use vars qw(
$push
$pull
%node
$im
$source
$dest
$nodenum
$blue
$black
$opt_b
$bgcol
@bgcolor
$dist
$iter
$maxiter
$percent
$xdist
$ydist
$newdist2
$xmove
$ymove
$movecount
$rate
$nodes
%link
$continue
$done
$line
@nodelist
%saw
$name
$label
$margin
$minx
$miny
$maxx
$maxy
$scale
$nodesize
$powderblue
$linecol
$h
$s
$v
$r
$g
$b
$color
$maxxlength
$minxlength
$pi
$twopi
$angle
@point
$width
$height
$arrowlength
$arrowwidth
$num
$opt_s
$edge
@parts
$part
@sources
@dests
$sourcesstring
$destsstring
$pov
$opt_p
$zdist
$zmove
$pov_or_vrml
$opt_v
$vrml
$opt_t
$trans
$opt_h
$opt_l
@linecolor
%cluster
%nodecount
$largestcluster
$largestclusterval
%rank
);

$push = 2000;
$pull = .1;
$maxiter = 400;
#$maxiter = 60;
$rate = 2;
$nodes = 5;
#$done = 0.1;
$done = 0.3;
#$done = 3;
$margin = 20;
#$nodesize = 80;
$nodesize = 40;
$arrowlength = 10; # pixels
$arrowwidth = 10; 

srand 1; #comment out this line to generate graphs differently every time

$pi = 3.141592653589793238462643383279502884197169399375105; # from memory
$twopi = $pi * 2;

getopts('s:pvhtb:l:');

# -s: set scale
if ($opt_s)
{
  $scale = $opt_s;
} else {
  $scale = 1;
}

# -p: Output as Pov-Ray
if ($opt_p)
{
  $pov = 1;
} else {
  $pov = 0;
}

# -v: Output as VRML
if ($opt_v)
{
  $vrml = 1;
} else {
  $vrml = 0;
}

# -h: Show some help
if ($opt_h) {
  usage();
  exit 1;
}

# -t: Make background transparent
if ($opt_t)
{
  $trans = 1;
} else {
  $trans = 0;
}

# -b: Set background color
if ($opt_b)
{
  $trans = 0;
  $opt_b =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_b";
  @bgcolor = (hex($1), hex($2), hex($3));
} else {
  @bgcolor = (255, 255, 255);
}

# -l: Set line color
if ($opt_l)
{
  $trans = 0;
  $opt_l =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_l";
  @linecolor = (hex($1), hex($2), hex($3));
} else {
  @linecolor = (169, 169, 169);
}

$done = $done / $scale;

while ($line = <STDIN>)
{
  undef $name;
  next if ($line =~ m#^//#);
  chomp $line;
  # 2 = arro1, 1 = no arrow
  if ($line =~ m#^(.*-[>-][^\[]*)#)
  {
    $edge = $1;
    @parts = split(/(-[->])/,$edge);
    for $part (0 .. $#parts)
    {
      if (defined $parts[$part+2] and $parts[$part] ne '->' and $parts[$part] ne '--')
      {
        #print ":$parts[$part]:".$parts[$part+1].":".$parts[$part+2].":\n";
        undef @sources;
        undef @dests;
        $parts[$part] =~ s/^\s*"?//;
        $parts[$part] =~ s/"?\s*$//;
        $parts[$part+2] =~ s/^\s*"?//;
        $parts[$part+2] =~ s/"?\s*;?\s*$//;
        if ($parts[$part] =~ m#^{(.*)}$#)
        {
          $sourcesstring = $1;
          #print STDERR "sourcesstring:$sourcesstring:\n";
          @sources = split(/[\s*;?\s*]/,$sourcesstring);
        } else {
          $sources[0] = $parts[$part];
        }
        if ($parts[$part+2] =~ m#^{(.*)}$#)
        {
          $destsstring = $1;
          #print STDERR "destsstring:$destsstring:\n";
          @dests = split(/[\s*;?\s*]/,$destsstring);
        } else {
          $dests[0] = $parts[$part+2];
        }
        for $source (@sources)
        {
          next if ($source eq "");
          for $dest (@dests)
          {
            next if ($dest eq "");
            $source =~ s/^\s*"?//;
            $source =~ s/"?\s*$//;
            $dest =~ s/^\s*"?//;
            $dest =~ s/"?\s*;?\s*$//;
            if ($parts[$part+1] eq '->') {
              $link{$source}{$dest} = 2;
              $rank{$dest}++;
            }
            $link{$source}{$dest} = 1 if ($parts[$part+1] eq '--');
            push (@nodelist,$source,$dest);
            #print STDERR "$source ".$parts[$part+1]." $dest\n";
          }
        }
      }
    }

#    $source = $1;
#    $dest = $2;
#    $source =~ s/^\W*//;
#    $source =~ s/\W*$//;
#    $dest =~ s/^\W*//;
#    $dest =~ s/\W*$//;
#    $link{$source}{$dest} = 2;
#    push (@nodelist,$source,$dest);
#    print STDERR "source:$source:dest:$dest:\n";
  } else {
#    if ($line =~ m#^edge# or $line =~ m#^node#)
#    {
#      print STDERR "Skipping: $line\n";
#      next;
#    }
    if ($line =~ m#^(\S+).*\[.*\]#)
    {
      $name = $1;
      $name =~ tr/"//d;
      if ($name eq 'node' or $name eq 'edge')
      {
        next;
      }
      #print STDERR "name:$name:\n";
    }
    if ($line =~ m#\[.*label=([^,\]]*).*\]#)
    {
      $label = $1;
      $label =~ tr/"//d;
      $node{$name}{'label'} = $label;
      #print STDERR "label:$label:\n";
    }
    if ($line =~ m#\[.*fillcolor="?([\d\.]+),([\d\.]+),([\d\.]+).*\]#)
    {
      $h = $1;
      $s = $2;
      $v = $3;
      #print STDERR "hsv:$h:$s:$v:\n";
      $h = $h * 360;
      ($r,$g,$b) = &hsv2rgb($h,$s,$v);
      $node{$name}{r} = $r;
      $node{$name}{g} = $g;
      $node{$name}{b} = $b;
      #print STDERR "rgb:$r:$g:$b:\n";
    }
  }
}

print STDERR "Number of edges for which this node is the destination:\n";
for my $node (sort {$rank{$b} <=> $rank{$a}} keys %rank) {
  print STDERR "$rank{$node} $node\n";
}
print STDERR "\n";

#$link{$source}{$dest}
my $maxcluster = 0;
for my $source (keys %link) {
  for my $dest (keys %{$link{$source}}) {
    if (!defined $cluster{$source} and !defined $cluster{$dest}) {
      $maxcluster++;
      $cluster{$source} = $maxcluster;
      $cluster{$dest} = $maxcluster;
    } elsif (defined $cluster{$source} and !defined $cluster{$dest}) {
      $cluster{$dest} = $cluster{$source};
    } elsif (defined $cluster{$dest} and !defined $cluster{$source}) {
      $cluster{$source} = $cluster{$dest};
    } elsif (defined $cluster{$source} and defined $cluster{$dest}) {

#      for my $node (keys %cluster) {
#        if ($cluster{$node} == $cluster{$dest}) {
#          $cluster{$node} = $cluster{$source}
#        }
#      }


       for my $node (keys %cluster) {
         if ($cluster{$node} == $cluster{$source}) {
           $cluster{$node} = $cluster{$dest}
         }
       }




    }
  }
}

for my $node (keys %cluster) {
  $nodecount{$cluster{$node}}++;
}

print STDERR scalar(keys %nodecount) . " clusters:\n";

$largestclusterval = 0;
for my $cluster (keys %nodecount) {
  if ($nodecount{$cluster} > $largestclusterval) {
    $largestcluster = $cluster;
    $largestclusterval = $nodecount{$cluster};
  }
#  print STDERR "largestcluster:$largestcluster,largestclusterval:$largestclusterval,cluster:$cluster,nodecount-cluster:$nodecount{$cluster}\n";
}


for my $cluster (sort keys %nodecount) {
  print STDERR "Cluster $cluster, $nodecount{$cluster} nodes:\n";
  for my $node (sort keys %cluster) {
    print STDERR "$node " if $cluster{$node} == $cluster;
  }
  print STDERR "\n";
}

#for $source (keys %link) {
#  for $dest (keys %{$link{$source}}) {
#    unless ($cluster{$source} == $largestcluster and $cluster{$dest} == $largestcluster) {
#      delete $link{$source}{$dest};
##      print STDERR "deleting $source - $dest\n";
#    }
#  }
#}

undef @nodelist;
print STDERR "Done clustering.\n";
for my $node (keys %cluster) {
  if ($cluster{$node} == $largestcluster) {
    push @nodelist, $node;
  }
}

#undef %saw;
#@saw{@nodelist} = ();
#@nodelist = sort keys %saw;  # remove sort if undesired
#undef %saw;

if ($pov or $vrml) {
  $pov_or_vrml = 1;
} else {
  $pov_or_vrml = 0;
}

for $nodenum (@nodelist)
{
  $node{$nodenum}{x}=rand;# $maxx;
  $node{$nodenum}{y}=rand;# $maxy;
  $node{$nodenum}{z}=rand if $pov_or_vrml;
  unless(defined $node{$nodenum}{'label'})
  {
    $node{$nodenum}{'label'} = $nodenum;
  }
}

print STDERR "springgraph iterating until reaches $done\n\n";

#&draw;
$continue = 1;
$iter = 0;
while($continue > $done and $iter <= $maxiter)
{
  $continue = $done;
  $iter++;
  for $nodenum (@nodelist)
  {
    $node{$nodenum}{oldx} = $node{$nodenum}{x};
    $node{$nodenum}{oldy} = $node{$nodenum}{y};
    $node{$nodenum}{oldz} = $node{$nodenum}{z} if $pov_or_vrml;
    $xmove = 0;
    $ymove = 0;
  }
  for $source (@nodelist)
  {
    $movecount = 0;
    for $dest (@nodelist)
    {
      next if ($source eq $dest);
      $xdist = $node{$source}{oldx} - $node{$dest}{oldx};
      $ydist = $node{$source}{oldy} - $node{$dest}{oldy};
      $dist = $xdist*$xdist + $ydist*$ydist;
      if ($pov_or_vrml)
      {
	$zdist = $node{$source}{oldz} - $node{$dest}{oldz};
        $dist += $zdist*$zdist;
      }
      # $distance = sqrt($dist);
      $percent = $push / $dist;
      if ($link{$source}{$dest})
      {
         $percent -= $pull;
      }
      if ($link{$dest}{$source})
      {
         $percent -= $pull;
      }
      $percent *= $rate;
      $xmove -= $xdist * $percent;
      $ymove -= $ydist * $percent;
      $zmove -= $zdist * $percent if $pov_or_vrml;
      $movecount++;
      # $pullmove = $pull * $dist;
      # $pushmove = $push / $dist;
      # print STDERR "dist: $dist, pull: $pullmove, push: $pushmove\n";
      # print STDERR "$source to ${dest}, Dist: $dist Want: $wantdist (${percent}x)\n";
      # print STDERR "is: $node[$source]{oldx} $node[$source]{oldy} $xdist $ydist, want: $wantxdist $wantydist ($newdist2)\n";

    }
    $xmove = $xmove / $movecount;
    $ymove = $ymove / $movecount;
    $zmove = $zmove / $movecount if $pov_or_vrml;
    $node{$source}{x} -= $xmove;
    $node{$source}{y} -= $ymove;
    $node{$source}{z} -= $zmove if $pov_or_vrml;
    if ($xmove > $continue)
    {
      $continue = $xmove;
    }
    if ($ymove > $continue)
    {
      $continue = $ymove;
    }
    if (($pov_or_vrml) and $zmove > $continue)
    {
      $continue = $zmove;
    }
  }
  #print STDERR "$iter\n";
  if (0)
  {
    &draw;
    open (XV,"| xv -wait 1 -");
    #open (XV,"| xloadimage -delay 1 stdin");
    binmode XV;
    print XV $im->png;
    close XV;
  }
  if ($iter % 20 == 0)
  {
    print STDERR "$continue\n";
  }
}
print STDERR "Iterations: $iter\n";
for $source (@nodelist)
{
  for $color ('r', 'g', 'b')
  {
    $node{$source}{$color} = 255 unless (defined $node{$source}{$color});
  }
}
if ($pov)
{
  &drawpov;
} elsif ($vrml) {
  &drawvrml;
} else {
  &draw;
}

undef $maxx;
undef $maxy;
sub draw
{
  for $nodenum (@nodelist)
  {
    if (!(defined $maxx) or (($node{$nodenum}{x} + (length($node{$nodenum}{'label'}) * 8 + 16)/2) > $maxx + (length($node{$nodenum}{'label'}) * 8 + 16)/2))
    {
      $maxx = $node{$nodenum}{x};# + (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
      $maxxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
    }
    if (!(defined $minx) or (($node{$nodenum}{x} - (length($node{$nodenum}{'label'}) * 8 + 16)/2) < $minx - (length($node{$nodenum}{'label'}) * 8 + 16)/2))
    {
      $minx = $node{$nodenum}{x};# - (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
      $minxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
    }

    $maxy = $node{$nodenum}{y} if (!(defined $maxy) or $node{$nodenum}{y} > $maxy);
    $miny = $node{$nodenum}{y} if (!(defined $miny) or $node{$nodenum}{y} < $miny);
  }
  for $nodenum (@nodelist)
  {
    #$node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $margin;
    $node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $minxlength -1 ;# + $margin;
    $node{$nodenum}{y} = ($node{$nodenum}{y} - $miny) * $scale + $nodesize/2 - 1;
  }
  $maxx = ($maxx - $minx) * $scale + $minxlength + $maxxlength;# + $margin*2;
  $maxy = ($maxy - $miny) * $scale + $nodesize/2*2;
  $im = new GD::Image($maxx,$maxy);
  $bgcol = $im->colorAllocate(@bgcolor);
  $im->transparent($bgcol) if $trans; # make transparent
  $blue = $im->colorAllocate(0,0,255);
  $powderblue = $im->colorAllocate(176,224,230);
  $black = $im->colorAllocate(0,0,0);
  $linecol = $im->colorAllocate(@linecolor);

  for $source (@nodelist)
  {
    #print STDERR "node: $source $node[$source]{x},$node[$source]{y}\n";
    for $dest (@nodelist)
    {
      if (defined $link{$source}{$dest} and $link{$source}{$dest} == 2 and $source ne $dest)
      {
        $dist = sqrt( abs($node{$source}{x}-$node{$dest}{x})**2 +  abs($node{$source}{y}-$node{$dest}{y})**2 );
        $xdist = $node{$source}{x} - $node{$dest}{x};
        $ydist = $node{$source}{y} - $node{$dest}{y};

        $angle = &acos($xdist/$dist);
        #$angle = atan2($ydist,$xdist);
        #$angle += $pi if $ydist < 0;
        #$dist = abs(cos($angle))*(length($node{$dest}{'label'}) * 8 + 16)/2 + abs(sin($angle))*$nodesize/2;
        $width = (length($node{$dest}{'label'}) * 8 + 16)/2;
        $height = $nodesize/2;
        $dist = sqrt( ($height**2 * $width**2) / ( ($height**2 * (cos($angle)**2) ) + ($width**2 * (sin($angle)**2) ) ));
        #$dist = $dist*40;
        $xmove = cos($angle)*$dist;
        $ymove = sin($angle)*$dist;
        #$ymove = -$ymove if $ydist < 0; # the part mj omitted
        $point[0]{x} = $xmove;
        $point[0]{y} = $ymove;

        $xmove = cos($angle)*($dist+$arrowlength-3);
        $ymove = sin($angle)*($dist+$arrowlength-3);
        #$ymove = -$ymove if $ydist < 0; # the part mj omitted
        $point[3]{x} = $xmove;
        $point[3]{y} = $ymove;

        #$angle = $angle + $arrowwidth/2;
        $dist = 4;
        $xmove = $xmove + cos($angle)*$dist;
        $ymove = $ymove + sin($angle)*$dist;
        #$ymove = -$ymove if $ydist < 0; # the part mj omitted

        $angle = $angle + $twopi/4; 
        $dist = $arrowwidth/2;
        $xmove = $xmove + cos($angle)*$dist;
        $ymove = $ymove + sin($angle)*$dist;
        #$ymove = -$ymove if $ydist < 0; # the part mj omitted
        $point[1]{x} = $xmove;
        $point[1]{y} = $ymove;

        $angle = $angle + $twopi/2;
        $dist = $arrowwidth;
        $xmove = $xmove + cos($angle)*$dist;
        $ymove = $ymove + sin($angle)*$dist;
        #$ymove = -$ymove if $ydist < 0; # the part mj omitted
        $point[2]{x} = $xmove;
        $point[2]{y} = $ymove;

        for $num (0 .. 3)
        {
          $point[$num]{y} = - $point[$num]{y} if $ydist < 0;
        }
        
        $im->line($node{$dest}{x}+$point[0]{x},$node{$dest}{y}+$point[0]{y},$node{$dest}{x}+$point[1]{x},$node{$dest}{y}+$point[1]{y},$linecol);
        $im->line($node{$dest}{x}+$point[1]{x},$node{$dest}{y}+$point[1]{y},$node{$dest}{x}+$point[2]{x},$node{$dest}{y}+$point[2]{y},$linecol);
        $im->line($node{$dest}{x}+$point[2]{x},$node{$dest}{y}+$point[2]{y},$node{$dest}{x}+$point[0]{x},$node{$dest}{y}+$point[0]{y},$linecol);
#        $xmove = int($node{$dest}{x}+$point[3]{x});
#        $ymove = int($node{$dest}{y}+$point[3]{y});
#        $im->fillToBorder($xmove,$ymove,$linecol,$powderblue);
        #$im->fillToBorder($node{$dest}{x}+$point[3]{x},$node{$dest}{y}+$point[3]{y},$linecol,$linecol);
        #$im->line($point[1]{x},$point[1]{y},$point[2]{x},$point[2]{y},$linecol);
        #$im->line($point[2]{x},$point[2]{y},$point[0]{x},$point[0]{y},$linecol);
        #$im->fillToBorder($point[3]{x},$point[3]{y},$linecol,$linecol);
        #$im->arc($point[3]{x},$point[3]{y},10,10,0,360,$black);

#        $im->arc($point[0]{x},$point[0]{y},20,20,0,360,$black);
#        $im->arc($point[1]{x},$point[1]{y},20,20,0,360,$black);
#        $im->arc($point[2]{x},$point[2]{y},20,20,0,360,$black);
        #$im->arc($node{$dest}{x}+$xmove,$node{$dest}{y}+$ymove,20,20,0,360,$black);
      }
    }
  }
  for $source (@nodelist)
  {
    for $dest (@nodelist)
    {
      if ($link{$source}{$dest})
      {
        $im->line($node{$source}{x},$node{$source}{y},$node{$dest}{x},$node{$dest}{y},$linecol);
      }
    }
  }

  for $source (@nodelist)
  {
    $im->arc($node{$source}{x},$node{$source}{y},(length($node{$source}{'label'}) * 8 + 16),$nodesize,0,360,$black);
    #$im->arc($node{$source}{x},$node{$source}{y},$nodesize,$nodesize,0,360,$black);
    if (defined $node{$source}{r} and defined $node{$source}{g} and defined $node{$source}{b})
    {
      $color = $im->colorResolve($node{$source}{r},$node{$source}{g},$node{$source}{b});
    } else
    {
      $color = $bgcol;
    }
    $im->fillToBorder($node{$source}{x},$node{$source}{y},$black,$color);
  }
  for $source (@nodelist)
  {
    $im->string(gdLargeFont,$node{$source}{x} - (length($node{$source}{'label'}) * 8 / 2) ,$node{$source}{y}-8,$node{$source}{'label'},$black);
  }


  binmode STDOUT;
  print $im->png;
}

sub drawpov
{
  print'// Generated by springgraph, by Darxus@ChaosReigns.com: 
// http://www.ChaosReigns.com/code/springgraph/

#include "colors.inc"
#include "shapes.inc"
#include "textures.inc"
#include "glass.inc"
#include "stones.inc"
light_source {<0, 400, -500> color White rotate <0, 360*clock, 0>}
light_source {<400, 0, -500> color White rotate <0, 360*clock, 0>}
';

  for $source (@nodelist)
  {
    $node{$source}{x} = $node{$source}{x} * $scale;
    $node{$source}{y} = $node{$source}{y} * $scale;
    $node{$source}{z} = $node{$source}{z} * $scale;
    $node{$source}{r} = $node{$source}{r} / 256;
    $node{$source}{g} = $node{$source}{g} / 256;
    $node{$source}{b} = $node{$source}{b} / 256;
  }
  for $source (@nodelist)
  {
    print "sphere { <$node{$source}{x},$node{$source}{y},$node{$source}{z}>, 15 pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    print "text { ttf \"crystal.ttf\", \"$node{$source}{'label'}\", 0.5, 0 translate 2*x rotate <0, 360*clock, 0> translate -0.375*y scale 10 translate <$node{$source}{x},$node{$source}{y},$node{$source}{z}> pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    #print "text { ttf \"crystal.ttf\", \"$node{$source}{'label'}\", 0.5, 0 translate -".scalar(length($node{$source}{'label'})*0.25)."*x scale 10 translate <$node{$source}{x},$node{$source}{y},$node{$source}{z}> pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    for $dest (@nodelist)
    {
      if ($link{$source}{$dest})
      {
        print "cylinder {<$node{$source}{x},$node{$source}{y},$node{$source}{z}>,<$node{$dest}{x},$node{$dest}{y},$node{$dest}{z}> 0.5 pigment {color rgb<0.5,0.5,0.5>}}\n";
      }
    }
  }
  print 'camera {
   location  <0, 0, -500>
   up        <0.0,  1.0,  0>
   right     <4/3,  0.0,  0>
   look_at   <0,    0,   -1>
   rotate <0, 360*clock, 0>
}
';

}


sub drawvrml
{
  my ($t,$r,$length,$color);
  print'#VRML V2.0 utf8

WorldInfo {
  info ["Generated by springgraph, by Darxus@ChaosReigns.com: http://www.ChaosReigns.com/code/springgraph/"]
}

';

  for $source (@nodelist)
  {
    $node{$source}{x} = $node{$source}{x} * $scale;
    $node{$source}{y} = $node{$source}{y} * $scale;
    $node{$source}{z} = $node{$source}{z} * $scale;
    for $color ('r', 'g', 'b')
    {
      if (defined $node{$source}{$color})
      {
        $node{$source}{$color} = $node{$source}{$color} / 256;
      }
    }
  }
  for $source (@nodelist)
  {
print "
Transform {
  translation $node{$source}{x} $node{$source}{y} $node{$source}{z}
  children [
    Shape{
        appearance Appearance {
           material Material {
              diffuseColor $node{$source}{r} $node{$source}{g} $node{$source}{b}
           }
        }
        geometry Sphere{radius 15}
    }
  ]
}
";

    #print "sphere { <$node{$source}{x},$node{$source}{y},$node{$source}{z}>, 15 pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    #print "text { ttf \"crystal.ttf\", \"$node{$source}{'label'}\", 0.5, 0 translate 2*x rotate <0, 360*clock, 0> translate -0.375*y scale 10 translate <$node{$source}{x},$node{$source}{y},$node{$source}{z}> pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    #print "text { ttf \"crystal.ttf\", \"$node{$source}{'label'}\", 0.5, 0 translate -".scalar(length($node{$source}{'label'})*0.25)."*x scale 10 translate <$node{$source}{x},$node{$source}{y},$node{$source}{z}> pigment {color rgb<$node{$source}{r},$node{$source}{g},$node{$source}{b}>}}\n";
    for $dest (@nodelist)
    {
      if ($link{$source}{$dest})
      {
        ($t,$r,$length) = &cylinder($node{$source}{x},$node{$source}{y},$node{$source}{z},$node{$dest}{x},$node{$dest}{y},$node{$dest}{z});
        print "
Transform {
  translation $t
  rotation $r
  children [
    Shape{
        appearance Appearance {
           material Material {
              diffuseColor 0.5 0.5 0.5
           }
        }
        geometry Cylinder {
          radius 0.5
          height $length
          top FALSE
          bottom FALSE
        }
    }
  ]
}
";


        
      }
    }
  }
#  print 'camera {
#   location  <0, 0, -500>
#   up        <0.0,  1.0,  0>
#   right     <4/3,  0.0,  0>
#   look_at   <0,    0,   -1>
#   rotate <0, 360*clock, 0>
#}
#';

}




sub hsv2rgb
{
#from http://faqchest.dynhost.com/prgm/perlu-l/perl-01/perl-0101/perl-010100/perl01010410_17820.html

# Given an h/s/v array, return an r/g/b array.
# The r/g/b values will each be between 0 and 255.
# The h value will be between 0 and 360, and
# the s and v values will be between 0 and 1.
#

                      my $h = shift;
                      my $s = shift;
                      my $v = shift;

                      # limit this to h values between 0 and 360 and s/v values
                      # between 0 and 1

                      unless (defined($h) && defined($s) && defined($v) &&
                             $h >= 0 && $s >= 0 && $v >= 0 &&
                             $h <= 360 && $s <= 1 && $v <= 1) {
                        return (undef, undef, undef);
                      }

                      my $r;
                      my $g;
                      my $b;

                      # 0.003 is less than 1/255; use this to make the floating point
                      # approximation of zero, since the resulting rgb values will
                      # normally be used as integers between 0 and 255.  Feel free to
                      # change this approximation of zero to something else, if this
                      # suits you.
                      if ($s < 0.003) {
                        $r = $g = $b = $v;
                      }
                      else {

                        $h /= 60;
                        my $sector = int($h);
                        my $fraction = $h - $sector;

                        my $p = $v * (1 - $s);
                        my $q = $v * (1 - ($s * $fraction));
                        my $t = $v * (1 - ($s * (1 - $fraction)));

                        if ($sector == 0) {
                          $r = $v;
                          $g = $t;
                          $b = $p;
                        }
                        elsif ($sector == 1) {
                          $r = $q;
                          $g = $v;
                          $b = $p;
                        }
                        elsif ($sector == 2) {
                          $r = $p;
                          $g = $v;
                          $b = $t;
                        }
                        elsif ($sector == 3) {
                          $r = $p;
                          $g = $q;
                          $b = $v;
                        }
                        elsif ($sector == 4) {
                          $r = $t;
                          $g = $p;
                          $b = $v;
                        }
                        else {
                          $r = $v;
                          $g = $p;
                          $b = $q;
                        }
                      }

                      # Convert the r/g/b values to all be between 0 and 255; use the
                      # ol' 0.003 approximation again, with the same comment as above.

                      $r = ($r < 0.003 ? 0.0 : $r * 255);
                      $g = ($g < 0.003 ? 0.0 : $g * 255);
                      $b = ($b < 0.003 ? 0.0 : $b * 255);

                      return ($r, $g, $b);
                    }

# from perlfunc(1)
sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }


sub cylinder {
    my ($x1,$y1,$z1,$x2,$y2,$z2) = @_;
    my ($t, $r, $length, $rx, $ry, $rz, $dist);

    $x1 = 0 unless $x1;
    $x2 = 0 unless $x2;
    $y1 = 0 unless $y1;
    $y2 = 0 unless $y2;
    $z1 = 0 unless $z1;
    $z2 = 0 unless $z2;
    my $dx=$x1-$x2;
    my $dy=$y1-$y2;
    my $dz=$z1-$z2;
    if (1) {
        unless (0) {
            $length = sqrt($dx*$dx + $dy*$dy + $dz*$dz);
            $rx = $dx;
            $ry = ($dy+$length);
            $rz = $dz;
            $dist = sqrt(abs($rx)**2 + abs($ry)**2);
            $dist = sqrt(abs($rz)**2 + abs($dist)**2);
            $rx = $rx / $dist;
            $ry = $ry / $dist;
            $rz = $rz / $dist;
            $t = ($x1-($dx/2))." ".($y1-($dy/2))." ".($z1-($dz/2));
            $r = "$rx $ry $rz $pi";
        }
    }
    return ($t,$r,$length);
}

sub usage {
print <<END
springgraph - Render a .dot file into a graphic

Usage: springgraph [-p] [-v] [-s scale] [-t] [-b color] [-l color] [-h]

   -p   Create a file that can be rendered with POV-Ray
   -v   Create a VRML file
   -s   This option specifies the scale. All of the node locations
        are multiplied by this. Increase the scale to eliminate node
        overlaps. Decrease the scale to make the graph smaller. 
   -t   Make the background of the resulting image transpaent.
   -b   set background color of image, specify it in the form RRGGBB,
        in hex digits, e.g. FFFFFF is white, 000000 is black, FF0000
        is red, ...
   -l   set the line color, same format as the background color
   -h   show this help

END
}