]> git.sthu.org Git - pgp-tools.git/blob - springgraph/springgraph
4a179882ec36c2af45a3c95950325dd84140558a
[pgp-tools.git] / 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 }