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

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

package Bio::Phylo::Treedrawer::Swf;
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 'SWF::Builder';
use Bio::Phylo::Util::Logger;
our $FONT;
my $logger = Bio::Phylo::Util::Logger->new;
my $PI     = '3.14159265358979323846';
my %colors;

sub _new {
    my $class = shift;
    my %opt   = looks_like_hash @_;
    my $self  = $class->SUPER::_new(
        %opt,
        '-api' => SWF::Builder->new(
            'FrameRate' => 15,
            'FrameSize' =>
              [ 0, 0, $opt{'-drawer'}->get_width, $opt{'-drawer'}->get_height ],
            'BackgroundColor' => 'ffffff'
        )
    );
    return bless $self, $class;
}

sub _finish {
    $logger->debug("finishing drawing");
    my $self = shift;
    require File::Temp;
    my ( $fh, $filename ) = File::Temp::tempfile();
    $self->_api->save('file.swf');
}

# -x1 => $x1,
# -x2 => $x2,
# -y1 => $y1,
# -y2 => $y2,
# -width => $width,
# -color => $color
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, $width, $color ) = @args{@keys};
    my ( $x2, $y2 ) = ( $x1, $y3 );
    return $self->_api->new_shape->linestyle( $width || 1, $color || '000000' )
      ->moveto( $x1, $y1 )->curveto( $x1, $y1, $x1, $y1, $x2, $y2, $x3, $y3 )
      ->place;
}

# required:
# -x1 => $x1,
# -y1 => $y1,
# -x2 => $x2,
# -y2 => $y2,
# -x3 => $x3,
# -y3 => $y3,
# optional:
# -fill   => $fill,
# -stroke => $stroke,
# -width  => $width,
# -url    => $url,
# -api    => $api,
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};
    return $self->_api->new_shape    # red triangle.
      ->fillstyle( $fill || 'ffffff' )
      ->linestyle( $width || 1, $stroke || '000000' )
      ->moveto( int $x1, int $y1 )->lineto( int $x2, int $y2 )
      ->lineto( int $x3, int $y3 )->lineto( int $x1, int $y1 )->place;
}

# -x1 => $x1,
# -x2 => $x2,
# -y1 => $y1,
# -y2 => $y2,
# -width => $width,
# -color => $color
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};
    return $self->_api->new_shape->linestyle( $width || 1, $color || '000000' )
      ->moveto( $x1, $y1 )->lineto( $x1, $y1, $x2, $y2 )->place;
}

# -x1 => $x1,
# -x2 => $x2,
# -y1 => $y1,
# -y2 => $y2,
# -width => $width,
# -color => $color
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 );
    return $self->_api->new_shape->linestyle( $width || 1, $color || '000000' )
      ->moveto( $x1, $y1 )->lineto( $x1, $y1, $x2, $y2, $x3, $y3 )->place;
}

# required:
# -x => $x,
# -y => $y,
# -text => $text,
#
# optional:
# -url  => $url,
sub _draw_text {
    $logger->debug("drawing text");
    my $self = shift;
    if ( not $self->{'FONT'} ) {
        $self->{'FONT'} =
          $self->_api->new_font($Bio::Phylo::Treedrawer::Swf::FONT);
    }
    my %args = @_;
    my ( $x, $y, $text, $url, $size ) = @args{qw(-x -y -text -url -size)};
    if ($url) {
        $text = sprintf( '<a href="%s">%s</a>', $url, $text );
    }
    my $textobj =
      $self->_api->new_html_text->font( $self->{'FONT'} )->size( $size || 12 )
      ->text($text);
    return $textobj->place->moveto( $x, $y );
}

# -x => $x,
# -y => $y,
# -width  => $width,
# -stroke => $color,
# -radius => $radius,
# -fill   => $file,
# -api    => $api,
# -url    => $url,
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 $circle =
      $self->_api->new_shape->fillstyle( $fill || '000000' )
      ->linestyle( $width || 1, $stroke || '000000' )->circle($radius);
    return $circle->place->moveto( $x, $y );
}

1;