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

Bio-Phylo documentation Contained in the Bio-Phylo distribution.

Index

Code Index:

NAME

Top

Bio::Phylo::Treedrawer::Pdf - Graphics format writer used by treedrawer, no serviceable parts inside

DESCRIPTION

Top

This module creates a pdf file from a Bio::Phylo::Forest::DrawTree object. It is called by the Bio::Phylo::Treedrawer object, so look there to learn how to create tree drawings.

SEE ALSO

Top

Bio::Phylo::Treedrawer

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

Bio::Phylo::Manual

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

CITATION

Top

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

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

REVISION

Top

 $Id: Pdf.pm 1660 2011-04-02 18:29:40Z rvos $
Bio-Phylo documentation Contained in the Bio-Phylo distribution. 
package Bio::Phylo::Treedrawer::Pdf;
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'PDF::API2::Lite PDF::API2::Annotation';
use Bio::Phylo::Util::Logger;
my $logger = Bio::Phylo::Util::Logger->new;
my $PI     = '3.14159265358979323846';
my %colors;


sub _new {
    my $class = shift;
    my %opt   = looks_like_hash @_;
    my $pdf   = PDF::API2::Lite->new;
    my $self  = $class->SUPER::_new( %opt, '-api' => $pdf );
    my $d     = $self->_drawer;
    my $page  = $self->_api->page( $d->get_width, $d->get_height );
    return bless $self, $class;
}


sub _finish {
    $logger->debug("finishing drawing");
    my $self = shift;
    $self->_api->saveas('file.pdf');
}


sub _draw_curve {
    $logger->debug("drawing curved branch");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color);
    my ( $x1, $y1, $x3, $y3, $linewidth, $color ) = @args{@keys};
    my $height = $self->_drawer->get_height;
    my ( $x2, $y2 ) = ( $x1, $y3 );
    return $self->_api->linewidth( $linewidth || 1 )
      ->strokecolor( $color ? "#$color" : "#000000" )
      ->move( $x1, $height - $y1 )
      ->curve( $x1, $height - $y1, $x2, $height - $y2, $x3, $height - $y3 )
      ->stroke();
}


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, yet" );
    }
    my $height = $self->_drawer->get_height;
    my $pdf = $api || $self->_api;
    return $pdf->move( $x1, $height - $y1 )->linewidth( $width || 1 )
      ->strokecolor( $stroke ? "#$stroke" : "#000000" )
      ->fillcolor( $fill     ? "#$fill"   : "white" )->poly(
        $x1, $height - $y1, $x2, $height - $y2,
        $x3, $height - $y3, $x1, $height - $y1,
      )->fillstroke();
}


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 $height = $self->_drawer->get_height;
    return $self->_api->linewidth( $width || 1 )
      ->strokecolor( $color ? "#$color" : "#000000" )
      ->move( $x1, $height - $y1 )
      ->poly( $x1, $height - $y1, $x2, $height - $y2 )->stroke();
}


sub _draw_multi {
    $logger->debug("drawing rectangular branch");
    my $self = shift;
    my %args = @_;
    my @keys = qw(-x1 -y1 -x2 -y2 -width -color);
    my ( $x1, $y1, $x3, $y3, $width, $color ) = @args{@keys};
    my ( $x2, $y2 ) = ( $x1, $y3 );
    my $height = $self->_drawer->get_height;
    return $self->_api->linewidth( $width || 1 )
      ->strokecolor( $color ? "#$color" : "#000000" )
      ->move( $x1, $height - $y1 )
      ->poly( $x1, $height - $y1, $x2, $height - $y2, $x3, $height - $y3 )
      ->stroke();
}


sub _draw_text {
    $logger->debug("drawing text");
    my $self = shift;
    if ( not $self->{'FONT'} ) {
        $self->{'FONT'} = $self->_api->corefont('Times-Roman');
    }
    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, yet" );
    }
    my $height = $self->_drawer->get_height;
    return $self->_api->fillcolor("#000000")
      ->print( $self->{'FONT'}, $size || 12, $x, $height - $y, 0, 0, $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;
    my $pdf = $api || $self->_api;
    my $circle =
      $pdf->circle( $x, $height - $y, $radius )->linewidth( $width || 1 )
      ->strokecolor( $stroke ? "#$stroke" : "#000000" )
      ->fillcolor( $fill     ? "#$fill"   : "white" )->fillstroke();

    if ($url) {
        $logger->warn( ref($self) . " can't embed links, yet" );

        #my $ann = PDF::API2::Annotation->new;
        #$ann->url(
        #    $url,
        #    '-rect' => [
        #        $x - $radius,
        #        ( $height - $y ) - $radius,
        #        $x + $radius,
        #        ( $height - $y ) + $radius,
        #    ]
        #);
    }
    return $circle;
}


1;