User:JeevesMkII/radialtree.pl
Jump to navigation
Jump to search
#!/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);