Bio::Phylo::Treedrawer::Png - Graphics format writer used by treedrawer, no

 $Id: Png.pm 1660 2011-04-02 18:29:40Z rvos $

package Bio::Phylo::Treedrawer::Png;
use strict;
use base 'Bio::Phylo::Treedrawer::Abstract';
use Bio::Phylo::Util::Exceptions 'throw';
use Bio::Phylo::Util::CONSTANT 'looks_like_hash';
use Bio::Phylo::Util::Dependency qw'GD::Simple GD::Polyline GD::Polygon GD';
use Bio::Phylo::Util::Logger;
my $logger = Bio::Phylo::Util::Logger->new;
my $PI     = '3.14159265358979323846';
my %colors;
my $whiteHex = 'FFFFFF';

sub _hex2rgb ($) {
    my $hex = shift;
    my ( $r, $g, $b ) = ( 0, 0, 0 );
    if ( $hex =~ m/^(..)(..)(..)$/ ) {
        $r = hex($1);
        $g = hex($2);
        $b = hex($3);
    }
    return $r, $g, $b;
}

sub _new {
    my $class = shift;
    my %opt   = looks_like_hash @_;
    my $img   = GD::Simple->new(
        $opt{'-drawer'}->get_width,
        $opt{'-drawer'}->get_height,
    );
    my $white = $img->colorAllocate( 255, 255, 255 );
    $img->transparent($white);
    $img->interlaced('true');
    my $self = $class->SUPER::_new( %opt, '-api' => $img );
    return bless $self, $class;
}

sub _finish {
    $logger->debug("finishing drawing");
    my $self = shift;
    $self->_api->png;
}

sub _draw_curve {
    $logger->debug("drawing curved branch");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color -api);
    my ( $x1, $y1, $x3, $y3, $linewidth, $color, $api ) = @args{@keys};
    my ( $x2, $y2 ) = ( $x1, $y3 );
    my $poly = GD::Polyline->new();
    my $img = $api || $self->_api;
    $img->setThickness( $linewidth || 1 );
    $poly->addPt( $x1, $y1 );
    $poly->addPt( $x1, ( $y1 + $y3 ) / 2 );
    $poly->addPt( ( $x1 + $x3 ) / 2, $y3 );
    $poly->addPt( $x3, $y3 );
    $img->polydraw( $poly->toSpline(), $img->colorAllocate( _hex2rgb $color) );
}

sub _draw_triangle {
    my $self = shift;
    $logger->debug("drawing triangle @_");
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -x3 -y3 -fill -stroke -width -url -api);
    my ( $x1, $y1, $x2, $y2, $x3, $y3, $fill, $stroke, $width, $url, $api ) =
      @args{@keys};
    if ($url) {
        $logger->warn( ref($self) . " can't embed links" );
    }
    my $img = $api || $self->_api;

    # create polygone
    my $poly = GD::Polygon->new();
    $poly->addPt( $x1, $y1 );
    $poly->addPt( $x2, $y2 );
    $poly->addPt( $x3, $y3 );
    $poly->addPt( $x1, $y1 );

    # set line thickness
    $img->setThickness( $width || 1 );

    # create stroke color
    my $strokeColorObj = $img->colorAllocate( _hex2rgb $stroke);

    # create fill color
    my $fillColorObj = $img->colorAllocate( _hex2rgb( $fill || $whiteHex ) );

    # draw polygon
    $img->polydraw( $poly, $strokeColorObj );

    # fill polygon
    $img->fill(
        ( ( $x1 + $x2 + $x3 ) / 3 ),
        ( ( $y1 + $y2 + $y3 ) / 3 ),
        $fillColorObj
    );
}

sub _draw_line {
    $logger->debug("drawing line");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color);
    my ( $x1, $y1, $x2, $y2, $width, $color ) = @args{@keys};
    my $img            = $self->_api;
    my $strokeColorObj = $img->colorAllocate( _hex2rgb $color);
    $img->setThickness( $width || 1 );
    $img->moveTo( $x1, $y1 );
    $img->lineTo( $x2, $y2 );
}

sub _draw_multi {
    $logger->debug("drawing multi line");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color);
    my ( $x1, $y1, $x3, $y3, $linewidth, $color ) = @args{@keys};
    my ( $x2, $y2 ) = ( $x1, $y3 );
    my $poly = GD::Polyline->new();
    $poly->addPt( $x1, $y1 );
    $poly->addPt( $x2, $y2 );
    $poly->addPt( $x3, $y3 );
    $self->_api->setThickness( $linewidth || 1 );
    my $colorObj = $self->_api->colorAllocate( _hex2rgb $color);
    $self->_api->polydraw( $poly, $colorObj );
}

sub _draw_text {
    $logger->debug("drawing text");
    my $self = shift;
    my %args = @_;
    my ( $x, $y, $text, $url, $size ) = @args{qw(-x -y -text -url -size)};
    if ($url) {
        $logger->warn( ref($self) . " can't embed links" );
    }
    $self->_api->moveTo( $x, $y );
    $self->_api->fontsize( $size || 12 );
    $self->_api->string($text);
}

sub _draw_circle {
    $logger->debug("drawing circle");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x -y -width -stroke -radius -fill -api -url);
    my ( $x, $y, $width, $stroke, $radius, $fill, $api, $url ) = @args{@keys};
    my $height = $self->_drawer->get_height;
    if ($url) {
        $logger->warn( ref($self) . " can't embed links" );
    }
    my $img = $api || $self->_api;
    $img->fgcolor( $img->colorAllocate( _hex2rgb $stroke) );
    $img->bgcolor( $img->colorAllocate( _hex2rgb( $fill || $whiteHex ) ) );
    $img->moveTo( $x, $y );
    $img->ellipse( $radius, $radius );
}

1;