springgraph/springgraph

   1 #!/usr/bin/perl -w
   2
   3 # springgraph v0.79, (c) 2002 Darxus@ChaosReigns.com, released under the GPL
   4 # Download current version from:  http://www.chaosreigns.com/code/springgraph/
   5 #
   6 # This program attempts to render .dot files in a fashion similar to neato,
   7 # which is part of graphviz:  http://www.research.att.com/sw/tools/graphviz/.
   8 # I have never looked at any of the code in graphviz.
   9 #
  10 # Example usage:
  11 #
  12 # cat test.dot | ./springgraph.pl -s 3 > springgraph.png
  13 #
  14 # The "-s 3" specifies the scale, and is optional.  All of the node
  15 # locations are multiplied by this.  Increase the scale to eliminate
  16 # node overlaps.  Decrease the scale to make the graph smaller.
  17 #
  18 # Requirements:  GD.pm (http://www.perl.com/CPAN/authors/id/L/LD/LDS/)
  19 #
  20 # Definition of the .dot files which springgraph renders
  21 # can be found in the graphviz man pages.  A copy is here:
  22 # http://www.unisa.edu.au/eie/csec/graphviz/dot.1.html.  Springgraph only
  23 # supports the fillcolor and label node attributes, and can only handle
  24 # two nodes per edge definition ("node1 -> node2", not "node1 -> node2
  25 # -> node3").
  26 #
  27 # Springgraph fully supports the .dot files generated by sig2dot
  28 # (http://www.chaosreigns.com/code/sig2dot), which generates .dot files
  29 # from GPG/PGP signature relationships.
  30 #
  31 # Thanks to the following for help with the math for the arrowheads:
  32 # Mike Joseph <mj@doze.net>
  33 # Walt Mankowski <waltman@pobox.com>
  34 # Jeff Weisberg <jaw+plug@tcp4me.com>
  35 #
  36 # Yes, the placement of the freaking arrowheads was by far the hardest
  37 # part of writing this program.
  38 #
  39 # Thanks to Hartmut Palm for cylinder translation/rotation code in
  40 # VRML.pm:  http://dc.gfz-potsdam.de/~palm/vrmlperl/
  41
  42 # v0.26 May 06 16:12:30 2002
  43 # v0.27 May 06 18:15:38 2002 cleanup
  44 # v0.44 May 06 23:56:45 2002
  45 # v0.56 May 07 05:10:02 2002
  46 # v0.60 May 07 23:27:29 2002 arrow heads !! (not filled in due to segfault)
  47 # v0.61 May 07          2002 handle absence of beginning double-quote in fillcolor attribute
  48 # v0.62 May 08 19:44:04 2002 use getopts to get scale argument
  49 # v0.63 May 08 21:29:48 2002 made fillcolor optional again
  50 # v0.64 May 08 22:28:40 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/ER.dot.txt
  51 #                            and http://www.research.att.com/sw/tools/graphviz/examples/undirected/process.dot.txt
  52 #                            (added support for undirected graphs ("--" links)
  53 # v0.65 May 08 22:44:00 2002 render http://www.research.att.com/sw/tools/graphviz/examples/directed/fsm.dot.txt
  54 #                            (do not attempt to draw a line from a node to itself and cause a devision by zero)
  55 # v0.67 May 09 05:53:16 2002 support multiple nodes on one link line, adjusted detection of completion
  56 #                            render http://www.research.att.com/sw/tools/graphviz/examples/directed/unix.dot.txt
  57 #                            (support node names containing spaces)
  58 # v0.68 May 09 17:29:06 2002 cleaned up link line processing a bit (removed extraneous define checks)
  59 # v0.69 May 09 18:23:19 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/inet.dot.txt
  60 #                            (support {} lists in link (edge) lines)
  61 # v0.70 May 10 00:39:20 2002 Strip double-quotes that were getting missed to support sig2dot v0.27.
  62 # v0.71 May 11 20:06:17 2002 don't draw twice, added some 3D math (but not output yet)
  63 # v0.72 May 11 21:31:20 2002 3D output !!! (via -p flag)
  64 # v0.73 May 11 22:34:23 2002 added labels to 3D output
  65 # v0.74 May 12 02:07:29 2002 output 3D output suitable for animation
  66 # v0.75 May 13 01:45:41 2002 beginnings of vrml output (-v) - colored spheres
  67 # v0.76 May 13 04:30:13 2002 added connections between nodes to vrml
  68 #                            output, thanks cylinder translation/rotation
  69 #                            code from VRML.pm by Hartmut Palm:
  70 #                            http://dc.gfz-potsdam.de/~palm/vrmlperl/
  71 # v0.77 May 13 04:41:53 2002 made colors optional in pov and vrml output
  72 # v0.78 May 13 06:31:34 2002 removed extra cylinders from vrml output
  73 # v0.79 May 13 07:20:23 2002 made 2d output background transparent
  74 # v0.80 Mar 19 2003 optimization patch from Marco Bodrato
  75 # v0.81 Aug 20 2003 Caption stderr progress notes
  76
  77 use GD;
  78 use Getopt::Std;
  79 use strict;
  80 use vars qw(
  81 $push
  82 $pull
  83 %node
  84 $im
  85 $source
  86 $dest
  87 $nodenum
  88 $blue
  89 $black
  90 $opt_b
  91 $bgcol
  92 @bgcolor
  93 $dist
  94 $iter
  95 $maxiter
  96 $percent
  97 $xdist
  98 $ydist
  99 $newdist2
 100 $xmove
 101 $ymove
 102 $movecount
 103 $rate
 104 $nodes
 105 %link
 106 $continue
 107 $done
 108 $line
 109 @nodelist
 110 %saw
 111 $name
 112 $label
 113 $margin
 114 $minx
 115 $miny
 116 $maxx
 117 $maxy
 118 $scale
 119 $nodesize
 120 $powderblue
 121 $linecol
 122 $h
 123 $s
 124 $v
 125 $r
 126 $g
 127 $b
 128 $color
 129 $maxxlength
 130 $minxlength
 131 $pi
 132 $twopi
 133 $angle
 134 @point
 135 $width
 136 $height
 137 $arrowlength
 138 $arrowwidth
 139 $num
 140 $opt_s
 141 $edge
 142 @parts
 143 $part
 144 @sources
 145 @dests
 146 $sourcesstring
 147 $destsstring
 148 $pov
 149 $opt_p
 150 $zdist
 151 $zmove
 152 $pov_or_vrml
 153 $opt_v
 154 $vrml
 155 $opt_t
 156 $trans
 157 $opt_h
 158 $opt_l
 159 @linecolor
 160 );
 161
 162 $push = 2000;
 163 $pull = .1;
 164 $maxiter = 400;
 165 $rate = 2;
 166 $nodes = 5;
 167 #$done = 0.1;
 168 $done = 0.3;
 169 #$done = 3;
 170 $margin = 20;
 171 #$nodesize = 80;
 172 $nodesize = 40;
 173 $arrowlength = 10; # pixels
 174 $arrowwidth = 10;
 175
 176 srand 1; #comment out this line to generate graphs differently every time
 177
 178 $pi = 3.141592653589793238462643383279502884197169399375105; # from memory
 179 $twopi = $pi * 2;
 180
 181 getopts('s:pvhtb:l:');
 182
 183 # -s: set scale
 184 if ($opt_s)
 185 {
 186   $scale = $opt_s;
 187 } else {
 188   $scale = 1;
 189 }
 190
 191 # -p: Output as Pov-Ray
 192 if ($opt_p)
 193 {
 194   $pov = 1;
 195 } else {
 196   $pov = 0;
 197 }
 198
 199 # -v: Output as VRML
 200 if ($opt_v)
 201 {
 202   $vrml = 1;
 203 } else {
 204   $vrml = 0;
 205 }
 206
 207 # -h: Show some help
 208 if ($opt_h) {
 209   usage();
 210   exit 1;
 211 }
 212
 213 # -t: Make background transparent
 214 if ($opt_t)
 215 {
 216   $trans = 1;
 217 } else {
 218   $trans = 0;
 219 }
 220
 221 # -b: Set background color
 222 if ($opt_b)
 223 {
 224   $trans = 0;
 225   $opt_b =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_b";
 226   @bgcolor = (hex($1), hex($2), hex($3));
 227 } else {
 228   @bgcolor = (255, 255, 255);
 229 }
 230
 231 # -l: Set line color
 232 if ($opt_l)
 233 {
 234   $trans = 0;
 235   $opt_l =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_l";
 236   @linecolor = (hex($1), hex($2), hex($3));
 237 } else {
 238   @linecolor = (169, 169, 169);
 239 }
 240
 241 $done = $done / $scale;
 242
 243 while ($line = <STDIN>)
 244 {
 245   undef $name;
 246   next if ($line =~ m#^//#);
 247   chomp $line;
 248   # 2 = arro1, 1 = no arrow
 249   if ($line =~ m#^(.*-[>-][^\[]*)#)
 250   {
 251     $edge = $1;
 252     @parts = split(/(-[->])/,$edge);
 253     for $part (0 .. $#parts)
 254     {
 255       if (defined $parts[$part+2] and $parts[$part] ne '->' and $parts[$part] ne '--')
 256       {
 257         #print ":$parts[$part]:".$parts[$part+1].":".$parts[$part+2].":\n";
 258         undef @sources;
 259         undef @dests;
 260         $parts[$part] =~ s/^\s*"?//;
 261         $parts[$part] =~ s/"?\s*$//;
 262         $parts[$part+2] =~ s/^\s*"?//;
 263         $parts[$part+2] =~ s/"?\s*;?\s*$//;
 264         if ($parts[$part] =~ m#^{(.*)}$#)
 265         {
 266           $sourcesstring = $1;
 267           #print STDERR "sourcesstring:$sourcesstring:\n";
 268           @sources = split(/[\s*;?\s*]/,$sourcesstring);
 269         } else {
 270           $sources[0] = $parts[$part];
 271         }
 272         if ($parts[$part+2] =~ m#^{(.*)}$#)
 273         {
 274           $destsstring = $1;
 275           #print STDERR "destsstring:$destsstring:\n";
 276           @dests = split(/[\s*;?\s*]/,$destsstring);
 277         } else {
 278           $dests[0] = $parts[$part+2];
 279         }
 280         for $source (@sources)
 281         {
 282           next if ($source eq "");
 283           for $dest (@dests)
 284           {
 285             next if ($dest eq "");
 286             $source =~ s/^\s*"?//;
 287             $source =~ s/"?\s*$//;
 288             $dest =~ s/^\s*"?//;
 289             $dest =~ s/"?\s*;?\s*$//;
 290             $link{$source}{$dest} = 2 if ($parts[$part+1] eq '->');
 291             $link{$source}{$dest} = 1 if ($parts[$part+1] eq '--');
 292             push (@nodelist,$source,$dest);
 293             #print STDERR "$source ".$parts[$part+1]." $dest\n";
 294           }
 295         }
 296       }
 297     }
 298
 299 #    $source = $1;
 300 #    $dest = $2;
 301 #    $source =~ s/^\W*//;
 302 #    $source =~ s/\W*$//;
 303 #    $dest =~ s/^\W*//;
 304 #    $dest =~ s/\W*$//;
 305 #    $link{$source}{$dest} = 2;
 306 #    push (@nodelist,$source,$dest);
 307 #    print STDERR "source:$source:dest:$dest:\n";
 308   } else {
 309 #    if ($line =~ m#^edge# or $line =~ m#^node#)
 310 #    {
 311 #      print STDERR "Skipping: $line\n";
 312 #      next;
 313 #    }
 314     if ($line =~ m#^(\S+).*\[.*\]#)
 315     {
 316       $name = $1;
 317       $name =~ tr/"//d;
 318       if ($name eq 'node' or $name eq 'edge')
 319       {
 320         next;
 321       }
 322       #print STDERR "name:$name:\n";
 323     }
 324     if ($line =~ m#\[.*label=([^,\]]*).*\]#)
 325     {
 326       $label = $1;
 327       $label =~ tr/"//d;
 328       $node{$name}{'label'} = $label;
 329       #print STDERR "label:$label:\n";
 330     }
 331     if ($line =~ m#\[.*fillcolor="?([\d\.]+),([\d\.]+),([\d\.]+).*\]#)
 332     {
 333       $h = $1;
 334       $s = $2;
 335       $v = $3;
 336       #print STDERR "hsv:$h:$s:$v:\n";
 337       $h = $h * 360;
 338       ($r,$g,$b) = &hsv2rgb($h,$s,$v);
 339       $node{$name}{r} = $r;
 340       $node{$name}{g} = $g;
 341       $node{$name}{b} = $b;
 342       #print STDERR "rgb:$r:$g:$b:\n";
 343     }
 344   }
 345 }
 346
 347 undef %saw;
 348 @saw{@nodelist} = ();
 349 @nodelist = sort keys %saw;  # remove sort if undesired
 350 undef %saw;
 351
 352 if ($pov or $vrml) {
 353   $pov_or_vrml = 1;
 354 } else {
 355   $pov_or_vrml = 0;
 356 }
 357
 358 for $nodenum (@nodelist)
 359 {
 360   $node{$nodenum}{x}=rand;# $maxx;
 361   $node{$nodenum}{y}=rand;# $maxy;
 362   $node{$nodenum}{z}=rand if $pov_or_vrml;
 363   unless(defined $node{$nodenum}{'label'})
 364   {
 365     $node{$nodenum}{'label'} = $nodenum;
 366   }
 367 }
 368
 369 print STDERR "springgraph iterating until reaches $done\n\n";
 370
 371 #&draw;
 372 $continue = 1;
 373 $iter = 0;
 374 while($continue > $done)
 375 {
 376   $continue = $done;
 377   $iter++;
 378   for $nodenum (@nodelist)
 379   {
 380     $node{$nodenum}{oldx} = $node{$nodenum}{x};
 381     $node{$nodenum}{oldy} = $node{$nodenum}{y};
 382     $node{$nodenum}{oldz} = $node{$nodenum}{z} if $pov_or_vrml;
 383     $xmove = 0;
 384     $ymove = 0;
 385   }
 386   for $source (@nodelist)
 387   {
 388     $movecount = 0;
 389     for $dest (@nodelist)
 390     {
 391       next if ($source eq $dest);
 392       $xdist = $node{$source}{oldx} - $node{$dest}{oldx};
 393       $ydist = $node{$source}{oldy} - $node{$dest}{oldy};
 394       $dist = $xdist*$xdist + $ydist*$ydist;
 395       if ($pov_or_vrml)
 396       {
 397         $zdist = $node{$source}{oldz} - $node{$dest}{oldz};
 398         $dist += $zdist*$zdist;
 399       }
 400       # $distance = sqrt($dist);
 401       $percent = $push / $dist;
 402       if ($link{$source}{$dest})
 403       {
 404          $percent -= $pull;
 405       }
 406       if ($link{$dest}{$source})
 407       {
 408          $percent -= $pull;
 409       }
 410       $percent *= $rate;
 411       $xmove -= $xdist * $percent;
 412       $ymove -= $ydist * $percent;
 413       $zmove -= $zdist * $percent if $pov_or_vrml;
 414       $movecount++;
 415       # $pullmove = $pull * $dist;
 416       # $pushmove = $push / $dist;
 417       # print STDERR "dist: $dist, pull: $pullmove, push: $pushmove\n";
 418       # print STDERR "$source to ${dest}, Dist: $dist Want: $wantdist (${percent}x)\n";
 419       # print STDERR "is: $node[$source]{oldx} $node[$source]{oldy} $xdist $ydist, want: $wantxdist $wantydist ($newdist2)\n";
 420
 421     }
 422     $xmove = $xmove / $movecount;
 423     $ymove = $ymove / $movecount;
 424     $zmove = $zmove / $movecount if $pov_or_vrml;
 425     $node{$source}{x} -= $xmove;
 426     $node{$source}{y} -= $ymove;
 427     $node{$source}{z} -= $zmove if $pov_or_vrml;
 428     if ($xmove > $continue)
 429     {
 430       $continue = $xmove;
 431     }
 432     if ($ymove > $continue)
 433     {
 434       $continue = $ymove;
 435     }
 436     if (($pov_or_vrml) and $zmove > $continue)
 437     {
 438       $continue = $zmove;
 439     }
 440   }
 441   #print STDERR "$iter\n";
 442   if (0)
 443   {
 444     &draw;
 445     open (XV,"| xv -wait 1 -");
 446     #open (XV,"| xloadimage -delay 1 stdin");
 447     binmode XV;
 448     print XV $im->png;
 449     close XV;
 450   }
 451   if ($iter % 20 == 0)
 452   {
 453     print STDERR "$continue\n";
 454   }
 455 }
 456 print STDERR "Iterations: $iter\n";
 457 for $source (@nodelist)
 458 {
 459   for $color ('r', 'g', 'b')
 460   {
 461     $node{$source}{$color} = 255 unless (defined $node{$source}{$color});
 462   }
 463 }
 464 if ($pov)
 465 {
 466   &drawpov;
 467 } elsif ($vrml) {
 468   &drawvrml;
 469 } else {
 470   &draw;
 471 }
 472
 473 undef $maxx;
 474 undef $maxy;
 475 sub draw
 476 {
 477   for $nodenum (@nodelist)
 478   {
 479     if (!(defined $maxx) or (($node{$nodenum}{x} + (length($node{$nodenum}{'label'}) * 8 + 16)/2) > $maxx + (length($node{$nodenum}{'label'}) * 8 + 16)/2))
 480     {
 481       $maxx = $node{$nodenum}{x};# + (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
 482       $maxxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
 483     }
 484     if (!(defined $minx) or (($node{$nodenum}{x} - (length($node{$nodenum}{'label'}) * 8 + 16)/2) < $minx - (length($node{$nodenum}{'label'}) * 8 + 16)/2))
 485     {
 486       $minx = $node{$nodenum}{x};# - (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
 487       $minxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
 488     }
 489
 490     $maxy = $node{$nodenum}{y} if (!(defined $maxy) or $node{$nodenum}{y} > $maxy);
 491     $miny = $node{$nodenum}{y} if (!(defined $miny) or $node{$nodenum}{y} < $miny);
 492   }
 493   for $nodenum (@nodelist)
 494   {
 495     #$node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $margin;
 496     $node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $minxlength -1 ;# + $margin;
 497     $node{$nodenum}{y} = ($node{$nodenum}{y} - $miny) * $scale + $nodesize/2 - 1;
 498   }
 499   $maxx = ($maxx - $minx) * $scale + $minxlength + $maxxlength;# + $margin*2;
 500   $maxy = ($maxy - $miny) * $scale + $nodesize/2*2;
 501   $im = new GD::Image($maxx,$maxy);
 502   $bgcol = $im->colorAllocate(@bgcolor);
 503   $im->transparent($bgcol) if $trans; # make transparent
 504   $blue = $im->colorAllocate(0,0,255);
 505   $powderblue = $im->colorAllocate(176,224,230);
 506   $black = $im->colorAllocate(0,0,0);
 507   $linecol = $im->colorAllocate(@linecolor);
 508
 509   for $source (@nodelist)
 510   {
 511     #print STDERR "node: $source $node[$source]{x},$node[$source]{y}\n";
 512     for $dest (@nodelist)
 513     {
 514       if (defined $link{$source}{$dest} and $link{$source}{$dest} == 2 and $source ne $dest)
 515       {
 516         $dist = sqrt( abs($node{$source}{x}-$node{$dest}{x})**2 +  abs($node{$source}{y}-$node{$dest}{y})**2 );
 517         $xdist = $node{$source}{x} - $node{$dest}{x};
 518         $ydist = $node{$source}{y} - $node{$dest}{y};
 519
 520         $angle = &acos($xdist/$dist);
 521         #$angle = atan2($ydist,$xdist);
 522         #$angle += $pi if $ydist < 0;
 523         #$dist = abs(cos($angle))*(length($node{$dest}{'label'}) * 8 + 16)/2 + abs(sin($angle))*$nodesize/2;
 524         $width = (length($node{$dest}{'label'}) * 8 + 16)/2;
 525         $height = $nodesize/2;
 526         $dist = sqrt( ($height**2 * $width**2) / ( ($height**2 * (cos($angle)**2) ) + ($width**2 * (sin($angle)**2) ) ));
 527         #$dist = $dist*40;
 528         $xmove = cos($angle)*$dist;
 529         $ymove = sin($angle)*$dist;
 530         #$ymove = -$ymove if $ydist < 0; # the part mj omitted
 531         $point[0]{x} = $xmove;
 532         $point[0]{y} = $ymove;
 533
 534         $xmove = cos($angle)*($dist+$arrowlength-3);
 535         $ymove = sin($angle)*($dist+$arrowlength-3);
 536         #$ymove = -$ymove if $ydist < 0; # the part mj omitted
 537         $point[3]{x} = $xmove;
 538         $point[3]{y} = $ymove;
 539
 540         #$angle = $angle + $arrowwidth/2;
 541         $dist = 4;
 542         $xmove = $xmove + cos($angle)*$dist;
 543         $ymove = $ymove + sin($angle)*$dist;
 544         #$ymove = -$ymove if $ydist < 0; # the part mj omitted
 545
 546         $angle = $angle + $twopi/4;
 547         $dist = $arrowwidth/2;
 548         $xmove = $xmove + cos($angle)*$dist;
 549         $ymove = $ymove + sin($angle)*$dist;
 550         #$ymove = -$ymove if $ydist < 0; # the part mj omitted
 551         $point[1]{x} = $xmove;
 552         $point[1]{y} = $ymove;
 553
 554         $angle = $angle + $twopi/2;
 555         $dist = $arrowwidth;
 556         $xmove = $xmove + cos($angle)*$dist;
 557         $ymove = $ymove + sin($angle)*$dist;
 558         #$ymove = -$ymove if $ydist < 0; # the part mj omitted
 559         $point[2]{x} = $xmove;
 560         $point[2]{y} = $ymove;
 561
 562         for $num (0 .. 3)
 563         {
 564           $point[$num]{y} = - $point[$num]{y} if $ydist < 0;
 565         }
 566
 567         $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);
 568         $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);
 569         $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);
 570 #        $xmove = int($node{$dest}{x}+$point[3]{x});
 571 #        $ymove = int($node{$dest}{y}+$point[3]{y});
 572 #        $im->fillToBorder($xmove,$ymove,$linecol,$powderblue);
 573         #$im->fillToBorder($node{$dest}{x}+$point[3]{x},$node{$dest}{y}+$point[3]{y},$linecol,$linecol);
 574         #$im->line($point[1]{x},$point[1]{y},$point[2]{x},$point[2]{y},$linecol);
 575         #$im->line($point[2]{x},$point[2]{y},$point[0]{x},$point[0]{y},$linecol);
 576         #$im->fillToBorder($point[3]{x},$point[3]{y},$linecol,$linecol);
 577         #$im->arc($point[3]{x},$point[3]{y},10,10,0,360,$black);
 578
 579 #        $im->arc($point[0]{x},$point[0]{y},20,20,0,360,$black);
 580 #        $im->arc($point[1]{x},$point[1]{y},20,20,0,360,$black);
 581 #        $im->arc($point[2]{x},$point[2]{y},20,20,0,360,$black);
 582         #$im->arc($node{$dest}{x}+$xmove,$node{$dest}{y}+$ymove,20,20,0,360,$black);
 583       }
 584     }
 585   }
 586   for $source (@nodelist)
 587   {
 588     for $dest (@nodelist)
 589     {
 590       if ($link{$source}{$dest})
 591       {
 592         $im->line($node{$source}{x},$node{$source}{y},$node{$dest}{x},$node{$dest}{y},$linecol);
 593       }
 594     }
 595   }
 596
 597   for $source (@nodelist)
 598   {
 599     $im->arc($node{$source}{x},$node{$source}{y},(length($node{$source}{'label'}) * 8 + 16),$nodesize,0,360,$black);
 600     #$im->arc($node{$source}{x},$node{$source}{y},$nodesize,$nodesize,0,360,$black);
 601     if (defined $node{$source}{r} and defined $node{$source}{g} and defined $node{$source}{b})
 602     {
 603       $color = $im->colorResolve($node{$source}{r},$node{$source}{g},$node{$source}{b});
 604     } else
 605     {
 606       $color = $bgcol;
 607     }
 608     $im->fillToBorder($node{$source}{x},$node{$source}{y},$black,$color);
 609   }
 610   for $source (@nodelist)
 611   {
 612     $im->string(gdLargeFont,$node{$source}{x} - (length($node{$source}{'label'}) * 8 / 2) ,$node{$source}{y}-8,$node{$source}{'label'},$black);
 613   }
 614
 615
 616   binmode STDOUT;
 617   print $im->png;
 618 }
 619
 620 sub drawpov
 621 {
 622   print'// Generated by springgraph, by Darxus@ChaosReigns.com:
 623 // http://www.ChaosReigns.com/code/springgraph/
 624
 625 #include "colors.inc"
 626 #include "shapes.inc"
 627 #include "textures.inc"
 628 #include "glass.inc"
 629 #include "stones.inc"
 630 light_source {<0, 400, -500> color White rotate <0, 360*clock, 0>}
 631 light_source {<400, 0, -500> color White rotate <0, 360*clock, 0>}
 632 ';
 633
 634   for $source (@nodelist)
 635   {
 636     $node{$source}{x} = $node{$source}{x} * $scale;
 637     $node{$source}{y} = $node{$source}{y} * $scale;
 638     $node{$source}{z} = $node{$source}{z} * $scale;
 639     $node{$source}{r} = $node{$source}{r} / 256;
 640     $node{$source}{g} = $node{$source}{g} / 256;
 641     $node{$source}{b} = $node{$source}{b} / 256;
 642   }
 643   for $source (@nodelist)
 644   {
 645     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";
 646     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";
 647     #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";
 648     for $dest (@nodelist)
 649     {
 650       if ($link{$source}{$dest})
 651       {
 652         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";
 653       }
 654     }
 655   }
 656   print 'camera {
 657    location  <0, 0, -500>
 658    up        <0.0,  1.0,  0>
 659    right     <4/3,  0.0,  0>
 660    look_at   <0,    0,   -1>
 661    rotate <0, 360*clock, 0>
 662 }
 663 ';
 664
 665 }
 666
 667
 668 sub drawvrml
 669 {
 670   my ($t,$r,$length,$color);
 671   print'#VRML V2.0 utf8
 672
 673 WorldInfo {
 674   info ["Generated by springgraph, by Darxus@ChaosReigns.com: http://www.ChaosReigns.com/code/springgraph/"]
 675 }
 676
 677 ';
 678
 679   for $source (@nodelist)
 680   {
 681     $node{$source}{x} = $node{$source}{x} * $scale;
 682     $node{$source}{y} = $node{$source}{y} * $scale;
 683     $node{$source}{z} = $node{$source}{z} * $scale;
 684     for $color ('r', 'g', 'b')
 685     {
 686       if (defined $node{$source}{$color})
 687       {
 688         $node{$source}{$color} = $node{$source}{$color} / 256;
 689       }
 690     }
 691   }
 692   for $source (@nodelist)
 693   {
 694 print "
 695 Transform {
 696   translation $node{$source}{x} $node{$source}{y} $node{$source}{z}
 697   children [
 698     Shape{
 699         appearance Appearance {
 700            material Material {
 701               diffuseColor $node{$source}{r} $node{$source}{g} $node{$source}{b}
 702            }
 703         }
 704         geometry Sphere{radius 15}
 705     }
 706   ]
 707 }
 708 ";
 709
 710     #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";
 711     #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";
 712     #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";
 713     for $dest (@nodelist)
 714     {
 715       if ($link{$source}{$dest})
 716       {
 717         ($t,$r,$length) = &cylinder($node{$source}{x},$node{$source}{y},$node{$source}{z},$node{$dest}{x},$node{$dest}{y},$node{$dest}{z});
 718         print "
 719 Transform {
 720   translation $t
 721   rotation $r
 722   children [
 723     Shape{
 724         appearance Appearance {
 725            material Material {
 726               diffuseColor 0.5 0.5 0.5
 727            }
 728         }
 729         geometry Cylinder {
 730           radius 0.5
 731           height $length
 732           top FALSE
 733           bottom FALSE
 734         }
 735     }
 736   ]
 737 }
 738 ";
 739
 740
 741
 742       }
 743     }
 744   }
 745 #  print 'camera {
 746 #   location  <0, 0, -500>
 747 #   up        <0.0,  1.0,  0>
 748 #   right     <4/3,  0.0,  0>
 749 #   look_at   <0,    0,   -1>
 750 #   rotate <0, 360*clock, 0>
 751 #}
 752 #';
 753
 754 }
 755
 756
 757
 758
 759 sub hsv2rgb
 760 {
 761 #from http://faqchest.dynhost.com/prgm/perlu-l/perl-01/perl-0101/perl-010100/perl01010410_17820.html
 762
 763 # Given an h/s/v array, return an r/g/b array.
 764 # The r/g/b values will each be between 0 and 255.
 765 # The h value will be between 0 and 360, and
 766 # the s and v values will be between 0 and 1.
 767 #
 768
 769                       my $h = shift;
 770                       my $s = shift;
 771                       my $v = shift;
 772
 773                       # limit this to h values between 0 and 360 and s/v values
 774                       # between 0 and 1
 775
 776                       unless (defined($h) && defined($s) && defined($v) &&
 777                              $h >= 0 && $s >= 0 && $v >= 0 &&
 778                              $h <= 360 && $s <= 1 && $v <= 1) {
 779                         return (undef, undef, undef);
 780                       }
 781
 782                       my $r;
 783                       my $g;
 784                       my $b;
 785
 786                       # 0.003 is less than 1/255; use this to make the floating point
 787                       # approximation of zero, since the resulting rgb values will
 788                       # normally be used as integers between 0 and 255.  Feel free to
 789                       # change this approximation of zero to something else, if this
 790                       # suits you.
 791                       if ($s < 0.003) {
 792                         $r = $g = $b = $v;
 793                       }
 794                       else {
 795
 796                         $h /= 60;
 797                         my $sector = int($h);
 798                         my $fraction = $h - $sector;
 799
 800                         my $p = $v * (1 - $s);
 801                         my $q = $v * (1 - ($s * $fraction));
 802                         my $t = $v * (1 - ($s * (1 - $fraction)));
 803
 804                         if ($sector == 0) {
 805                           $r = $v;
 806                           $g = $t;
 807                           $b = $p;
 808                         }
 809                         elsif ($sector == 1) {
 810                           $r = $q;
 811                           $g = $v;
 812                           $b = $p;
 813                         }
 814                         elsif ($sector == 2) {
 815                           $r = $p;
 816                           $g = $v;
 817                           $b = $t;
 818                         }
 819                         elsif ($sector == 3) {
 820                           $r = $p;
 821                           $g = $q;
 822                           $b = $v;
 823                         }
 824                         elsif ($sector == 4) {
 825                           $r = $t;
 826                           $g = $p;
 827                           $b = $v;
 828                         }
 829                         else {
 830                           $r = $v;
 831                           $g = $p;
 832                           $b = $q;
 833                         }
 834                       }
 835
 836                       # Convert the r/g/b values to all be between 0 and 255; use the
 837                       # ol' 0.003 approximation again, with the same comment as above.
 838
 839                       $r = ($r < 0.003 ? 0.0 : $r * 255);
 840                       $g = ($g < 0.003 ? 0.0 : $g * 255);
 841                       $b = ($b < 0.003 ? 0.0 : $b * 255);
 842
 843                       return ($r, $g, $b);
 844                     }
 845
 846 # from perlfunc(1)
 847 sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }
 848
 849
 850 sub cylinder {
 851     my ($x1,$y1,$z1,$x2,$y2,$z2) = @_;
 852     my ($t, $r, $length, $rx, $ry, $rz, $dist);
 853
 854     $x1 = 0 unless $x1;
 855     $x2 = 0 unless $x2;
 856     $y1 = 0 unless $y1;
 857     $y2 = 0 unless $y2;
 858     $z1 = 0 unless $z1;
 859     $z2 = 0 unless $z2;
 860     my $dx=$x1-$x2;
 861     my $dy=$y1-$y2;
 862     my $dz=$z1-$z2;
 863     if (1) {
 864         unless (0) {
 865             $length = sqrt($dx*$dx + $dy*$dy + $dz*$dz);
 866             $rx = $dx;
 867             $ry = ($dy+$length);
 868             $rz = $dz;
 869             $dist = sqrt(abs($rx)**2 + abs($ry)**2);
 870             $dist = sqrt(abs($rz)**2 + abs($dist)**2);
 871             $rx = $rx / $dist;
 872             $ry = $ry / $dist;
 873             $rz = $rz / $dist;
 874             $t = ($x1-($dx/2))." ".($y1-($dy/2))." ".($z1-($dz/2));
 875             $r = "$rx $ry $rz $pi";
 876         }
 877     }
 878     return ($t,$r,$length);
 879 }
 880
 881 sub usage {
 882 print <<END
 883 springgraph - Render a .dot file into a graphic
 884
 885 Usage: springgraph [-p] [-v] [-s scale] [-t] [-b color] [-l color] [-h]
 886
 887    -p   Create a file that can be rendered with POV-Ray
 888    -v   Create a VRML file
 889    -s   This option specifies the scale. All of the node locations
 890         are multiplied by this. Increase the scale to eliminate node
 891         overlaps. Decrease the scale to make the graph smaller.
 892    -t   Make the background of the resulting image transpaent.
 893    -b   set background color of image, specify it in the form RRGGBB,
 894         in hex digits, e.g. FFFFFF is white, 000000 is black, FF0000
 895         is red, ...
 896    -l   set the line color, same format as the background color
 897    -h   show this help
 898
 899 END
 900 }