view release on metacpan or  search on metacpan

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

		'height' => $height,
		'style'  => {
			'fill'         => $fill,
			'stroke'       => $stroke,
			'stroke-width' => $s_width,
		},
	);
}

=begin comment

# required:
# -x => $x,
# -y => $y,
# -text => $text,
#
# optional:
# -api      => $api,
# -url      => $url,
# -rotation => [ $rotation, $x, $y ]

=end comment

=cut

sub _draw_text {
    my $self = shift;
    my %args = @_;
    my ( $x, $y, $text ) = @args{qw(-x -y -text)};
    my $url      = $args{'-url'};
	my $rotation = $args{'-rotation'} || [];
    my $api      = $args{'-api'} || $self->_api;	
    delete @args{qw(-x -y -text -api -url -rotation)};
    if ( $url ) {
        $api = $api->tag( 'a', 'xlink:href' => $url );
    }
	my @style;
	if ( my $face = $args{'-font_face'} ) {
		push @style, "font-family: ${face}";
	}
	if ( my $size = $args{'-font_size'} ) {
		push @style, "font-size: ${size}"
	}
	if ( my $style = $args{'-font_style'} ) {
		push @style, "font-style: ${style}";
	}
	if ( my $colour = $args{'-font_colour'} ) {
		push @style, "fill: ${colour}";
	}
	if ( my $weight = $args{'-font_weight'} ) {
		push @style, "font-weight: ${weight}";
	}
	no warnings 'uninitialized';
    return $api->tag(
		'text',
		'x'         => $x,
		'y'         => $y,
		'style'     => join('; ',@style),
		'transform' => "rotate(@${rotation})",
		%args
	)->cdata($text);
}

=begin comment

# -x => $x,
# -y => $y,
# -width  => $width,
# -stroke => $color,
# -radius => $radius,
# -fill   => $file,
# -api    => $api,
# -url    => $url,

=end comment

=cut

sub _draw_circle {
    my $self = shift;
    my %args = @_;
    my ( $x, $y, $radius, $width, $stroke, $fill, $api, $url ) =
      @args{qw(-x  -y  -radius  -width  -stroke  -fill  -api  -url)};
    if ($radius) {
        my $svg = $api || $self->_api;
        if ($url) {
            $svg = $svg->tag( 'a', 'xlink:href' => $url );
        }
        my %circle = (
            'cx'    => int $x,
            'cy'    => int $y,
            'r'     => int $radius,
            'style' => {
                'fill'         => $fill   || 'white',
                'stroke'       => $stroke || 'black',
                'stroke-width' => $width  || 1,
            },
        );
        return $svg->tag( 'circle', %circle );
    }
}

=begin comment

# -x1 => $x1,
# -x2 => $x2,
# -y1 => $y1,
# -y2 => $y2,
# -width => $width,
# -color => $color

=end comment

=cut

sub _draw_curve {
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color);
    my ( $x1, $y1, $x2, $y2, $width, $color ) = @args{@keys};
    delete @args{@keys};