[Bioperl-guts-l] [14794] bioperl-live/trunk/Bio/Graphics: added feature grouping to SVG output from Bio::Graphics
Lincoln Stein
lstein at dev.open-bio.org
Sun Aug 10 18:16:21 EDT 2008
Revision: 14794
Author: lstein
Date: 2008-08-10 18:16:20 -0400 (Sun, 10 Aug 2008)
Log Message:
-----------
added feature grouping to SVG output from Bio::Graphics
Modified Paths:
--------------
bioperl-live/trunk/Bio/Graphics/FeatureFile.pm
bioperl-live/trunk/Bio/Graphics/Glyph/generic.pm
bioperl-live/trunk/Bio/Graphics/Glyph.pm
bioperl-live/trunk/Bio/Graphics/Panel.pm
Modified: bioperl-live/trunk/Bio/Graphics/FeatureFile.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/FeatureFile.pm 2008-08-09 23:34:11 UTC (rev 14793)
+++ bioperl-live/trunk/Bio/Graphics/FeatureFile.pm 2008-08-10 22:16:20 UTC (rev 14794)
@@ -294,6 +294,14 @@
features rendered, the created panel, and an array ref of all the
track objects created.
+Instead of a Bio::Graphics::Panel object, you can provide a hash
+reference containing the arguments that you would pass to
+Bio::Graphics::Panel->new(). For example, to render an SVG image, you
+could do this:
+
+ my ($tracks_rendered,$panel) = $data->render({-image_class=>'GD::SVG'});
+ print $panel->svg;
+
=back
=cut
@@ -301,7 +309,7 @@
#"
sub render {
- my $self = shift;
+ my $self = shift;
my $panel = shift; # 8 arguments
my ($position_to_insert,
$options,
@@ -313,7 +321,9 @@
) = @_;
my %seenit;
- $panel ||= $self->new_panel;
+ unless ($panel && UNIVERSAL::isa($panel,'Bio::Graphics::Panel')) {
+ $panel = $self->new_panel($panel);
+ }
# count up number of tracks inserted
my @tracks;
@@ -1459,9 +1469,10 @@
# create a panel if needed
sub new_panel {
- my $self = shift;
+ my $self = shift;
+ my $options = shift;
- require Bio::Graphics::Panel;
+ eval "require Bio::Graphics::Panel" unless Bio::Graphics::Panel->can('new');
# general configuration of the image here
my $width = $self->setting(general => 'pixels')
@@ -1480,11 +1491,14 @@
$stop = $self->max unless defined $stop;
}
- my $new_segment = Bio::Graphics::Feature->new(-start=>$start,-stop=>$stop);
+ my $new_segment = Bio::Graphics::Feature->new(-start=>$start,-stop=>$stop);
+ my @panel_options = %$options if $options && ref $options eq 'HASH';
my $panel = Bio::Graphics::Panel->new(-segment => $new_segment,
-width => $width,
-key_style => 'between',
- $self->style('general'));
+ $self->style('general'),
+ @panel_options
+ );
$panel;
}
Modified: bioperl-live/trunk/Bio/Graphics/Glyph/generic.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/Glyph/generic.pm 2008-08-09 23:34:11 UTC (rev 14793)
+++ bioperl-live/trunk/Bio/Graphics/Glyph/generic.pm 2008-08-10 22:16:20 UTC (rev 14794)
@@ -184,10 +184,12 @@
$self->calculate_cds() if $self->option('draw_translation') && $self->protein_fits;
+ $self->panel->startGroup($gd);
$self->SUPER::draw(@_);
$self->draw_label(@_) if $self->option('label');
$self->draw_description(@_) if $self->option('description');
$self->draw_part_labels(@_) if $self->option('label') && $self->option('part_labels');
+ $self->panel->endGroup($gd);
}
sub draw_component {
Modified: bioperl-live/trunk/Bio/Graphics/Glyph.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/Glyph.pm 2008-08-09 23:34:11 UTC (rev 14793)
+++ bioperl-live/trunk/Bio/Graphics/Glyph.pm 2008-08-10 22:16:20 UTC (rev 14794)
@@ -741,6 +741,8 @@
push @FEATURE_STACK,$self->feature;
+ $self->panel->startGroup($gd);
+
my $connector = $self->connector;
if (my @parts = $self->parts) {
@@ -770,7 +772,10 @@
$self->draw_component($gd,$left,$top,$partno,$total_parts) unless $self->feature_has_subparts;
}
+ $self->panel->endGroup($gd);
+
pop @FEATURE_STACK;
+
}
# the "level" is the level of testing of the glyph
Modified: bioperl-live/trunk/Bio/Graphics/Panel.pm
===================================================================
--- bioperl-live/trunk/Bio/Graphics/Panel.pm 2008-08-09 23:34:11 UTC (rev 14793)
+++ bioperl-live/trunk/Bio/Graphics/Panel.pm 2008-08-10 22:16:20 UTC (rev 14794)
@@ -538,44 +538,65 @@
$offset += $track->layout_height + $spacing;
}
+ $gd->startGroup() if $gd->can('startGroup');
$self->draw_background($gd,$self->{background}) if $self->{background};
$self->draw_grid($gd) if $self->{grid};
$self->draw_background($gd,$self->{postgrid}) if $self->{postgrid};
+ $gd->endGroup() if $gd->can('endGroup');
$offset = $pt;
for my $track (@{$self->{tracks}}) {
- my $draw_between = $between_key && $track->option('key');
- my $has_parts = $track->parts;
- my $side_key_height = 0;
+ $self->startGroup($gd);
+
+ my $draw_between = $between_key && $track->option('key');
+ my $has_parts = $track->parts;
+ my $side_key_height = 0;
- next if !$has_parts && ($empty_track_style eq 'suppress'
- or $empty_track_style eq 'key' && $bottom_key);
+ next if !$has_parts && ($empty_track_style eq 'suppress'
+ or $empty_track_style eq 'key' && $bottom_key);
- if ($draw_between) {
- $offset += $self->draw_between_key($gd,$track,$offset);
- }
+ if ($draw_between) {
+ $offset += $self->draw_between_key($gd,$track,$offset);
+ }
- $self->draw_empty($gd,$offset,$empty_track_style)
- if !$has_parts && $empty_track_style=~/^(line|dashed)$/;
+ $self->draw_empty($gd,$offset,$empty_track_style)
+ if !$has_parts && $empty_track_style=~/^(line|dashed)$/;
- $track->draw($gd,$pl,$offset,0,1);
+ $track->draw($gd,$pl,$offset,0,1);
- if ($self->{key_style} =~ /^(left|right)$/) {
- $side_key_height = $self->draw_side_key($gd,$track,$offset,$self->{key_style});
- }
+ if ($self->{key_style} =~ /^(left|right)$/) {
+ $side_key_height = $self->draw_side_key($gd,$track,$offset,$self->{key_style});
+ }
- $self->track_position($track,$offset);
- my $layout_height = $track->layout_height;
- $offset += ($side_key_height > $layout_height ? $side_key_height : $layout_height)+$spacing;
+ $self->track_position($track,$offset);
+ my $layout_height = $track->layout_height;
+ $offset += ($side_key_height > $layout_height ? $side_key_height : $layout_height)+$spacing;
+
+ $self->endGroup($gd);
}
+ $self->startGroup($gd);
$self->draw_bottom_key($gd,$pl,$offset) if $self->{key_style} eq 'bottom';
+ $self->endGroup($gd);
+
return $self->{gd} = $gd;
}
+sub startGroup {
+ my $self = shift;
+ my $gd = shift;
+ $gd->startGroup if $gd->can('startGroup');
+}
+sub endGroup {
+ my $self = shift;
+ my $gd = shift;
+ $gd->endGroup if $gd->can('endGroup');
+}
+
+
# Package accessors
# GD (and GD::SVG)'s new() resides in GD::Image
sub image_class { return shift->{image_class}; }
More information about the Bioperl-guts-l
mailing list