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