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