User:JeevesMkII/radialtree.pl
From RationalWiki
#!/bin/perl -w
use strict;
use Math::Trig qw(deg2rad);
use Math::Round qw(nearest nearest_ceil nearest_floor);
use constant ABS_ARC_SPEC => "A%.2f %.2f %d %d %d %.2f %.2f\n";
use constant REL_ARC_SPEC => "a%.2f %.2f %d %d %d %.2f %.2f\n";
use constant ABS_MOVE_SPEC => "M%.2f %.2f\n";
use constant REL_MOVE_SPEC => "m%.2f %.2f\n";
use constant ABS_LINE_SPEC => "L%.2f %.2f\n";
use constant REL_LINE_SPEC => "l%.2f %.2f\n";
use constant PATH_ELEMENT_SPEC => "<path id=\"%s\" stroke=\"%s\" fill=\"%s\" stroke-width=\"%d\" d=\"\n";
use constant CLASS_SPEC => " class=\"%s\" ";
use constant CLOSE_TAG_SPEC => " />\n";
use constant TEXTPATH_ELEMENT_SPEC => "<textPath xlink:href=\"%s\" startOffset=\"%d%%\" alignment-baseline=\"%s\">\n";
use constant CLOSE_TEXTPATH_SPEC => "</textPath>\n";
use constant TEXT_ELEMENT_SPEC => "<text id=\"%s\" font-family=\"%s\" font-size=\"%d\" fill=\"%s\" text-anchor=\"%s\">\n";
use constant CLOSE_TEXT_ELEMENT => "</text>\n";
use constant GROUP_ELEMENT_SPEC => "<g id=\"%s\">\n";
use constant CLOSE_GROUP_ELEMENT => "</g>\n";
use constant XML_DOC_HEADER => "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
use constant XML_DOCTYPE_HEADER => "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\" >\n";
use constant SVG_ELEMENT_SPEC => "<svg version=\"1.1\" id=\"%s\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" width=\"%d\" height=\"%d\" overflow=\"visible\" xml:space=\"preserve\">\n";
use constant CLOSE_SVG_ELEMENT => "</svg>\n";
# prototypes for recursive subs
sub finalise_tree_stats($);
sub create_tree_node_path($$$$$$$$$$$$$);
# Trig functions
sub polar_to_svg_coordinates($$$$)
{
my ($x, $y, $radius, $angle) = @_;
my $rads = deg2rad($angle);
return ($x + nearest(.01, ($radius * cos($rads))), $y - nearest(.01, ($radius * sin($rads))));
}
sub calc_sector_path($$$$$$)
{
my ($x, $y, $from, $dtheta, $outer, $inner) = @_;
$dtheta = abs($dtheta) % 360;
my $to = $from + $dtheta;
my ($ox1, $oy1) = polar_to_svg_coordinates($x, $y, $outer, $from);
my ($ox2, $oy2) = polar_to_svg_coordinates($x, $y, $outer, $to);
my ($ix1, $iy1) = polar_to_svg_coordinates($x, $y, $inner, $to);
my ($ix2, $iy2) = polar_to_svg_coordinates($x, $y, $inner, $from);
my (%iarc, %oarc);
if ($dtheta < 180 && $dtheta != 0)
{
%oarc = create_arc_spec($ox2, $oy2, 0, 0, 0, $outer, $outer, 1);
%iarc = create_arc_spec($ix2, $iy2, 0, 0, 1, $inner, $inner, 1);
}
else
{
%oarc = create_arc_spec($ox2, $oy2, 0, 1, 0, $outer, $outer, 1);
%iarc = create_arc_spec($ix2, $iy2, 0, 1, 1, $inner, $inner, 1);
}
my %move = create_move_spec($ox1, $oy1, 1);
my %l1 = create_line_spec($ix1, $iy1, 1);
my %l2 = create_line_spec($ox1, $oy1, 1);
my @components = (\%move, \%oarc, \%l1, \%iarc, \%l2);
return (type => "path", components => \@components)
}
# SVG functions
sub print_indent($)
{
my ($depth) = @_;
if ($depth > 0)
{
printf("\t") while($depth--);
}
}
sub create_arc_spec($$$$$$$$)
{
my ($dx, $dy, $rot, $l, $s, $rx, $ry, $abs) = @_;
my %arc_spec = ( type => "arc", dx => $dx, dy => $dy, rx => $rx, ry => $ry, rotation => $rot,
large => $l, sweep => $s, absolute => $abs);
return %arc_spec;
}
sub print_arc_spec(%)
{
my (%arc_spec) = @_;
if ($arc_spec{absolute})
{
printf(ABS_ARC_SPEC, $arc_spec{rx},$arc_spec{ry}, $arc_spec{rotation},
$arc_spec{large}, $arc_spec{sweep}, $arc_spec{dx}, $arc_spec{dy});
}
else
{
printf(REL_ARC_SPEC, $arc_spec{rx},$arc_spec{ry}, $arc_spec{rotation},
$arc_spec{large}, $arc_spec{sweep}, $arc_spec{dx}, $arc_spec{dy});
}
}
sub create_move_spec($$$)
{
my ($x, $y, $abs) = @_;
my %move_spec = ( type => "move", x => $x, y => $y, absolute => $abs );
return %move_spec;
}
sub print_move_spec(%)
{
my (%move_spec) = @_;
if ($move_spec{absolute})
{
printf(ABS_MOVE_SPEC, $move_spec{x}, $move_spec{y});
}
else
{
printf(REL_MOVE_SPEC, $move_spec{x}, $move_spec{y});
}
}
sub create_line_spec($$$)
{
my ($x, $y, $abs) = @_;
my %line_spec = ( type => "line", x => $x, y => $y, absolute => $abs );
return %line_spec;
}
sub print_line_spec(%)
{
my (%line_spec) = @_;
if ($line_spec{absolute})
{
printf(ABS_LINE_SPEC, $line_spec{x}, $line_spec{y});
}
else
{
printf(REL_LINE_SPEC, $line_spec{x}, $line_spec{y});
}
}
sub print_path_spec($%)
{
my ($depth, %path_spec) = @_;
my $ret = -1;
if ($path_spec{type} eq "path")
{
$ret = 0;
my @components = @{$path_spec{components}};
foreach (@components)
{
print_indent($depth);
my %path_element = %{$_};
if ($path_element{type} eq "arc")
{
print_arc_spec(%path_element)
}
elsif ($path_element{type} eq "move")
{
print_move_spec(%path_element)
}
elsif ($path_element{type} eq "line")
{
print_line_spec(%path_element)
}
else
{
$ret = -1;
last;
}
}
}
return $ret;
}
sub create_path_element($)
{
my ($id) = @_;
my %path_spec = ( type => "path", id => $id, class => "", stroke => "none",
fill => "none", strokewidth => 0);
return %path_spec;
}
sub set_path_id($$)
{
my ($path_ref, $id) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
$path_ref->{id} = $id;
$ret = 0;
}
return $ret;
}
sub set_path_class($$)
{
my ($path_ref, $class) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
$path_ref->{class} = $class;
$ret = 0;
}
return $ret;
}
sub set_path_stroke($$) {
my ($path_ref, $stroke) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
$path_ref->{stroke} = $stroke;
$ret = 0;
}
return $ret;
}
sub set_path_fill($$)
{
my ($path_ref, $fill) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
$path_ref->{fill} = $fill;
$ret = 0;
}
return $ret;
}
sub set_path_stroke_width($$)
{
my ($path_ref, $stroke_width) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
$path_ref->{strokewidth} = $stroke_width;
$ret = 0;
}
return $ret;
}
sub set_path_spec($$)
{
my ($path_ref, $spec_ref) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path" &&
$spec_ref->{type} eq "path")
{
$path_ref->{spec} = $spec_ref;
$ret = 0;
}
return $ret;
}
sub print_path_element($$)
{
my ($path_ref, $depth) = @_;
my $ret = -1;
if ($path_ref->{type} eq "path")
{
if (exists $path_ref->{spec})
{
print_indent($depth);
printf(PATH_ELEMENT_SPEC, $path_ref->{id}, $path_ref->{stroke}, $path_ref->{fill},
$path_ref->{strokewidth});
my %spec = %{$path_ref->{spec}};
if (0 == print_path_spec($depth+1, %spec))
{
print_indent($depth);
printf("\"");
printf(CLASS_SPEC, $path_ref->{class})
unless ("" eq $path_ref->{class});
printf(CLOSE_TAG_SPEC);
$ret = 0;
}
else
{
# TODO, print error
}
}
}
return $ret;
}
sub create_textpath_element($)
{
my ($href) = @_;
my %textpath_spec = (type => "textpath", xlink => $href, offset => 0,
baseline => "auto", text => "");
return %textpath_spec;
}
sub set_textpath_xlink($$)
{
my ($textpath_ref, $href) = @_;
my $ret = -1;
if ($textpath_ref->{type} eq "textpath")
{
$textpath_ref->{xlink} = $href;
$ret = 0;
}
return $ret;
}
sub set_textpath_offset($$)
{
my ($textpath_ref, $offset) = @_;
my $ret = -1;
if ($textpath_ref->{type} eq "textpath" && $offset >= 0
&& $offset <= 100)
{
$textpath_ref->{offset} = $offset;
$ret = 0;
}
return $ret;
}
sub set_textpath_baseline($$)
{
my ($textpath_ref, $baseline) = @_;
my $ret = -1;
if ($textpath_ref->{type} eq "textpath" &&
($baseline eq "auto" || $baseline eq "baseline" || $baseline eq "before-edge" ||
$baseline eq "text-before-edge" || $baseline eq "middle" ||
$baseline eq "central" || $baseline eq "after-edge" || $baseline eq "text-after-edge" ||
$baseline eq "ideographic" || $baseline eq "alphabetic" || $baseline eq "hanging" ||
$baseline eq "mathematical"))
{
$textpath_ref->{baseline} = $baseline;
$ret = 0;
}
return $ret;
}
sub set_textpath_text($$)
{
my ($textpath_ref, $text) = @_;
my $ret = -1;
if ($textpath_ref->{type} eq "textpath")
{
$textpath_ref->{text} = $text;
$ret = 0;
}
return $ret;
}
sub print_textpath_element($$)
{
my ($textpath_ref, $depth) = @_;
my $ret = -1;
if ($textpath_ref->{type} eq "textpath")
{
print_indent($depth);
printf(TEXTPATH_ELEMENT_SPEC, $textpath_ref->{xlink}, $textpath_ref->{offset},
$textpath_ref->{baseline});
print_indent($depth+1);
print($textpath_ref->{text} . "\n");
print_indent($depth);
printf(CLOSE_TEXTPATH_SPEC);
$ret = 0;
}
return $ret;
}
sub create_text_element($)
{
my ($id) = @_;
my %text_spec = ( type => "text", id => $id, font => "Verdana", size => 12, fill => "black",
anchor => "start", textpath => undef, text => "" );
return %text_spec;
}
sub set_text_id($$)
{
my ($text_ref, $id) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
$text_ref->{id} = $id;
$ret = 0;
}
return $ret;
}
sub set_text_font($$)
{
my ($text_ref, $font) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
$text_ref->{font} = $font;
$ret = 0;
}
return $ret;
}
sub set_text_fill($$)
{
my ($text_ref, $fill) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
$text_ref->{fill} = $fill;
$ret = 0;
}
return $ret;
}
sub set_text_anchor($$)
{
my ($text_ref, $anchor) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text" &&
($text_ref->{anchor} eq "start" || $text_ref->{anchor} eq "middle" ||
$text_ref->{anchor} eq "end"))
{
$text_ref->{anchor} = $anchor;
$ret = 0;
}
return $ret;
}
sub set_text_textpath($$)
{
my ($text_ref, $textpath_ref) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text" && $textpath_ref->{type} eq "textpath")
{
$text_ref->{textpath} = $textpath_ref;
$ret = 0;
}
return $ret;
}
sub set_text_size($$)
{
my ($text_ref, $size) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
$text_ref->{size} = $size;
$ret = 0;
}
return $ret;
}
sub set_text_text($$)
{
my ($text_ref, $text) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
$text_ref->{text} = $text;
$ret = 0;
}
return $ret;
}
sub print_text_element($$)
{
my ($text_ref, $depth) = @_;
my $ret = -1;
if ($text_ref->{type} eq "text")
{
print_indent($depth);
printf(TEXT_ELEMENT_SPEC, $text_ref->{id}, $text_ref->{font}, $text_ref->{size},
$text_ref->{fill}, $text_ref->{anchor});
if (defined $text_ref->{textpath})
{
print_textpath_element($text_ref->{textpath}, $depth+1);
}
else
{
print_indent($depth+1);
print($text_ref->{text} . "\n");
}
print_indent($depth);
printf(CLOSE_TEXT_ELEMENT);
$ret = 0;
}
return $ret;
}
sub create_group_element($)
{
my ($id) = @_;
my @children = ();
my %group = ( type => "group", id => $id, children => \@children);
return %group;
}
sub set_group_id($$)
{
my ($group_ref, $id) = @_;
my $ret = -1;
if ($group_ref->{type} eq "group")
{
$group_ref->{id} = $id;
$ret = 0;
}
return $ret;
}
sub append_group_child($$)
{
my ($group_ref, $child_ref) = @_;
my $ret = -1;
if ($group_ref->{type} eq "group")
{
push(@{$group_ref->{children}}, $child_ref);
$ret = 0;
}
return $ret;
}
sub remove_group_child($$)
{
my ($group_ref, $index) = @_;
my $ret = -1;
if ($group_ref->{type} eq "group" &&
$index >= 0 && $index < scalar @{$group_ref->{children}})
{
splice(@{$group_ref->{children}}, $index, 1);
$ret = 0;
}
return $ret;
}
sub print_group_element($$)
{
my ($group_ref, $depth) = @_;
my $ret = -1;
if ($group_ref->{type} eq "group")
{
print_indent($depth);
printf(GROUP_ELEMENT_SPEC, $group_ref->{id});
$ret = 0;
foreach (@{$group_ref->{children}})
{
$ret = print_element($_, $depth+1);
if (0 != $ret)
{
last;
}
}
if (0 == $ret)
{
print_indent($depth);
printf(CLOSE_GROUP_ELEMENT);
}
}
return $ret;
}
sub create_svg_document($$$)
{
my ($id, $x, $y) = @_;
my @children = ();
my %svg = ( type => "svg", id => $id, x => $x, y => $y, children => \@children );
return %svg;
}
sub set_svg_document_id($$)
{
my ($svg_ref, $id) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
$svg_ref->{id} = $id;
$ret = 0;
}
return $ret;
}
sub set_svg_document_x($$)
{
my ($svg_ref, $x) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
$svg_ref->{x} = $x;
$ret = 0;
}
return $ret;
}
sub set_svg_document_y($$)
{
my ($svg_ref, $y) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
$svg_ref->{y} = $y;
$ret = 0;
}
return $ret;
}
sub append_svg_document_child($$)
{
my ($svg_ref, $child_ref) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
push(@{$svg_ref->{children}}, $child_ref);
$ret = 0;
}
return $ret;
}
sub remove_svg_document_child($$)
{
my ($svg_ref, $index) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg" &&
$index >= 0 && $index < scalar @{$svg_ref->{children}})
{
splice(@{$svg_ref->{children}}, $index, 1);
$ret = 0;
}
return $ret;
}
sub print_svg_document($$)
{
my ($svg_ref, $depth) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
print_indent($depth);
printf(XML_DOC_HEADER);
print_indent($depth);
printf(XML_DOCTYPE_HEADER);
print_indent($depth);
printf(SVG_ELEMENT_SPEC, $svg_ref->{id}, $svg_ref->{x}, $svg_ref->{y});
$ret = 0;
foreach (@{$svg_ref->{children}})
{
$ret = print_element($_, $depth+1);
if (0 != $ret)
{
last;
}
}
if (0 == $ret)
{
print_indent($depth);
printf(CLOSE_SVG_ELEMENT);
}
}
return $ret;
}
sub print_element($$)
{
my ($element_ref, $depth) = @_;
my $ret = -1;
if ($element_ref->{type} eq "path")
{
$ret = print_path_element($element_ref, $depth);
}
elsif ($element_ref->{type} eq "text")
{
$ret = print_text_element($element_ref, $depth);
}
elsif ($element_ref->{type} eq "group")
{
$ret = print_group_element($element_ref, $depth);
}
return $ret;
}
# Tree parsing
sub trim($)
{
my ($str) = @_;
$str =~ s/^\s+|\s+$//g;
return $str;
}
sub parse_input_tree($)
{
my ($root_ref) = @_;
my $root = undef;
my $node = undef;
my $line_num = 0;
my $current_depth = 0;
my $count = 0;
my $ret = 0;
while (<STDIN>)
{
++$line_num;
chomp;
if($_ =~ m/^([\*]+)\s*(\/\*.*\*\/)?\s*(.*)$/)
{
my $depth = length $1;
# TODO: create a more personal ID for each node
my $id = "node" . ++$count;
my $style_ref = undef;
if (defined $2)
{
my %style;
my $style_def = $2;
$style_def =~ s/^\/\*\s*|\s*\*\/$//g;
my @pairs = split(",", $style_def);
foreach (@pairs)
{
$_ =~ m/^\s*([^=]*)=?(.*)\s*$/;
$style{trim($1)} = trim($2);
}
$style_ref = \%style;
}
if ($depth > $current_depth)
{
if (++$current_depth != $depth)
{
printf(STDERR "Error: tree nesting skips a level at line $line_num\n");
$ret = -1;
last;
}
my %new_node = create_tree_node($node, $id, trim($3));
tree_node_set_style(\%new_node, $style_ref);
if (defined $node)
{
push(@{$node->{leaves}}, \%new_node);
}
else
{
$root = \%new_node;
}
$node = \%new_node;
}
elsif ($depth == $current_depth)
{
$node = $node->{parent};
if (not defined $node)
{
printf(STDERR "Error: tree has more than one root at line $line_num\n");
$ret = -1;
last;
}
my %new_node = create_tree_node($node, $id, trim($3));
tree_node_set_style(\%new_node, $style_ref);
push(@{$node->{leaves}}, \%new_node);
$node = \%new_node;
}
else
{
if ($depth == 1)
{
printf(STDERR "Error: tree has more than one root at line $line_num\n");
$ret = -1;
last;
}
$node = $node->{parent};
do
{
$node = $node->{parent};
} until (--$current_depth == $depth);
my %new_node = create_tree_node($node, $id, trim($3));
tree_node_set_style(\%new_node, $style_ref);
push(@{$node->{leaves}}, \%new_node);
$node = \%new_node;
}
}
}
${$root_ref} = $root;
return $ret;
}
sub create_tree_node($$)
{
my ($parent, $id, $text) = @_;
my @leaves = ();
my %stats = (depth => 0, breadth => 0);
my %node = (parent => $parent, id => $id, text => $text, stats => \%stats, style => undef, leaves => \@leaves);
return %node;
}
sub tree_node_set_style($$)
{
my ($tree_ref, $style_ref) = @_;
$tree_ref->{style} = $style_ref;
}
sub finalise_tree_stats($)
{
my ($tree_ref) = @_;
my $max_depth = 0;
my $breadth = 0;
foreach (@{$tree_ref->{leaves}})
{
finalise_tree_stats($_);
if ($_->{stats}->{depth} > $max_depth)
{
$max_depth = $_->{stats}->{depth};
}
$breadth += $_->{stats}->{breadth};
}
if (not $tree_ref->{text} eq "")
{
++$breadth;
}
$tree_ref->{stats}->{depth} = ++$max_depth;
$tree_ref->{stats}->{breadth} = $breadth;
}
sub create_tree_node_path($$$$$$$$$$$$$)
{
my ($tree_ref, $tree_group_ref, $text_group_ref, $bg_group_ref, $x, $y, $step,
$theta, $style_ref, $radius, $angle_ref, $centre_ref, $bg_angle_ref) = @_;
my $ret = 0;
if ($$angle_ref < 0)
{
$$angle_ref = 360 + $$angle_ref;
}
my $to_angle = $$angle_ref;
my $from_angle = $$angle_ref;
$radius += $step;
if (not $tree_ref->{text} eq "")
{
my ($tx1, $ty1, $tx2, $ty2);
my %textpath_element = create_textpath_element("#" . $tree_ref->{id} . "-guide");
my %text_element = create_text_element($tree_ref->{id} . "-text");
if ($$angle_ref > 90 && $$angle_ref <= 270)
{
($tx2, $ty2) = polar_to_svg_coordinates($x, $y, $style_ref->{treeradius}, $$angle_ref);
($tx1, $ty1) = polar_to_svg_coordinates($x, $y, $style_ref->{textradius}, $$angle_ref);
$ret = set_text_anchor(\%text_element, "end")
unless (0 != $ret);
$ret = set_textpath_offset(\%textpath_element, 100)
unless (0 != $ret);
}
else
{
($tx1, $ty1) = polar_to_svg_coordinates($x, $y, $style_ref->{treeradius}, $$angle_ref);
($tx2, $ty2) = polar_to_svg_coordinates($x, $y, $style_ref->{textradius}, $$angle_ref);
}
my %text_move = create_move_spec($tx1, $ty1, 1);
my %text_line = create_line_spec($tx2, $ty2, 1);
my @text_components = (\%text_move, \%text_line);
my %text_spec = (type => "path", components => \@text_components);
my %text_guide = create_path_element($tree_ref->{id} . "-guide");
$ret = set_path_spec(\%text_guide, \%text_spec)
unless (0 != $ret);
$ret = set_textpath_text(\%textpath_element, $tree_ref->{text})
unless (0 != $ret);
$ret = set_textpath_baseline(\%textpath_element, "middle")
unless (0 != $ret);
$ret = set_text_textpath(\%text_element, \%textpath_element)
unless (0 != $ret);
$ret = append_group_child($text_group_ref, \%text_guide)
unless (0 != $ret);
$ret = append_group_child($text_group_ref, \%text_element)
unless (0 != $ret);
$$angle_ref -= $theta;
}
else
{
$ret = create_tree_node_path(shift @{$tree_ref->{leaves}}, $tree_group_ref, $text_group_ref, $bg_group_ref, $x, $y, $step,
$theta, $style_ref, $radius, $angle_ref, $centre_ref, $bg_angle_ref)
unless (0 != $ret);
$to_angle = $$centre_ref;
$from_angle = $$centre_ref;
}
foreach (@{$tree_ref->{leaves}})
{
$ret = create_tree_node_path($_, $tree_group_ref, $text_group_ref, $bg_group_ref, $x, $y, $step,
$theta, $style_ref, $radius, $angle_ref, $centre_ref, $bg_angle_ref)
unless (0 != $ret);
$from_angle = $$centre_ref;
}
my @tree_components;
$$centre_ref = $to_angle;
if ($from_angle != $to_angle)
{
my $sweep = $to_angle - $from_angle;
if ($from_angle < 0)
{
$from_angle = 360 + $from_angle;
}
else
{
$to_angle = $to_angle % 360;
}
if ($sweep < 0)
{
$sweep = 360 + $sweep;
}
my ($sx1, $sy1) = polar_to_svg_coordinates($x, $y, $radius, $from_angle);
my ($sx2, $sy2) = polar_to_svg_coordinates($x, $y, $radius, $to_angle);
my %arc;
my %move1 = create_move_spec($sx1, $sy1, 1);
if ($sweep < 180 && $sweep != 0)
{
%arc = create_arc_spec($sx2, $sy2, 0, 0, 0, $radius, $radius, 1);
}
else
{
%arc = create_arc_spec($sx2, $sy2, 0, 1, 0, $radius, $radius, 1);
}
push(@tree_components, \%move1);
push(@tree_components, \%arc);
$$centre_ref = $from_angle + ($sweep / 2);
}
my ($start_x, $start_y) = polar_to_svg_coordinates($x, $y, $radius, $$centre_ref);
$radius -= $step;
my ($end_x, $end_y) = polar_to_svg_coordinates($x, $y, $radius, $$centre_ref);
my %move2 = create_move_spec($start_x, $start_y, 1);
my %riser = create_line_spec($end_x, $end_y, 1);
push(@tree_components, \%move2);
push(@tree_components, \%riser);
my %tree_spec = (type => "path", components => \@tree_components);
my %tree_path = create_path_element($tree_ref->{id});
$ret = set_path_spec(\%tree_path, \%tree_spec)
unless (0 != $ret);
$ret = set_path_stroke(\%tree_path, "black")
unless (0 != $ret);
$ret = set_path_stroke_width(\%tree_path, 1)
unless (0 != $ret);
$ret = append_group_child($tree_group_ref, \%tree_path)
unless (0 != $ret);
print STDERR "changing angle! $$angle_ref\n";
if (defined $tree_ref->{style})
{
if (exists $tree_ref->{style}->{bgcolour})
{
my $bg_from_angle = $$angle_ref + ($theta / 2);
my $bg_to_angle = $$bg_angle_ref;
my $bg_sweep = $bg_to_angle - $bg_from_angle;
if ($bg_from_angle > 360)
{
$bg_from_angle = $bg_from_angle % 360;
}
if ($bg_sweep < 0)
{
$bg_sweep = 360 + $bg_sweep;
}
print STDERR "Angle is currently $$angle_ref, Creating an arc from $bg_from_angle to $bg_to_angle\n";
my %bg_spec = calc_sector_path($x, $y, $bg_from_angle, $bg_sweep, $style_ref->{textradius},
$style_ref->{treeradius});
my %bg_path = create_path_element($tree_ref->{id} . "-bg");
$ret = set_path_spec(\%bg_path, \%bg_spec)
unless (0 != $ret);
$ret = set_path_fill(\%bg_path, $tree_ref->{style}->{bgcolour})
unless (0 != $ret);
$ret = append_group_child($bg_group_ref, \%bg_path)
unless (0 != $ret);
$$bg_angle_ref = $bg_from_angle;
}
}
return $ret;
}
sub create_tree_group($$$)
{
my ($tree_ref, $svg_ref, $style_ref) = @_;
my $ret = -1;
if ($svg_ref->{type} eq "svg")
{
my $x = $svg_ref->{x} / 2;
my $y = $svg_ref->{y} / 2;
my $step = int($style_ref->{treeradius} / ($tree_ref->{stats}->{depth} + 1));
my $theta = 360 / ($tree_ref->{stats}->{breadth});
my %bg_group = create_group_element("background");
my %text_group = create_group_element("text");
my %tree_group = create_group_element("tree");
my $angle = 180;
my $centre = 0;
my $bg_angle = $angle + ($theta / 2);
#$ret = create_tree_node_path($tree_ref, \%tree_group, \%text_group, \%bg_group, $x, $y,
# $step, $theta, $style_ref, undef, 90, 0, 90);
$ret = create_tree_node_path($tree_ref, \%tree_group, \%text_group, \%bg_group, $x, $y,
$step, $theta, $style_ref, 0, \$angle, \$centre, \$bg_angle);
$ret = append_svg_document_child($svg_ref, \%bg_group)
unless (0 != $ret);
$ret = append_svg_document_child($svg_ref, \%text_group)
unless (0 != $ret);
$ret = append_svg_document_child($svg_ref, \%tree_group)
unless (0 != $ret);
}
return $ret;
}
#my %foo = calc_sector_path(250, 250, 0, 50, 70, 50);
#print_path_spec(%foo);
#my %bar = calc_sector_path(250, 250, 0, 50, 50, 0);
#print_path_spec(%bar);
my %spec = calc_sector_path(250, 250, 0, 50, 70, 50);
my %path = create_path_element("foo");
set_path_id(\%path, "baz");
set_path_spec(\%path, \%spec);
#print_path_element(\%path, 0);
my $tree = undef;
my $ret = parse_input_tree(\$tree);
finalise_tree_stats($tree);
my %style = (treeradius => 150, textradius => 250);
my %svg = create_svg_document("foo", 600, 600);
create_tree_group($tree, \%svg, \%style);
print_svg_document(\%svg, 0);