view release on metacpan or  search on metacpan

lib/Bio/Phylo/Treedrawer/Svg.pm  view on Meta::CPAN

    my %c = %{ $self->_drawer->get_pie_colors };
	%colors = %c if scalar keys %c;
	
    $self->_tree->visit_level_order(
        sub {
            my $node = shift;
            if ( not $node->get_collapsed ) {
                my $cx = int $node->get_x;
                my $cy = int $node->get_y;
                my $r;
                if ( $node->is_internal ) {
                    $r = int $self->_drawer->get_node_radius($node);
                }
                else {
                    $r = int $self->_drawer->get_tip_radius($node);
                }
                if ( $r ) {
					if ( my $pievalues = $node->get_generic('pie') ) {
						my @keys  = keys %{$pievalues};
						my $start = -90;
						my $total;
						$total += $pievalues->{$_} for @keys;
						my $pie = $self->_api->tag(
							'g',
							'id'        => 'pie_' . $node->get_id,
							'transform' => "translate($cx,$cy)",
						);
						for my $i ( 0 .. $#keys ) {
							next if not $pievalues->{ $keys[$i] };
							my $slice = $pievalues->{ $keys[$i] } / $total * 360;
							my $color = $colors{ $keys[$i] };
							if ( not $color ) {
								my $gray = int( ( $i / $#keys ) * 256 );
								$colors{ $keys[$i] } = "rgb($gray,$gray,$gray)";
							}
							my $do_arc  = 0;
							my $radians = $slice * $PI / 180;
							$do_arc++ if $slice > 180;
							my $radius = $r - 2;
							my $ry     = $radius * sin($radians);
							my $rx     = $radius * cos($radians);
							my $g =
							  $pie->tag( 'g', 'transform' => "rotate($start)" );
							$g->path(
								'style' =>
								  { 'fill' => "$color", 'stroke' => 'none' },
								'd' => "M $radius,0 A $radius,$radius 0 $do_arc,1 $rx,$ry L 0,0 z"
							);
							$start += $slice;
						}
					}
                }
            }
        }
    );
}

=begin comment

 Type    : Internal method.
 Title   : _draw_legend
 Usage   : $svg->_draw_legend();
 Function: Draws likelihood pie legend
 Returns :
 Args    : None

=end comment

=cut

sub _draw_legend {
    my $self = shift;
    if (%colors) {
        my $svg  = $self->_api;
        my $tree = $self->_tree;
        my $draw = $self->_drawer;
        my @keys = keys %colors;
        my $increment =
          ( $tree->get_tallest_tip->get_x - $tree->get_root->get_x ) /
          scalar @keys;
        my $x = $tree->get_root->get_x + 5;
        foreach my $key (@keys) {
            $svg->rectangle(
                'x'      => $x,
                'y'      => ( $draw->get_height - 90 ),
                'width'  => ( $increment - 10 ),
                'height' => 10,
                'id'     => 'legend_' . $key,
                'style'  => {
                    'fill'         => $colors{$key},
                    'stroke'       => 'black',
                    'stroke-width' => '1',
                },
            );
            $self->_draw_text(
                '-x'    => $x,
                '-y'    => ( $draw->get_height - 60 ),
                '-text' => $key || ' ',
                'class' => 'legend_label'
            );
            $x += $increment;
        }
        $self->_draw_text(
            '-x' =>
              ( $tree->get_tallest_tip->get_x + $draw->get_text_horiz_offset ),
            '-y'    => ( $draw->get_height - 80 ),
            '-text' => 'Node value legend',
            'class' => 'legend_text',
        );
    }
}

=head1 SEE ALSO

There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo> 
for any user or developer questions and discussions.

=over

=item L<Bio::Phylo::Treedrawer>

The svg treedrawer is called by the L<Bio::Phylo::Treedrawer> object. Look there
to learn how to create tree drawings.

=item L<Bio::Phylo::Manual>

Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>.

=back

=head1 CITATION

If you use Bio::Phylo in published research, please cite it:

B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen>
and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl.
I<BMC Bioinformatics> B<12>:63.
L<http://dx.doi.org/10.1186/1471-2105-12-63>

=cut

1;