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