#!/usr/bin/perl -w
# springgraph v0.79, (c) 2002 Darxus@ChaosReigns.com, released under the GPL
# Download current version from: http://www.chaosreigns.com/code/springgraph/
#
# This program attempts to render .dot files in a fashion similar to neato,
# which is part of graphviz: http://www.research.att.com/sw/tools/graphviz/.
# I have never looked at any of the code in graphviz.
#
# Example usage:
#
# cat test.dot | ./springgraph.pl -s 3 > springgraph.png
#
# The "-s 3" specifies the scale, and is optional. All of the node
# locations are multiplied by this. Increase the scale to eliminate
# node overlaps. Decrease the scale to make the graph smaller.
#
# Requirements: GD.pm (http://www.perl.com/CPAN/authors/id/L/LD/LDS/)
#
# Definition of the .dot files which springgraph renders
# can be found in the graphviz man pages. A copy is here:
# http://www.unisa.edu.au/eie/csec/graphviz/dot.1.html. Springgraph only
# supports the fillcolor and label node attributes, and can only handle
# two nodes per edge definition ("node1 -> node2", not "node1 -> node2
# -> node3").
#
# Springgraph fully supports the .dot files generated by sig2dot
# (http://www.chaosreigns.com/code/sig2dot), which generates .dot files
# from GPG/PGP signature relationships.
#
# Thanks to the following for help with the math for the arrowheads:
# Mike Joseph <mj@doze.net>
# Walt Mankowski <waltman@pobox.com>
# Jeff Weisberg <jaw+plug@tcp4me.com>
#
# Yes, the placement of the freaking arrowheads was by far the hardest
# part of writing this program.
#
# Thanks to Hartmut Palm for cylinder translation/rotation code in
# VRML.pm: http://dc.gfz-potsdam.de/~palm/vrmlperl/
# v0.26 May 06 16:12:30 2002
# v0.27 May 06 18:15:38 2002 cleanup
# v0.44 May 06 23:56:45 2002
# v0.56 May 07 05:10:02 2002
# v0.60 May 07 23:27:29 2002 arrow heads !! (not filled in due to segfault)
# v0.61 May 07 2002 handle absence of beginning double-quote in fillcolor attribute
# v0.62 May 08 19:44:04 2002 use getopts to get scale argument
# v0.63 May 08 21:29:48 2002 made fillcolor optional again
# v0.64 May 08 22:28:40 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/ER.dot.txt
# and http://www.research.att.com/sw/tools/graphviz/examples/undirected/process.dot.txt
# (added support for undirected graphs ("--" links)
# v0.65 May 08 22:44:00 2002 render http://www.research.att.com/sw/tools/graphviz/examples/directed/fsm.dot.txt
# (do not attempt to draw a line from a node to itself and cause a devision by zero)
# v0.67 May 09 05:53:16 2002 support multiple nodes on one link line, adjusted detection of completion
# render http://www.research.att.com/sw/tools/graphviz/examples/directed/unix.dot.txt
# (support node names containing spaces)
# v0.68 May 09 17:29:06 2002 cleaned up link line processing a bit (removed extraneous define checks)
# v0.69 May 09 18:23:19 2002 render http://www.research.att.com/sw/tools/graphviz/examples/undirected/inet.dot.txt
# (support {} lists in link (edge) lines)
# v0.70 May 10 00:39:20 2002 Strip double-quotes that were getting missed to support sig2dot v0.27.
# v0.71 May 11 20:06:17 2002 don't draw twice, added some 3D math (but not output yet)
# v0.72 May 11 21:31:20 2002 3D output !!! (via -p flag)
# v0.73 May 11 22:34:23 2002 added labels to 3D output
# v0.74 May 12 02:07:29 2002 output 3D output suitable for animation
# v0.75 May 13 01:45:41 2002 beginnings of vrml output (-v) - colored spheres
# v0.76 May 13 04:30:13 2002 added connections between nodes to vrml
# output, thanks cylinder translation/rotation
# code from VRML.pm by Hartmut Palm:
# http://dc.gfz-potsdam.de/~palm/vrmlperl/
# v0.77 May 13 04:41:53 2002 made colors optional in pov and vrml output
# v0.78 May 13 06:31:34 2002 removed extra cylinders from vrml output
# v0.79 May 13 07:20:23 2002 made 2d output background transparent
# v0.80 Mar 19 2003 optimization patch from Marco Bodrato
# v0.81 Aug 20 2003 Caption stderr progress notes
# v0.87 Oct 13 2004 only graph the largest cluster - Darxus
# v0.88 Nov 22 21:27:21 2005 applied clustering fix patch from David Crisinel
#
# TODO
# * inverse exponential movement
# * specification of output pixelcount
# * ljmindmap style averaged random colors (cluster colorization)
use GD;
use Getopt::Std;
use strict;
use vars qw(
$push
$pull
%node
$im
$source
$dest
$nodenum
$blue
$black
$opt_b
$bgcol
@bgcolor
$dist
$iter
$maxiter
$percent
$xdist
$ydist
$newdist2
$xmove
$ymove
$movecount
$rate
$nodes
%link
$continue
$done
$line
@nodelist
%saw
$name
$label
$margin
$minx
$miny
$maxx
$maxy
$scale
$nodesize
$powderblue
$linecol
$h
$s
$v
$r
$g
$b
$color
$maxxlength
$minxlength
$pi
$twopi
$angle
@point
$width
$height
$arrowlength
$arrowwidth
$num
$opt_s
$edge
@parts
$part
@sources
@dests
$sourcesstring
$destsstring
$pov
$opt_p
$zdist
$zmove
$pov_or_vrml
$opt_v
$vrml
$opt_t
$trans
$opt_h
$opt_l
@linecolor
%cluster
%nodecount
$largestcluster
$largestclusterval
%rank
);
$push = 2000;
$pull = .1;
$maxiter = 400;
#$maxiter = 60;
$rate = 2;
$nodes = 5;
#$done = 0.1;
$done = 0.3;
#$done = 3;
$margin = 20;
#$nodesize = 80;
$nodesize = 40;
$arrowlength = 10; # pixels
$arrowwidth = 10;
srand 1; #comment out this line to generate graphs differently every time
$pi = 3.141592653589793238462643383279502884197169399375105; # from memory
$twopi = $pi * 2;
getopts('s:pvhtb:l:');
# -s: set scale
if ($opt_s)
{
$scale = $opt_s;
} else {
$scale = 1;
}
# -p: Output as Pov-Ray
if ($opt_p)
{
$pov = 1;
} else {
$pov = 0;
}
# -v: Output as VRML
if ($opt_v)
{
$vrml = 1;
} else {
$vrml = 0;
}
# -h: Show some help
if ($opt_h) {
usage();
exit 1;
}
# -t: Make background transparent
if ($opt_t)
{
$trans = 1;
} else {
$trans = 0;
}
# -b: Set background color
if ($opt_b)
{
$trans = 0;
$opt_b =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_b";
@bgcolor = (hex($1), hex($2), hex($3));
} else {
@bgcolor = (255, 255, 255);
}
# -l: Set line color
if ($opt_l)
{
$trans = 0;
$opt_l =~ m/^(..)(..)(..)$/ or die "Invalid color: $opt_l";
@linecolor = (hex($1), hex($2), hex($3));
} else {
@linecolor = (169, 169, 169);
}
$done = $done / $scale;
while ($line = <STDIN>)
{
undef $name;
next if ($line =~ m#^//#);
chomp $line;
# 2 = arro1, 1 = no arrow
if ($line =~ m#^(.*-[>-][^\[]*)#)
{
$edge = $1;
@parts = split(/(-[->])/,$edge);
for $part (0 .. $#parts)
{
if (defined $parts[$part+2] and $parts[$part] ne '->' and $parts[$part] ne '--')
{
#print ":$parts[$part]:".$parts[$part+1].":".$parts[$part+2].":\n";
undef @sources;
undef @dests;
$parts[$part] =~ s/^\s*"?//;
$parts[$part] =~ s/"?\s*$//;
$parts[$part+2] =~ s/^\s*"?//;
$parts[$part+2] =~ s/"?\s*;?\s*$//;
if ($parts[$part] =~ m#^{(.*)}$#)
{
$sourcesstring = $1;
#print STDERR "sourcesstring:$sourcesstring:\n";
@sources = split(/[\s*;?\s*]/,$sourcesstring);
} else {
$sources[0] = $parts[$part];
}
if ($parts[$part+2] =~ m#^{(.*)}$#)
{
$destsstring = $1;
#print STDERR "destsstring:$destsstring:\n";
@dests = split(/[\s*;?\s*]/,$destsstring);
} else {
$dests[0] = $parts[$part+2];
}
for $source (@sources)
{
next if ($source eq "");
for $dest (@dests)
{
next if ($dest eq "");
$source =~ s/^\s*"?//;
$source =~ s/"?\s*$//;
$dest =~ s/^\s*"?//;
$dest =~ s/"?\s*;?\s*$//;
if ($parts[$part+1] eq '->') {
$link{$source}{$dest} = 2;
$rank{$dest}++;
}
$link{$source}{$dest} = 1 if ($parts[$part+1] eq '--');
push (@nodelist,$source,$dest);
#print STDERR "$source ".$parts[$part+1]." $dest\n";
}
}
}
}
# $source = $1;
# $dest = $2;
# $source =~ s/^\W*//;
# $source =~ s/\W*$//;
# $dest =~ s/^\W*//;
# $dest =~ s/\W*$//;
# $link{$source}{$dest} = 2;
# push (@nodelist,$source,$dest);
# print STDERR "source:$source:dest:$dest:\n";
} else {
# if ($line =~ m#^edge# or $line =~ m#^node#)
# {
# print STDERR "Skipping: $line\n";
# next;
# }
if ($line =~ m#^(\S+).*\[.*\]#)
{
$name = $1;
$name =~ tr/"//d;
if ($name eq 'node' or $name eq 'edge')
{
next;
}
#print STDERR "name:$name:\n";
}
if ($line =~ m#\[.*label=([^,\]]*).*\]#)
{
$label = $1;
$label =~ tr/"//d;
$node{$name}{'label'} = $label;
#print STDERR "label:$label:\n";
}
if ($line =~ m#\[.*fillcolor="?([\d\.]+),([\d\.]+),([\d\.]+).*\]#)
{
$h = $1;
$s = $2;
$v = $3;
#print STDERR "hsv:$h:$s:$v:\n";
$h = $h * 360;
($r,$g,$b) = &hsv2rgb($h,$s,$v);
$node{$name}{r} = $r;
$node{$name}{g} = $g;
$node{$name}{b} = $b;
#print STDERR "rgb:$r:$g:$b:\n";
}
}
}
print STDERR "Number of edges for which this node is the destination:\n";
for my $node (sort {$rank{$b} <=> $rank{$a}} keys %rank) {
print STDERR "$rank{$node} $node\n";
}
print STDERR "\n";
#$link{$source}{$dest}
my $maxcluster = 0;
for my $source (keys %link) {
for my $dest (keys %{$link{$source}}) {
if (!defined $cluster{$source} and !defined $cluster{$dest}) {
$maxcluster++;
$cluster{$source} = $maxcluster;
$cluster{$dest} = $maxcluster;
} elsif (defined $cluster{$source} and !defined $cluster{$dest}) {
$cluster{$dest} = $cluster{$source};
} elsif (defined $cluster{$dest} and !defined $cluster{$source}) {
$cluster{$source} = $cluster{$dest};
} elsif (defined $cluster{$source} and defined $cluster{$dest}) {
# for my $node (keys %cluster) {
# if ($cluster{$node} == $cluster{$dest}) {
# $cluster{$node} = $cluster{$source}
# }
# }
for my $node (keys %cluster) {
if ($cluster{$node} == $cluster{$source}) {
$cluster{$node} = $cluster{$dest}
}
}
}
}
}
for my $node (keys %cluster) {
$nodecount{$cluster{$node}}++;
}
print STDERR scalar(keys %nodecount) . " clusters:\n";
$largestclusterval = 0;
for my $cluster (keys %nodecount) {
if ($nodecount{$cluster} > $largestclusterval) {
$largestcluster = $cluster;
$largestclusterval = $nodecount{$cluster};
}
# print STDERR "largestcluster:$largestcluster,largestclusterval:$largestclusterval,cluster:$cluster,nodecount-cluster:$nodecount{$cluster}\n";
}
for my $cluster (sort keys %nodecount) {
print STDERR "Cluster $cluster, $nodecount{$cluster} nodes:\n";
for my $node (sort keys %cluster) {
print STDERR "$node " if $cluster{$node} == $cluster;
}
print STDERR "\n";
}
#for $source (keys %link) {
# for $dest (keys %{$link{$source}}) {
# unless ($cluster{$source} == $largestcluster and $cluster{$dest} == $largestcluster) {
# delete $link{$source}{$dest};
## print STDERR "deleting $source - $dest\n";
# }
# }
#}
undef @nodelist;
print STDERR "Done clustering.\n";
for my $node (keys %cluster) {
if ($cluster{$node} == $largestcluster) {
push @nodelist, $node;
}
}
#undef %saw;
#@saw{@nodelist} = ();
#@nodelist = sort keys %saw; # remove sort if undesired
#undef %saw;
if ($pov or $vrml) {
$pov_or_vrml = 1;
} else {
$pov_or_vrml = 0;
}
for $nodenum (@nodelist)
{
$node{$nodenum}{x}=rand;# $maxx;
$node{$nodenum}{y}=rand;# $maxy;
$node{$nodenum}{z}=rand if $pov_or_vrml;
unless(defined $node{$nodenum}{'label'})
{
$node{$nodenum}{'label'} = $nodenum;
}
}
print STDERR "springgraph iterating until reaches $done\n\n";
#&draw;
$continue = 1;
$iter = 0;
while($continue > $done and $iter <= $maxiter)
{
$continue = $done;
$iter++;
for $nodenum (@nodelist)
{
$node{$nodenum}{oldx} = $node{$nodenum}{x};
$node{$nodenum}{oldy} = $node{$nodenum}{y};
$node{$nodenum}{oldz} = $node{$nodenum}{z} if $pov_or_vrml;
$xmove = 0;
$ymove = 0;
}
for $source (@nodelist)
{
$movecount = 0;
for $dest (@nodelist)
{
next if ($source eq $dest);
$xdist = $node{$source}{oldx} - $node{$dest}{oldx};
$ydist = $node{$source}{oldy} - $node{$dest}{oldy};
$dist = $xdist*$xdist + $ydist*$ydist;
if ($pov_or_vrml)
{
$zdist = $node{$source}{oldz} - $node{$dest}{oldz};
$dist += $zdist*$zdist;
}
# $distance = sqrt($dist);
$percent = $push / $dist;
if ($link{$source}{$dest})
{
$percent -= $pull;
}
if ($link{$dest}{$source})
{
$percent -= $pull;
}
$percent *= $rate;
$xmove -= $xdist * $percent;
$ymove -= $ydist * $percent;
$zmove -= $zdist * $percent if $pov_or_vrml;
$movecount++;
# $pullmove = $pull * $dist;
# $pushmove = $push / $dist;
# print STDERR "dist: $dist, pull: $pullmove, push: $pushmove\n";
# print STDERR "$source to ${dest}, Dist: $dist Want: $wantdist (${percent}x)\n";
# print STDERR "is: $node[$source]{oldx} $node[$source]{oldy} $xdist $ydist, want: $wantxdist $wantydist ($newdist2)\n";
}
$xmove = $xmove / $movecount;
$ymove = $ymove / $movecount;
$zmove = $zmove / $movecount if $pov_or_vrml;
$node{$source}{x} -= $xmove;
$node{$source}{y} -= $ymove;
$node{$source}{z} -= $zmove if $pov_or_vrml;
if ($xmove > $continue)
{
$continue = $xmove;
}
if ($ymove > $continue)
{
$continue = $ymove;
}
if (($pov_or_vrml) and $zmove > $continue)
{
$continue = $zmove;
}
}
#print STDERR "$iter\n";
if (0)
{
&draw;
open (XV,"| xv -wait 1 -");
#open (XV,"| xloadimage -delay 1 stdin");
binmode XV;
print XV $im->png;
close XV;
}
if ($iter % 20 == 0)
{
print STDERR "$continue\n";
}
}
print STDERR "Iterations: $iter\n";
for $source (@nodelist)
{
for $color ('r', 'g', 'b')
{
$node{$source}{$color} = 255 unless (defined $node{$source}{$color});
}
}
if ($pov)
{
&drawpov;
} elsif ($vrml) {
&drawvrml;
} else {
&draw;
}
undef $maxx;
undef $maxy;
sub draw
{
for $nodenum (@nodelist)
{
if (!(defined $maxx) or (($node{$nodenum}{x} + (length($node{$nodenum}{'label'}) * 8 + 16)/2) > $maxx + (length($node{$nodenum}{'label'}) * 8 + 16)/2))
{
$maxx = $node{$nodenum}{x};# + (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
$maxxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
}
if (!(defined $minx) or (($node{$nodenum}{x} - (length($node{$nodenum}{'label'}) * 8 + 16)/2) < $minx - (length($node{$nodenum}{'label'}) * 8 + 16)/2))
{
$minx = $node{$nodenum}{x};# - (length($node{$nodenum}{'label'}) * 8 + 16)/2/2
$minxlength = (length($node{$nodenum}{'label'}) * 8 + 16)/2;
}
$maxy = $node{$nodenum}{y} if (!(defined $maxy) or $node{$nodenum}{y} > $maxy);
$miny = $node{$nodenum}{y} if (!(defined $miny) or $node{$nodenum}{y} < $miny);
}
for $nodenum (@nodelist)
{
#$node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $margin;
$node{$nodenum}{x} = ($node{$nodenum}{x} - $minx) * $scale + $minxlength -1 ;# + $margin;
$node{$nodenum}{y} = ($node{$nodenum}{y} - $miny) * $scale + $nodesize/2 - 1;
}
$maxx = ($maxx - $minx) * $scale + $minxlength + $maxxlength;# + $margin*2;
$maxy = ($maxy - $miny) * $scale + $nodesize/2*2;
$im = new GD::Image($maxx,$maxy);
$bgcol = $im->colorAllocate(@bgcolor);
$im->transparent($bgcol) if $trans; # make transparent
$blue = $im->colorAllocate(0,0,255);
$powderblue = $im->colorAllocate(176,224,230);
$black = $im->colorAllocate(0,0,0);
$linecol = $im->colorAllocate(@linecolor);
for $source (@nodelist)
{
#print STDERR "node: $source $node[$source]{x},$node[$source]{y}\n";
for $dest (@nodelist)
{
if (defined $link{$source}{$dest} and $link{$source}{$dest} == 2 and $source ne $dest)
{
$dist = sqrt( abs($node{$source}{x}-$node{$dest}{x})**2 + abs($node{$source}{y}-$node{$dest}{y})**2 );
$xdist = $node{$source}{x} - $node{$dest}{x};
$ydist = $node{$source}{y} - $node{$dest}{y};
$angle = &acos($xdist/$dist);
#$angle = atan2($ydist,$xdist);
#$angle += $pi if $ydist < 0;
#$dist = abs(cos($angle))*(length($node{$dest}{'label'}) * 8 + 16)/2 + abs(sin($angle))*$nodesize/2;
$width = (length($node{$dest}{'label'}) * 8 + 16)/2;
$height = $nodesize/2;
$dist = sqrt( ($height**2 * $width**2) / ( ($height**2 * (cos($angle)**2) ) + ($width**2 * (sin($angle)**2) ) ));
#$dist = $dist*40;
$xmove = cos($angle)*$dist;
$ymove = sin($angle)*$dist;
#$ymove = -$ymove if $ydist < 0; # the part mj omitted
$point[0]{x} = $xmove;
$point[0]{y} = $ymove;
$xmove = cos($angle)*($dist+$arrowlength-3);
$ymove = sin($angle)*($dist+$arrowlength-3);
#$ymove = -$ymove if $ydist < 0; # the part mj omitted
$point[3]{x} = $xmove;
$point[3]{y} = $ymove;
#$angle = $angle + $arrowwidth/2;
$dist = 4;
$xmove = $xmove + cos($angle)*$dist;
$ymove = $ymove + sin($angle)*$dist;
#$ymove = -$ymove if $ydist < 0; # the part mj omitted
$angle = $angle + $twopi/4;
$dist = $arrowwidth/2;
$xmove = $xmove + cos($angle)*$dist;
$ymove = $ymove + sin($angle)*$dist;
#$ymove = -$ymove if $ydist < 0; # the part mj omitted
$point[1]{x} = $xmove;
$point[1]{y} = $ymove;
$angle = $angle + $twopi/2;
$dist = $arrowwidth;
$xmove = $xmove + cos($angle)*$dist;
$ymove = $ymove + sin($angle)*$dist;
#$ymove = -$ymove if $ydist < 0; # the part mj omitted
$point[2]{x} = $xmove;
$point[2]{y} = $ymove;
for $num (0 .. 3)
{
$point[$num]{y} = - $point[$num]{y} if $ydist < 0;
}
$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);
$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);
$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);
# $xmove = int($node{$dest}{x}+$point[3]{x});
# $ymove = int($node{$dest}{y}+$point[3]{y});
# $im->fillToBorder($xmove,$ymove,$linecol,$powderblue);
#$im->fillToBorder($node{$dest}{x}+$point[3]{x},$node{$dest}{y}+$point[3]{y},$linecol,$linecol);
#$im->line($point[1]{x},$point[1]{y},$point[2]{x},$point[2]{y},$linecol);
#$im->line($point[2]{x},$point[2]{y},$point[0]{x},$point[0]{y},$linecol);
#$im->fillToBorder($point[3]{x},$point[3]{y},$linecol,$linecol);
#$im->arc($point[3]{x},$point[3]{y},10,10,0,360,$black);
# $im->arc($point[0]{x},$point[0]{y},20,20,0,360,$black);
# $im->arc($point[1]{x},$point[1]{y},20,20,0,360,$black);
# $im->arc($point[2]{x},$point[2]{y},20,20,0,360,$black);
#$im->arc($node{$dest}{x}+$xmove,$node{$dest}{y}+$ymove,20,20,0,360,$black);
}
}
}
for $source (@nodelist)
{
for $dest (@nodelist)
{
if ($link{$source}{$dest})
{
$im->line($node{$source}{x},$node{$source}{y},$node{$dest}{x},$node{$dest}{y},$linecol);
}
}
}
for $source (@nodelist)
{
$im->arc($node{$source}{x},$node{$source}{y},(length($node{$source}{'label'}) * 8 + 16),$nodesize,0,360,$black);
#$im->arc($node{$source}{x},$node{$source}{y},$nodesize,$nodesize,0,360,$black);
if (defined $node{$source}{r} and defined $node{$source}{g} and defined $node{$source}{b})
{
$color = $im->colorResolve($node{$source}{r},$node{$source}{g},$node{$source}{b});
} else
{
$color = $bgcol;
}
$im->fillToBorder($node{$source}{x},$node{$source}{y},$black,$color);
}
for $source (@nodelist)
{
$im->string(gdLargeFont,$node{$source}{x} - (length($node{$source}{'label'}) * 8 / 2) ,$node{$source}{y}-8,$node{$source}{'label'},$black);
}
binmode STDOUT;
print $im->png;
}
sub drawpov
{
print'// Generated by springgraph, by Darxus@ChaosReigns.com:
// http://www.ChaosReigns.com/code/springgraph/
#include "colors.inc"
#include "shapes.inc"
#include "textures.inc"
#include "glass.inc"
#include "stones.inc"
light_source {<0, 400, -500> color White rotate <0, 360*clock, 0>}
light_source {<400, 0, -500> color White rotate <0, 360*clock, 0>}
';
for $source (@nodelist)
{
$node{$source}{x} = $node{$source}{x} * $scale;
$node{$source}{y} = $node{$source}{y} * $scale;
$node{$source}{z} = $node{$source}{z} * $scale;
$node{$source}{r} = $node{$source}{r} / 256;
$node{$source}{g} = $node{$source}{g} / 256;
$node{$source}{b} = $node{$source}{b} / 256;
}
for $source (@nodelist)
{
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";
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";
#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";
for $dest (@nodelist)
{
if ($link{$source}{$dest})
{
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";
}
}
}
print 'camera {
location <0, 0, -500>
up <0.0, 1.0, 0>
right <4/3, 0.0, 0>
look_at <0, 0, -1>
rotate <0, 360*clock, 0>
}
';
}
sub drawvrml
{
my ($t,$r,$length,$color);
print'#VRML V2.0 utf8
WorldInfo {
info ["Generated by springgraph, by Darxus@ChaosReigns.com: http://www.ChaosReigns.com/code/springgraph/"]
}
';
for $source (@nodelist)
{
$node{$source}{x} = $node{$source}{x} * $scale;
$node{$source}{y} = $node{$source}{y} * $scale;
$node{$source}{z} = $node{$source}{z} * $scale;
for $color ('r', 'g', 'b')
{
if (defined $node{$source}{$color})
{
$node{$source}{$color} = $node{$source}{$color} / 256;
}
}
}
for $source (@nodelist)
{
print "
Transform {
translation $node{$source}{x} $node{$source}{y} $node{$source}{z}
children [
Shape{
appearance Appearance {
material Material {
diffuseColor $node{$source}{r} $node{$source}{g} $node{$source}{b}
}
}
geometry Sphere{radius 15}
}
]
}
";
#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";
#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";
#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";
for $dest (@nodelist)
{
if ($link{$source}{$dest})
{
($t,$r,$length) = &cylinder($node{$source}{x},$node{$source}{y},$node{$source}{z},$node{$dest}{x},$node{$dest}{y},$node{$dest}{z});
print "
Transform {
translation $t
rotation $r
children [
Shape{
appearance Appearance {
material Material {
diffuseColor 0.5 0.5 0.5
}
}
geometry Cylinder {
radius 0.5
height $length
top FALSE
bottom FALSE
}
}
]
}
";
}
}
}
# print 'camera {
# location <0, 0, -500>
# up <0.0, 1.0, 0>
# right <4/3, 0.0, 0>
# look_at <0, 0, -1>
# rotate <0, 360*clock, 0>
#}
#';
}
sub hsv2rgb
{
#from http://faqchest.dynhost.com/prgm/perlu-l/perl-01/perl-0101/perl-010100/perl01010410_17820.html
# Given an h/s/v array, return an r/g/b array.
# The r/g/b values will each be between 0 and 255.
# The h value will be between 0 and 360, and
# the s and v values will be between 0 and 1.
#
my $h = shift;
my $s = shift;
my $v = shift;
# limit this to h values between 0 and 360 and s/v values
# between 0 and 1
unless (defined($h) && defined($s) && defined($v) &&
$h >= 0 && $s >= 0 && $v >= 0 &&
$h <= 360 && $s <= 1 && $v <= 1) {
return (undef, undef, undef);
}
my $r;
my $g;
my $b;
# 0.003 is less than 1/255; use this to make the floating point
# approximation of zero, since the resulting rgb values will
# normally be used as integers between 0 and 255. Feel free to
# change this approximation of zero to something else, if this
# suits you.
if ($s < 0.003) {
$r = $g = $b = $v;
}
else {
$h /= 60;
my $sector = int($h);
my $fraction = $h - $sector;
my $p = $v * (1 - $s);
my $q = $v * (1 - ($s * $fraction));
my $t = $v * (1 - ($s * (1 - $fraction)));
if ($sector == 0) {
$r = $v;
$g = $t;
$b = $p;
}
elsif ($sector == 1) {
$r = $q;
$g = $v;
$b = $p;
}
elsif ($sector == 2) {
$r = $p;
$g = $v;
$b = $t;
}
elsif ($sector == 3) {
$r = $p;
$g = $q;
$b = $v;
}
elsif ($sector == 4) {
$r = $t;
$g = $p;
$b = $v;
}
else {
$r = $v;
$g = $p;
$b = $q;
}
}
# Convert the r/g/b values to all be between 0 and 255; use the
# ol' 0.003 approximation again, with the same comment as above.
$r = ($r < 0.003 ? 0.0 : $r * 255);
$g = ($g < 0.003 ? 0.0 : $g * 255);
$b = ($b < 0.003 ? 0.0 : $b * 255);
return ($r, $g, $b);
}
# from perlfunc(1)
sub acos { atan2( sqrt(1 - $_[0] * $_[0]), $_[0] ) }
sub cylinder {
my ($x1,$y1,$z1,$x2,$y2,$z2) = @_;
my ($t, $r, $length, $rx, $ry, $rz, $dist);
$x1 = 0 unless $x1;
$x2 = 0 unless $x2;
$y1 = 0 unless $y1;
$y2 = 0 unless $y2;
$z1 = 0 unless $z1;
$z2 = 0 unless $z2;
my $dx=$x1-$x2;
my $dy=$y1-$y2;
my $dz=$z1-$z2;
if (1) {
unless (0) {
$length = sqrt($dx*$dx + $dy*$dy + $dz*$dz);
$rx = $dx;
$ry = ($dy+$length);
$rz = $dz;
$dist = sqrt(abs($rx)**2 + abs($ry)**2);
$dist = sqrt(abs($rz)**2 + abs($dist)**2);
$rx = $rx / $dist;
$ry = $ry / $dist;
$rz = $rz / $dist;
$t = ($x1-($dx/2))." ".($y1-($dy/2))." ".($z1-($dz/2));
$r = "$rx $ry $rz $pi";
}
}
return ($t,$r,$length);
}
sub usage {
print <<END
springgraph - Render a .dot file into a graphic
Usage: springgraph [-p] [-v] [-s scale] [-t] [-b color] [-l color] [-h]
-p Create a file that can be rendered with POV-Ray
-v Create a VRML file
-s This option specifies the scale. All of the node locations
are multiplied by this. Increase the scale to eliminate node
overlaps. Decrease the scale to make the graph smaller.
-t Make the background of the resulting image transpaent.
-b set background color of image, specify it in the form RRGGBB,
in hex digits, e.g. FFFFFF is white, 000000 is black, FF0000
is red, ...
-l set the line color, same format as the background color
-h show this help
END
}