2 # BioPerl module for Bio::TreeIO::svg-graph
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Allen Day <allenday@ucla.edu>
8 # Copyright Brian O'Connor
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
16 Bio::TreeIO::svggraph - A simple output format that converts a Tree object to an SVG output
21 my $in = Bio::TreeIO->new(-file => 'input', -format => 'newick');
22 my $out = Bio::TreeIO->new(-file => '>output', -format => 'svggraph');
24 while( my $tree = $in->next_tree ) {
25 my $svg_xml = $out->write_tree($tree);
30 This outputs a tree as an SVG graphic using the SVG::Graph API
36 User feedback is an integral part of the evolution of this and other
37 Bioperl modules. Send your comments and suggestions preferably to
38 the Bioperl mailing list. Your participation is much appreciated.
40 bioperl-l@bioperl.org - General discussion
41 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
45 Please direct usage questions or support issues to the mailing list:
47 I<bioperl-l@bioperl.org>
49 rather than to the module maintainer directly. Many experienced and
50 reponsive experts will be able look at the problem and quickly
51 address it. Please include a thorough description of the problem
52 with code and data examples if at all possible.
56 Report bugs to the Bioperl bug tracking system to help us keep track
57 of the bugs and their resolution. Bug reports can be submitted via the
60 https://redmine.open-bio.org/projects/bioperl/
62 =head1 AUTHOR - Brian OConnor
64 Email brian.oconnor-at-excite.com
69 Guillaume Rousse, Guillaume-dot-Rousse-at-inria-dot-fr
73 The rest of the documentation details each of the object methods.
74 Internal methods are usually preceded with a _
79 # Let the code begin...
82 package Bio
::TreeIO
::svggraph
;
85 # Object preamble - inherits from Bio::Root::Root
89 use SVG
::Graph
::Data
::Tree
;
90 use SVG
::Graph
::Data
::Node
;
96 use base
qw(Bio::TreeIO);
101 Usage : my $obj = Bio::TreeIO::svggraph->new();
102 Function: Builds a new Bio::TreeIO::svggraph object
103 Returns : Bio::TreeIO::svggraph
104 Args :-width => image width (default 1600)
105 -height => image height (default 1000)
106 -margin => margin (default 30)
107 -stroke => stroke color (default 'black')
108 -stroke_width=> stroke width (default 2)
109 -font_size=> font size (default '10px')
110 -nomalize => undef or 'log' (default is undef)
116 my ($width,$height,$margin,$stroke,
117 $stroke_width,$font_size,
118 $normalize) = $self->_rearrange([qw
127 $self->{_width
} = $width || 1600;
128 $self->{_height
} = $height || 1000;
129 $self->{_margin
} = defined $margin ?
$margin : 30;
130 $self->{_stroke
} = $stroke || 'black';
131 $self->{_stroke_width
} = $stroke_width || 2;
132 $self->{_font_size
} = $font_size || '10px';
133 $self->{_normalize
} = $normalize || '';
134 $self->SUPER::_initialize
(@_);
140 Usage : $treeio->write_tree($tree);
141 Function: Write a tree out to data stream in newick/phylip format
143 Args : Bio::Tree::TreeI object
148 my ($self,$tree) = @_;
149 my $line = $self->_write_tree_Helper($tree->get_root_node);
150 $self->_print($line. "\n");
151 $self->flush if $self->_flush_on_write && defined $self->_fh;
155 sub _write_tree_Helper
{
156 my ($self,$node) = @_;
158 my $graph = SVG
::Graph
->new
159 ('width' => $self->{'_width'},
160 'height' => $self->{'_height'},
161 'margin' => $self->{'_margin'});
163 my $group0 = $graph->add_frame;
164 my $tree = SVG
::Graph
::Data
::Tree
->new;
165 my $root = SVG
::Graph
::Data
::Node
->new;
166 $root->name($node->id);
167 $self->_decorateRoot($root, $node->each_Descendent());
169 $group0->add_data($tree);
171 $group0->add_glyph('tree',
172 'stroke' =>$self->{'_stroke'},
173 'stroke-width'=>$self->{'_stroke_width'},
174 'font-size' =>$self->{'_font_size'});
176 return($graph->draw);
182 Title : _decorateRoot
183 Usage : internal methods
193 my ($self,$previousNode,@children) = @_;
194 for my $child (@children) {
195 my $currNode = SVG
::Graph
::Data
::Node
->new;
197 # if no ID is set, the branch label is intentionally set blank (bug in SVG::Graph)
198 my $id = $child->id || '';
199 $currNode->branch_label($id);
200 my $length = $child->branch_length;
201 if ($self->{_normalize
} eq 'log') {
202 $length = log($length + 1);
205 $currNode->branch_length($length);
206 $previousNode->add_daughter($currNode);
207 $self->_decorateRoot($currNode, $child->each_Descendent());
216 Function: Sorry not possible with this format
224 $_[0]->throw("Sorry the format 'svggraph' can only be used as an output format");