Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

fix merge

  • Loading branch information...
commit f72e32971ea5a14dbd4e324139119bf290566dca 2 parents bae9aa9 + 7efd4cb
@lstein lstein authored
Showing with 466 additions and 272 deletions.
  1. +3 −0  Changes
  2. +7 −0 MANIFEST
  3. +1 −1  lib/Bio/Graphics.pm
  4. +87 −0 lib/Bio/Graphics/GDWrapper.pm
  5. +141 −90 lib/Bio/Graphics/Glyph.pm
  6. +2 −0  lib/Bio/Graphics/Glyph/Factory.pm
  7. +1 −1  lib/Bio/Graphics/Glyph/anchored_arrow.pm
  8. +2 −2 lib/Bio/Graphics/Glyph/arrow.pm
  9. +1 −1  lib/Bio/Graphics/Glyph/cds.pm
  10. +10 −8 lib/Bio/Graphics/Glyph/dna.pm
  11. +6 −6 lib/Bio/Graphics/Glyph/dumbbell.pm
  12. +7 −9 lib/Bio/Graphics/Glyph/gene.pm
  13. +21 −16 lib/Bio/Graphics/Glyph/generic.pm
  14. +2 −2 lib/Bio/Graphics/Glyph/group.pm
  15. +28 −29 lib/Bio/Graphics/Glyph/phylo_align.pm
  16. +10 −10 lib/Bio/Graphics/Glyph/protein.pm
  17. +49 −50 lib/Bio/Graphics/Glyph/ruler_arrow.pm
  18. +3 −3 lib/Bio/Graphics/Glyph/segments.pm
  19. +2 −2 lib/Bio/Graphics/Glyph/text_in_box.pm
  20. +1 −1  lib/Bio/Graphics/Glyph/trace.pm
  21. +1 −1  lib/Bio/Graphics/Glyph/track.pm
  22. +7 −8 lib/Bio/Graphics/Glyph/transcript2.pm
  23. +4 −4 lib/Bio/Graphics/Glyph/translation.pm
  24. +5 −5 lib/Bio/Graphics/Glyph/wiggle_xyplot.pm
  25. +12 −21 lib/Bio/Graphics/Glyph/xyplot.pm
  26. +53 −2 lib/Bio/Graphics/Panel.pm
  27. BIN  t/data/t1/version14.gif
  28. BIN  t/data/t1/version14.png
  29. BIN  t/data/t2/version20.gif
  30. BIN  t/data/t2/version20.png
  31. BIN  t/data/t3/version15.gif
  32. BIN  t/data/t3/version15.png
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Perl extension Bio::Graphics.
+2.32 Fri Feb 22 15:58:10 EST 2013
+ - Add truetype support. Enable by passing -truetype=>1 to Bio::Graphics::Panel->new()
+
2.31 Tue Sep 25 22:39:43 EDT 2012
- Fix infinite loop when drawing wiggle_xyplots with z-score scaling
over regions that do not vary much.
View
7 MANIFEST
@@ -14,6 +14,7 @@ lib/Bio/Graphics/FeatureBase.pm
lib/Bio/Graphics/FeatureDir.pm
lib/Bio/Graphics/FeatureFile.pm
lib/Bio/Graphics/FeatureFile/Iterator.pm
+lib/Bio/Graphics/GDWrapper.pm
lib/Bio/Graphics/Glyph.pm
lib/Bio/Graphics/Glyph/alignment.pm
lib/Bio/Graphics/Glyph/allele_tower.pm
@@ -138,6 +139,8 @@ t/data/t1/version12.gif
t/data/t1/version12.png
t/data/t1/version13.gif
t/data/t1/version13.png
+t/data/t1/version14.gif
+t/data/t1/version14.png
t/data/t1/version2.gif
t/data/t1/version2.png
t/data/t1/version3.gif
@@ -170,6 +173,8 @@ t/data/t2/version19.gif
t/data/t2/version19.png
t/data/t2/version2.gif
t/data/t2/version2.png
+t/data/t2/version20.gif
+t/data/t2/version20.png
t/data/t2/version3.gif
t/data/t2/version3.png
t/data/t2/version4.png
@@ -192,6 +197,8 @@ t/data/t3/version13.gif
t/data/t3/version13.png
t/data/t3/version14.gif
t/data/t3/version14.png
+t/data/t3/version15.gif
+t/data/t3/version15.png
t/data/t3/version2.gif
t/data/t3/version2.png
t/data/t3/version3.gif
View
2  lib/Bio/Graphics.pm
@@ -2,7 +2,7 @@ package Bio::Graphics;
use strict;
use Bio::Graphics::Panel;
-our $VERSION = '2.31';
+our $VERSION = '2.32';
1;
View
87 lib/Bio/Graphics/GDWrapper.pm
@@ -0,0 +1,87 @@
+package Bio::Graphics::GDWrapper;
+
+use base 'GD::Image';
+use Memoize 'memoize';
+memoize('_match_font');
+
+my $DefaultFont;
+
+#from http://reeddesign.co.uk/test/points-pixels.html
+my %Pixel2Point = (
+ 8 => 6,
+ 9 => 7,
+ 10 => 7.5,
+ 11 => 8,
+ 12 => 9,
+ 13 => 10,
+ 14 => 10.5,
+ 15 =>11,
+ 16 => 12,
+ 17 => 13,
+ 18 => 13.5,
+ 19 => 14,
+ 20 => 14.5,
+ 21 => 15,
+ 22 => 16,
+ 23 => 17,
+ 24 => 18,
+ 25 => 19,
+ 26 => 20
+ );
+my $GdInit;
+
+sub new {
+ my $self = shift;
+ my ($gd,$default_font) = @_;
+ $DefaultFont = $default_font unless $default_font eq '1';
+ $gd->useFontConfig(1);
+ return bless $gd,ref $self || $self;
+}
+
+sub default_font { return $DefaultFont || 'Arial' }
+
+# print with a truetype string
+sub string {
+ my $self = shift;
+ my ($font,$x,$y,$string,$color) = @_;
+ return $self->SUPER::string(@_) if $self->isa('GD::SVG');
+ my $fontface = $self->_match_font($font);
+# warn "$font => $fontface";
+ my ($fontsize) = $fontface =~ /-(\d+)/;
+ $self->stringFT($color,$fontface,$fontsize,0,$x,$y+$fontsize+1,$string);
+}
+
+sub string_width {
+ my $self = shift;
+ my ($font,$string) = @_;
+ my $fontface = $self->_match_font($font);
+ my ($fontsize) = $fontface =~ /-([\d.]+)/;
+ my @bounds = GD::Image->stringFT(0,$fontface,$fontsize,0,0,0,$string);
+ return abs($bounds[2]-$bounds[0]);
+}
+
+sub string_height {
+ my $self = shift;
+ my ($font,$string) = @_;
+ my $fontface = $self->_match_font($font);
+ my ($fontsize) = $fontface =~ /-(\d+)/;
+ my @bounds = GD::Image->stringFT(0,$fontface,$fontsize,0,0,0,$string);
+ return abs($bounds[5]-$bounds[3]);
+}
+
+# find a truetype match for a built-in font
+sub _match_font {
+ my $self = shift;
+ my $font = shift;
+ return $font unless ref $font && $font->isa('GD::Font');
+ $GdInit++ || GD::Image->useFontConfig(1);
+ my $fh = $font->height-1;
+ my $height = $Pixel2Point{$fh} || $fh;
+ my $style = $font eq GD->gdMediumBoldFont ? 'bold'
+ :$font eq GD->gdGiantFont ? 'bold'
+ :'normal';
+ my $ttfont = $self->default_font;
+ return "$ttfont-$height:$style";
+}
+
+1;
View
231 lib/Bio/Graphics/Glyph.pm
@@ -8,12 +8,13 @@ use Bio::Graphics::Layout;
use Memoize 'memoize';
memoize('options') unless $^O =~ /mswin/i;
-# memoize('option'); # helps ??
+# memoize('option',NORMALIZER=>'_normalize_objects'); # helps ??
+my %OptionCache; # works better?
use base qw(Bio::Root::Root);
my %LAYOUT_COUNT;
-my @FEATURE_STACK;
+our @FEATURE_STACK;
# the CM1 and CM2 constants control the size of the hash used to
# detect collisions.
@@ -205,6 +206,7 @@ sub demo_feature {
return;
}
+sub gd { shift->panel->current_gd }
# a bumpable graphical object that has bumpable graphical subparts
@@ -221,6 +223,8 @@ sub new {
my $level = $arg{-level} || 0;
my $flip = $arg{-flip};
+ push @FEATURE_STACK,($feature,undef);
+
my $self = bless {},$class;
$self->{feature} = $feature;
$self->{factory} = $factory;
@@ -260,13 +264,13 @@ sub new {
$self->feature_has_subparts(@subfeatures>0);
if (@visible_subfeatures) {
- # dynamic glyph resolution
- @subglyphs = map { $_->[0] }
+ # dynamic glyph resolution
+ @subglyphs = map { $_->[0] }
sort { $a->[1] <=> $b->[1] }
map { [$_, $_->left ] }
$self->make_subglyph($level+1,@visible_subfeatures);
- $self->{feature_count} = scalar @subglyphs;
- $self->{parts} = \@subglyphs;
+ $self->{feature_count} = scalar @subglyphs;
+ $self->{parts} = \@subglyphs;
}
# warn "type=",$feature->type,", glyph=$self, subglyphs=@subglyphs";
@@ -293,7 +297,7 @@ sub new {
}
$self->{point} = $arg{-point} ? $self->height : undef;
-
+ splice(@FEATURE_STACK,-2);
return $self;
}
@@ -471,7 +475,10 @@ sub width {
}
sub layout_height {
my $self = shift;
- return $self->layout;
+ push @FEATURE_STACK,$self->feature;
+ my $result = $self->layout;
+ pop @FEATURE_STACK;
+ return $result;
}
sub layout_width {
my $self = shift;
@@ -533,90 +540,101 @@ sub unfilled_box {
sub boxes {
my $self = shift;
+ push @FEATURE_STACK,$self->feature;
+
my ($left,$top,$parent) = @_;
$top += 0; $left += 0;
my @result;
- $self->layout;
- $parent ||= $self;
- my $subparts = $self->box_subparts || 0;
-
- for my $part ($self->parts) {
- my $type = $part->feature->primary_tag || '';
- if ($type eq 'group' or $subparts > $part->level) {
- push @result,$part->boxes($left,$top+$self->top+$self->pad_top,$parent);
- next if $type eq 'group';
- }
- my ($x1,$y1,$x2,$y2) = $part->box;
- $x2++ if $x1==$x2;
- push @result,[$part->feature,
- $left + $x1,$top+$self->top+$self->pad_top+$y1,
- $left + $x2,$top+$self->top+$self->pad_top+$y2,
- $parent];
- }
-
- return wantarray ? @result : \@result;
-}
+ $self->layout;
+ $parent ||= $self;
+ my $subparts = $self->box_subparts || 0;
+
+ for my $part ($self->parts) {
+ my $type = $part->feature->primary_tag || '';
+ if ($type eq 'group' or $subparts > $part->level) {
+ push @result,$part->boxes($left,$top+$self->top+$self->pad_top,$parent);
+ next if $type eq 'group';
+ }
+ my ($x1,$y1,$x2,$y2) = $part->box;
+ $x2++ if $x1==$x2;
+ push @result,[$part->feature,
+ $left + $x1,$top+$self->top+$self->pad_top+$y1,
+ $left + $x2,$top+$self->top+$self->pad_top+$y2,
+ $parent];
+ }
+
+ pop @FEATURE_STACK;
+ return wantarray ? @result : \@result;
+ }
-sub box_subparts {
- my $self = shift;
- return $self->{box_subparts} if exists $self->{box_subparts};
- return $self->{box_subparts} = $self->_box_subparts;
-}
+ sub box_subparts {
+ my $self = shift;
+ return $self->{box_subparts} if exists $self->{box_subparts};
+ return $self->{box_subparts} = $self->_box_subparts;
+ }
-sub _box_subparts { shift->option('box_subparts') }
+ sub _box_subparts { shift->option('box_subparts') }
-# this should be overridden for labels, etc.
-# allows glyph to make itself thicker or thinner depending on
-# domain-specific knowledge
-sub pad_top {
- my $self = shift;
- return 0;
-}
-sub pad_bottom {
- my $self = shift;
- return 0;
-}
-sub pad_left {
- my $self = shift;
- my @parts = $self->parts or return 0;
- my $max = 0;
- foreach (@parts) {
- my $pl = $_->pad_left;
- $max = $pl if $max < $pl;
- }
- $max;
-}
-sub pad_right {
- my $self = shift;
- my @parts = $self->parts or return 0;
- my $max = 0;
- foreach (@parts) {
- my $pr = $_->pad_right;
- $max = $pr if $max < $pr;
- }
- $max;
-}
+ # this should be overridden for labels, etc.
+ # allows glyph to make itself thicker or thinner depending on
+ # domain-specific knowledge
+ sub pad_top {
+ my $self = shift;
+ return 0;
+ }
+ sub pad_bottom {
+ my $self = shift;
+ return 0;
+ }
+ sub pad_left {
+ my $self = shift;
+ my @parts = $self->parts or return 0;
+ my $max = 0;
+ foreach (@parts) {
+ my $pl = $_->pad_left;
+ $max = $pl if $max < $pl;
+ }
+ $max;
+ }
+ sub pad_right {
+ my $self = shift;
+ my @parts = $self->parts or return 0;
+ my $max = 0;
+ my $max_right = 0;
+ foreach (@parts) {
+ my $right = $_->right;
+ my $pr = $_->pad_right;
+ if ($max_right < $pr+$right) {
+ $max = $pr;
+ $max_right = $pr+$right;
+ }
+ }
+ $max;
+ }
-# move relative to parent
-sub move {
- my $self = shift;
- my ($dx,$dy) = @_;
- $self->{left} += $dx;
- $self->{top} += $dy;
+ # move relative to parent
+ sub move {
+ my $self = shift;
+ my ($dx,$dy) = @_;
+ $self->{left} += $dx;
+ $self->{top} += $dy;
- # because the feature parts use *absolute* not relative addressing
- # we need to move each of the parts horizontally, but not vertically
- $_->move($dx,0) foreach $self->parts;
-}
+ # because the feature parts use *absolute* not relative addressing
+ # we need to move each of the parts horizontally, but not vertically
+ $_->move($dx,0) foreach $self->parts;
+ }
-# get an option
-sub option {
- my $self = shift;
- my $option_name = shift;
- my @args = ($option_name,@{$self}{qw(partno total_parts)});
- my $factory = $self->{factory} or return;
- return $factory->option($self,@args)
+ # get an option
+ sub option {
+ my $self = shift;
+ my $option_name = shift;
+ local $^W=0;
+ my $cache_key = join ';',(%$self,$option_name);
+ return $OptionCache{$cache_key} if exists $OptionCache{$cache_key};
+ my @args = ($option_name,@{$self}{qw(partno total_parts)});
+ my $factory = $self->{factory} or return;
+ return $OptionCache{$cache_key} = $factory->option($self,@args);
}
# get an option that might be a code reference
@@ -764,7 +782,7 @@ sub getfont {
my $img_class = $self->image_class;
- unless (UNIVERSAL::isa($font,$img_class . '::Font')) {
+ if (!UNIVERSAL::isa($font,$img_class . '::Font') && $font =~ /^(gd|sanserif)/) {
my $ref = {
gdTinyFont => $img_class->gdTinyFont(),
gdSmallFont => $img_class->gdSmallFont(),
@@ -848,6 +866,7 @@ sub layout_sort {
# handle collision detection
sub layout {
my $self = shift;
+
return $self->{layout_height} if exists $self->{layout_height};
my @parts = $self->parts;
@@ -1028,7 +1047,7 @@ sub optimized_layout {
$_->{layout_height}+BUMP_SPACING
]
} $self->layout_sort(@$parts);
-
+
my $layout = Bio::Graphics::Layout->new(0,$self->panel->right);
my $overbumped;
while (@rects) {
@@ -1044,13 +1063,18 @@ sub optimized_layout {
return $overbumped && $overbumped < $layout->totalHeight ? $overbumped : $layout->totalHeight;
}
+sub draw_it {
+ my $self = shift;
+ push @FEATURE_STACK,$self->feature;
+ $self->draw(@_);
+ pop @FEATURE_STACK;
+}
+
sub draw {
my $self = shift;
my $gd = shift;
my ($left,$top,$partno,$total_parts) = @_;
- push @FEATURE_STACK,$self->feature;
-
$self->panel->startGroup($gd);
my $connector = $self->connector;
@@ -1083,9 +1107,6 @@ sub draw {
}
$self->panel->endGroup($gd);
-
- pop @FEATURE_STACK;
-
}
sub connector { return }
@@ -1110,6 +1131,7 @@ sub parent_feature {
$ancestors = 1 unless defined $ancestors;
return unless @FEATURE_STACK;
+
my $index = $#FEATURE_STACK - $ancestors;
return unless $index >= 0;
return $FEATURE_STACK[$index];
@@ -1467,6 +1489,30 @@ sub linewidth {
shift->option('linewidth') || 1;
}
+sub font_width {
+ my $self = shift;
+ my $font = shift;
+ $self->panel->string_width($font||$self->font,'m');
+}
+
+sub font_height {
+ my $self = shift;
+ my $font = shift;
+ $self->panel->string_height($font||$self->font,'hj');
+}
+
+sub string_width {
+ my $self = shift;
+ my ($string,$font) = @_;
+ $self->panel->string_width($font||$self->font,$string||'m');
+}
+
+sub string_height {
+ my $self = shift;
+ my ($string,$font) = @_;
+ $self->panel->string_height($font||$self->font,$string||'hj');
+}
+
sub fill {
my $self = shift;
my $gd = shift;
@@ -1821,7 +1867,12 @@ sub _pod_options {
return $pod;
}
-
+# normalizer for memoize
+sub _normalize_objects {
+ my ($obj,$option_name) = @_;
+ my @args = (%$obj,$option_name);
+ return "@args";
+}
1;
View
2  lib/Bio/Graphics/Glyph/Factory.pm
@@ -53,6 +53,8 @@ use strict;
use Carp qw(:DEFAULT cluck);
use Bio::Root::Version;
use base qw(Bio::Root::Root);
+#use Memoize 'memoize';
+#memoize('option');
my %LOADED_GLYPHS = ();
my %GENERIC_OPTIONS = (
View
2  lib/Bio/Graphics/Glyph/anchored_arrow.pm
@@ -48,7 +48,7 @@ sub draw_label {
my $x = $self->left + $left;
my $font = $self->option('labelfont') || $self->font;
my $middle = $self->left + $left + ($self->right - $self->left) / 2;
- my $label_width = $font->width * length($label);
+ my $label_width = $self->string_width($label,$font);
if ($label_align eq 'center') {
my $new_x = $middle - $label_width / 2;
$x = $new_x if ($new_x > $x);;
View
4 lib/Bio/Graphics/Glyph/arrow.pm
@@ -113,7 +113,7 @@ my %UNITS = (p => 1e-12,
sub pad_bottom {
my $self = shift;
my $val = $self->SUPER::pad_bottom(@_);
- $val += $self->font->height if $self->option('tick');
+ $val += $self->string_height($self->font) if $self->option('tick');
$val;
}
@@ -190,7 +190,7 @@ sub draw_parallel {
if ($self->option('tick')) {
local $^W = 0; # dumb uninitialized variable warning
my $font = $self->font;
- my $width = $font->width;
+ my $width = $self->string_width('m',$font);
my $font_color = $self->fontcolor;
my $height = $self->height;
View
2  lib/Bio/Graphics/Glyph/cds.pm
@@ -284,7 +284,7 @@ sub draw_component {
}
# we get here if there's room to draw the primary sequence
- my $font = $self->font;
+ my $font = $self->mono_font;
my $pixels_per_residue = $self->pixels_per_residue;
my $strand = $feature->strand;
my $y = $y1-1;
View
18 lib/Bio/Graphics/Glyph/dna.pm
@@ -59,7 +59,7 @@ sub description { 0 }
sub pad_top {
my $self = shift;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $pt = $self->SUPER::pad_top;
return $self->dna_fits
? $pt + $font->height+5
@@ -68,7 +68,7 @@ sub pad_top {
sub height {
my $self = shift;
- my $font = $self->font;
+ my $font = $self->mono_font;
return $self->dna_fits ? 2*$font->height
: $self->do_gc ? $self->SUPER::height
: 0;
@@ -113,7 +113,7 @@ sub draw_dna {
my @bases = split '',$strand >= 0 ? $dna : $self->reversec($dna);
my $color = $self->fgcolor;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $lineheight = $font->height;
$y1 -= $lineheight/2 - 3;
my $strands = $self->option('strand') || 'auto';
@@ -147,6 +147,7 @@ sub draw_gc_content {
my ($x1,$y1,$x2,$y2) = @_;
$dna = $self->reversec($dna) if $self->{flip};
+ my $font = $self->mono_font;
# get the options that tell us how to draw the GC content
@@ -234,7 +235,7 @@ sub draw_gc_content {
my $axiscolor = $self->color('axis_color') || $fgcolor;
# Draw the axes
- my $fontwidth = $self->font->width;
+ my $fontwidth = $font->width;
$gd->line($x1, $y1, $x1, $y2, $axiscolor);
$gd->line($x2-2,$y1, $x2-2,$y2, $axiscolor);
$gd->line($x1, $y1, $x1+3,$y1, $axiscolor);
@@ -246,15 +247,16 @@ sub draw_gc_content {
$gd->line($x1+5,$y2, $x2-5,$y2, $bgcolor);
$gd->line($x1+5,($y2+$y1)/2,$x2-5,($y2+$y1)/2,$bgcolor);
$gd->line($x1+5,$y1, $x2-5,$y1, $bgcolor);
- $gd->string($self->font,$x1-length('% gc')*$fontwidth,$y1,'% gc',$axiscolor) if $bin_height > $self->font->height*2;
+ $gd->string($self->font,$x1-$self->string_width('% gc',$self->font),$y1,'% gc',$axiscolor)
+ if $bin_height > $self->font_height($font)*2;
# If we are using a sliding window, the GC graph will be scaled to use the full
# height of the glyph, so label the right vertical axis to show the scaling that# is in effect
$gd->string($self->font,$x2+3,$y1,"${maxgc}%",$axiscolor)
- if $bin_height > $self->font->height*2.5;
- $gd->string($self->font,$x2+3,$y2-$self->font->height,"${mingc}%",$axiscolor)
- if $bin_height > $self->font->height*2.5;
+ if $bin_height > $self->font_height*2.5;
+ $gd->string($self->font,$x2+3,$y2-$self->font_height,"${mingc}%",$axiscolor)
+ if $bin_height > $self->font_height*2.5;
# Draw the GC content graph itself
View
12 lib/Bio/Graphics/Glyph/dumbbell.pm
@@ -215,14 +215,14 @@ sub draw_end_bubble
my $bubble_text = defined $self->option('bubble_text') ? $self->option('bubble_text') : "Text";
my $font = $self->option('labelfont') || $self->font;
- my $bubble_text_length = $font->width * length($bubble_text);
- my $bubble_text_x = $midX - $bubble_text_length / 2;
- my $bubble_text_y = $midY - $font->height / 2;
+ my $bubble_text_length = $self->string_width($bubble_text,$font);
+ my $bubble_text_x = $midX - $bubble_text_length/2;
+ my $bubble_text_y = $midY - $self->font_height($font)/2;
$gd->string($font, $bubble_text_x, $bubble_text_y, $bubble_text, $self->fontcolor);
my $oval_width = $bubble_text_length * 1.414;
- my $oval_height = $font->height * 1.414;
+ my $oval_height = $self->font_height($font) * 1.414;
$self->oval($gd, $midX-$oval_width/2, $midY-$oval_height/2, $midX+$oval_width/2, $midY+$oval_height/2);
@@ -325,8 +325,8 @@ sub draw_component {
{
my $font = $self->option('labelfont') || $self->font;
my $midX = ($x2-$x1-2*$shape_size)/2+$x1+$shape_size;
- my $startCaption = $midX - $font->width * length($caption) / 2;
- $gd->string($font, $startCaption, $midY-$font->height, $caption, $self->fontcolor);
+ my $startCaption = $midX - $self->string_width($caption,$font)/2;
+ $gd->string($font, $startCaption, $midY-$self->font_height($font), $caption, $self->fontcolor);
}
}
View
16 lib/Bio/Graphics/Glyph/gene.pm
@@ -59,6 +59,9 @@ sub my_options {
sub extra_arrow_length {
my $self = shift;
+ return 0 if $self->feature->primary_tag =~ /exon|utr/i;
+ return $self->SUPER::extra_arrow_length
+ unless $self->feature->primary_tag =~ /gene/;
return 0 unless $self->{level} == 1;
local $self->{level} = 0; # fake out superclass
return $self->SUPER::extra_arrow_length;
@@ -67,19 +70,14 @@ sub extra_arrow_length {
sub pad_left {
my $self = shift;
my $type = $self->feature->primary_tag;
- return 0 unless $type =~ /gene|mRNA/;
+ return 0 unless $type =~ /gene|mRNA|transcript/;
$self->SUPER::pad_left;
}
sub pad_right {
my $self = shift;
return 0 unless $self->{level} < 2; # don't invoke this expensive call on exons
- my $strand = $self->feature->strand;
- $strand *= -1 if $self->{flip};
- my $pad = $self->SUPER::pad_right;
- return $pad unless defined($strand) && $strand > 0;
- my $al = $self->arrow_length;
- return $al > $pad ? $al : $pad;
+ return $self->SUPER::pad_right;
}
sub pad_bottom {
@@ -110,8 +108,8 @@ sub bump {
sub label {
my $self = shift;
return unless $self->{level} < 2;
- if ($self->label_transcripts && $self->{feature}->primary_tag =~ /RNA|pseudogene/i) {
- return $self->_label;
+ if ($self->{feature}->primary_tag =~ /rna|transcript|pseudogene/i && $self->label_transcripts) {
+ return $self->_label;
} else {
return $self->SUPER::label;
}
View
37 lib/Bio/Graphics/Glyph/generic.pm
@@ -3,6 +3,9 @@ package Bio::Graphics::Glyph::generic;
use strict;
use Bio::Graphics::Util qw(frame_and_offset);
use base qw(Bio::Graphics::Glyph);
+use Memoize 'memoize';
+#memoize('pad_left');
+#memoize('pad_right');
my %complement = (g=>'c',a=>'t',t=>'a',c=>'g',
G=>'C',A=>'T',T=>'A',C=>'G');
@@ -137,6 +140,10 @@ sub connector_color {
my $self = shift;
$self->color('connector_color') || $self->fgcolor;
}
+sub mono_font {
+ return GD->gdSmallFont;
+}
+
sub font {
my $self = shift;
return $self->getfont('font','gdSmallFont');
@@ -170,7 +177,7 @@ sub height {
$self->option('draw_translation') && $self->protein_fits
or
$self->option('draw_dna') && $self->dna_fits;
- my $fh = $self->font->height + 2;
+ my $fh = $self->font_height + 2;
return $h > $fh ? $h : $fh;
}
@@ -187,8 +194,8 @@ sub pad_bottom {
my $bottom = $self->option('pad_bottom');
return $bottom if defined $bottom;
my $pad = $self->SUPER::pad_bottom;
- $pad += $self->labelheight if $self->description;
- $pad += $self->labelheight if $self->part_labels && $self->label_position eq 'top';
+ $pad += $self->labelheight+6 if $self->description;
+ $pad += $self->labelheight+6 if $self->part_labels && $self->label_position eq 'top';
$pad;
}
sub pad_right {
@@ -205,7 +212,7 @@ sub pad_left {
my $self = shift;
my $pad = $self->SUPER::pad_left;
return $pad unless $self->label_position eq 'left' && $self->label;
- $pad += $self->labelwidth;
+ $pad += $self->labelwidth + 3;
$pad;
}
sub labelfont {
@@ -218,15 +225,15 @@ sub descfont {
}
sub labelwidth {
my $self = shift;
- return $self->{labelwidth} ||= length($self->label||'') * $self->font->width;
+ return $self->{labelwidth} ||= $self->string_width($self->label||'',$self->labelfont);
}
sub descriptionwidth {
my $self = shift;
- return $self->{descriptionwidth} ||= length($self->description||'') * $self->font->width;
+ return $self->{descriptionwidth} ||= $self->string_width($self->description||'',$self->descfont);
}
sub labelheight {
my $self = shift;
- return $self->{labelheight} ||= $self->font->height;
+ return $self->{labelheight} ||= $self->string_height($self->labelfont);
}
sub label_position {
my $self = shift;
@@ -359,7 +366,7 @@ sub draw_translation {
my $feature = $self->feature;
my $strand = $feature->strand;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $pixels_per_residue = $self->scale * 3;
my $y = $y1 + ($self->height - $font->height)/2;
@@ -410,7 +417,7 @@ sub draw_sequence {
my $feature = $self->feature;
my $strand = $feature->strand;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $pixels_per_base = $self->scale;
my $y = $y1 + ($self->height - $font->height)/2 - 1;
@@ -471,7 +478,7 @@ sub draw_label {
$self->top + $top - 1,
$label);
} elsif ($self->label_position eq 'left') {
- my $y = $self->{top} + ($self->height - $font->height)/2 + $top;
+ my $y = $self->{top} + ($self->height - $self->string_height($font))/2 + $top;
$y = $self->{top} + $top if $y < $self->{top} + $top;
$self->render_label($gd,
$font,
@@ -514,7 +521,7 @@ sub draw_description {
$gd->string($self->descfont,
$left,
- $bottom,
+ $bottom-3,
$label,
$self->descriptioncolor);
}
@@ -592,17 +599,15 @@ sub dna_fits {
my $self = shift;
my $pixels_per_base = $self->scale;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $font_width = $font->width;
-
+
return $pixels_per_base >= $font_width;
}
sub protein_fits {
my $self = shift;
- my $font = $self->font;
-
- # return unless $font->height <= $self->height;
+ my $font = $self->mono_font;
my $font_width = $font->width;
my $pixels_per_residue = $self->scale * 3;
View
4 lib/Bio/Graphics/Glyph/group.pm
@@ -50,7 +50,7 @@ sub labelfont {
sub pad_left {
my $self = shift;
return 0 unless $self->option('group_label');
- return length($self->label||'') * $self->labelfont->width+3;
+ return $self->string_width($self->label,$self->labelfont) +3;
}
sub draw {
@@ -76,7 +76,7 @@ sub draw_label {
$x = $panel->left + 1 if $x <= $panel->left;
$y = $self->top + $top - 1;
} elsif ($self->label_position eq 'left') {
- $y = $self->{top} + ($self->height - $font->height)/2 + $top;
+ $y = $self->{top} + ($self->height - $self->font_height($font))/2 + $top;
$y = $self->{top} + $top if $y < $self->{top} + $top;
}
$panel->add_key_box($self,$label,$x,$y);
View
57 lib/Bio/Graphics/Glyph/phylo_align.pm
@@ -21,7 +21,7 @@ sub description { 0 }
sub height {
my $self = shift;
- my $font = $self->font;
+ my $font = $self->mono_font;
#adjust the space to take if conservation scores are drawn instead
if (! $self->dna_fits) {
@@ -124,13 +124,11 @@ sub unknown_species {
$refspecies = $_[1];
@current_species = @{$_[2]};
@known_species = @{$_[3]};
- @unknown_species;
} else {
%alignments = $self->extract_features;
$refspecies = $self->option('reference_species');
@current_species = keys %alignments; #all species in viewing window
@known_species = $self->known_species; #all species from cladogram info
- @unknown_species; #species in GFF but not in clado
} #would have combined the two cases into one line using || but Perl will treat the arrays as num of elem
#do set subtraction to see which species in viewing range but not in tree
@@ -217,8 +215,9 @@ sub draw_clado {
my @nodes = $root->get_all_Descendents;
#draw bg for cladogram
+ my $font = $self->mono_font;
my $clado_bg = $self->color('clado_bg') || $self->bgcolor;
- my @coords = (0, $y1, $start_x+$xoffset+$self->font->width-1, $y2+1);
+ my @coords = (0, $y1, $start_x+$xoffset+$font->width-1, $y2+1);
my @coords2 = ($x1, $y1, $start_x+$xoffset/2, $y2);
if ($draw_clado_left) {
$gd->filledRectangle(@coords, $clado_bg);
@@ -381,7 +380,8 @@ sub get_legend_and_scale {
#main method that draws everything
sub draw {
my $self = shift;
- my $height = $self->font->height;
+ my $font = $self->mono_font;
+ my $height = $font->height;
my $scale = $self->scale;
my $gd = shift;
@@ -396,12 +396,12 @@ sub draw {
#spacing of either DNA alignments or score histograms in units of font height
my $species_spacing = $self->option('species_spacing') || 1;
- my $xscale = $self->font->width;
+ my $xscale = $font->width;
my $yscale = $height * $species_spacing;
my $xoffset = $x1;
- my $yoffset = $y1 + 0.5*$self->font->height;
+ my $yoffset = $y1 + 0.5*$font->height;
#method that reads the tree file to create the tree objects
my $tree = $self->set_tree;
@@ -468,14 +468,14 @@ sub draw {
$dna = $dna->seq if ref($dna) and $dna->can('seq'); # to catch Bio::PrimarySeqI objects
my $bg_color = $self->color('ref_color') || $self->bgcolor;
- $fy2 = $fy1 + $self->font->height || $y2;
+ $fy2 = $fy1 + $font->height || $y2;
$self->_draw_dna($gd,$dna,$fx1,$fy1,$fx2,$fy2, $self->fgcolor, $bg_color);
} else {
}
- my $x_label_start = $start_x + $xoffset + $self->font->width;
+ my $x_label_start = $start_x + $xoffset + $font->width;
$self->species_label($gd, $draw_clado_left, $x_label_start, $y, $species) unless ($self->option('hide_label'));
$y += $yscale;
@@ -485,7 +485,7 @@ sub draw {
#skip if the there is no alignments for this species in this window
unless ($alignments{$species}) {
- my $x_label_start = $start_x + $xoffset + $self->font->width;
+ my $x_label_start = $start_x + $xoffset + $font->width;
$self->species_label($gd, $draw_clado_left, $x_label_start, $y, $species) unless ($self->option('hide_label'));
$y += $yscale;
@@ -578,7 +578,7 @@ sub draw {
#label the species in the cladogram
- my $x_label_start = $start_x + $xoffset + $self->font->width;
+ my $x_label_start = $start_x + $xoffset + $font->width;
$self->species_label($gd, $draw_clado_left, $x_label_start, $y, $species) unless ($self->option('hide_label'));
$y += $yscale;
@@ -599,24 +599,26 @@ sub species_label {
my $y_start = shift;
my $species = shift;
+ my $font = $self->mono_font;
+
$x_start += 2;
- my $text_width = $self->font->width * length($species);
+ my $text_width = $font->width * length($species);
my $bgcolor = $self->color('bg_color');
#make label
if ($draw_clado_left) {
- $gd->filledRectangle($x_start-2, $y_start, $x_start + $text_width, $y_start+$self->font->height, $bgcolor);
- $gd->rectangle($x_start-2, $y_start, $x_start + $text_width, $y_start+$self->font->height, $self->fgcolor);
- $gd->string($self->font, $x_start, $y_start, $species, $self->fgcolor);
+ $gd->filledRectangle($x_start-2, $y_start, $x_start + $text_width, $y_start+$font->height, $bgcolor);
+ $gd->rectangle($x_start-2, $y_start, $x_start + $text_width, $y_start+$font->height, $self->fgcolor);
+ $gd->string($font, $x_start, $y_start, $species, $self->fgcolor);
} else {
my ($x_max, $y_max) = $gd->getBounds;
my $write_pos = $x_max - $x_start - $text_width;
- $gd->filledRectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$self->font->height, $bgcolor);
- $gd->rectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$self->font->height, $self->fgcolor);
- $gd->string($self->font, $write_pos+2, $y_start, $species, $self->fgcolor);
+ $gd->filledRectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$font->height, $bgcolor);
+ $gd->rectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$font->height, $self->fgcolor);
+ $gd->string($font, $write_pos+2, $y_start, $species, $self->fgcolor);
}
}
@@ -627,7 +629,7 @@ sub draw_pairwisegraph_axis {
my $self = shift;
my ($gd, $graph_legend, $x1, $x2, $y_track_top, $y_track_bottom, $draw_clado_left, @bounds) = @_;
-
+ my $font = $self->mono_font;
my $axis_color = $self->color('axis_color') || $self->fgcolor;
my $mid_axis_color = $self->color('mid_axis_color') || $axis_color;
@@ -647,15 +649,15 @@ sub draw_pairwisegraph_axis {
$coords[0] = $bounds[0] - $coords[0];
$coords[2] = $bounds[0] - $coords[2];
- my $x_text_offset = length($label) * $self->font->width;
+ my $x_text_offset = length($label) * $font->width;
- $gd->string($self->font, $coords[0]-$x_text_offset, $coords[1], $label, $self->fgcolor);
+ $gd->string($font, $coords[0]-$x_text_offset, $coords[1], $label, $self->fgcolor);
$gd->line(@coords, $self->fgcolor);
$gd->line($x2,$y_track_top,$x2,$y_track_bottom,$self->fgcolor);
} else {
#draw the legned on the left
- $gd->string($self->font, @coords[0..1], $label, $self->fgcolor);
+ $gd->string($font, @coords[0..1], $label, $self->fgcolor);
$gd->line(@coords, $self->fgcolor);
$gd->line($x1,$y_track_top,$x1,$y_track_bottom,$self->fgcolor);
@@ -942,7 +944,7 @@ sub draw_log10_rectangle {
my $graph_scale = shift;
my $zero_y = shift;
my $y1 = shift;
- my $zero_y = shift;
+ $zero_y = shift; # oy vey - this will be overwritten
my $x_left = shift;
my $x_right = shift;
my $gd = shift;
@@ -969,8 +971,9 @@ sub draw_dna {
my $fgcolor = $self->fgcolor;
my $bg_color = $self->color('targ_color') || $self->bgcolor;
my $errcolor = $self->color('errcolor') || $fgcolor;
+ my $font = $self->mono_font;
- $y2 = $y1 + $self->font->height || $y2;
+ $y2 = $y1 + $font->height || $y2;
@@ -1025,10 +1028,6 @@ sub _draw_dna {
$gd->filledRectangle($x1+1, $y1, $x2, $y2, $bg_color);
}
-
- my $feature = $self->feature;
-
-
my $strand = $feature->strand || 1;
$strand *= -1 if $self->{flip};
@@ -1039,7 +1038,7 @@ sub _draw_dna {
$color = $self->fgcolor unless $color;
$bg_color = 0 unless $bg_color;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $lineheight = $font->height;
# $y1 -= $lineheight/2 - 3; ##################NOT SURE WHY THIS WAS HERE BEFORE
my $strands = $self->option('strand') || 'auto';
View
20 lib/Bio/Graphics/Glyph/protein.pm
@@ -12,7 +12,7 @@ sub description { 0 }
sub height {
my $self = shift;
- my $font = $self->font;
+ my $font = $self->mono_font;
return $self->dna_fits ? 2 * $font->height
: $self->do_kd ? $self->SUPER::height
: 0;
@@ -53,7 +53,7 @@ sub draw_protein {
my @bases = split '', $protein;
my $color = $self->fgcolor;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $lineheight = $font->height;
$y1 -= $lineheight/2 - 3;
@@ -152,14 +152,14 @@ sub draw_kd_plot {
$gd->line($x1+5,($y2+$y1)/2,$x2-5,($y2+$y1)/2,$bgcolor);
$gd->line($x1+5,$y1, $x2-5,$y1, $bgcolor);
my $label = 'Kyte-Doolittle hydropathy plot';
- $gd->string($self->font,$x1+5,$y1,$label,$axiscolor)
- if $bin_height > $self->font->height*2 &&
- $self->width > $self->font->width*length($label);
-
- $gd->string($self->font,$x2-20,$y1,$maxkd,$axiscolor)
- if $bin_height > $self->font->height*2.5;
- $gd->string($self->font,$x2-20,$y2-$self->font->height,$minkd,$axiscolor)
- if $bin_height > $self->font->height*2.5;
+ $gd->string($self->mono_font,$x1+5,$y1,$label,$axiscolor)
+ if $bin_height > $self->mono_font->height*2 &&
+ $self->width > $self->mono_font->width*length($label);
+
+ $gd->string($self->mono_font,$x2-20,$y1,$maxkd,$axiscolor)
+ if $bin_height > $self->mono_font->height*2.5;
+ $gd->string($self->mono_font,$x2-20,$y2-$self->mono_font->height,$minkd,$axiscolor)
+ if $bin_height > $self->mono_font->height*2.5;
my $graphwidth = $x2 - $x1;
$scale = $graphwidth / (@datapoints + $kd_window - 1);
View
99 lib/Bio/Graphics/Glyph/ruler_arrow.pm
@@ -19,7 +19,7 @@ my %UNITS = (K => 1000,
sub pad_bottom {
my $self = shift;
my $val = $self->SUPER::pad_bottom(@_);
- $val += $self->font->height if $self->option('tick');
+ $val += $self->font_height if $self->option('tick');
$val;
}
@@ -89,55 +89,54 @@ sub draw_parallel {
# turn on ticks
if ($self->option('tick')) {
local $^W = 0; # dumb uninitialized variable warning
- my $font = $self->font;
- my $width = $font->width;
- my $font_color = $self->fontcolor;
- my $height = $self->height;
-
- my $relative = $self->option('relative_coords');
- my $start = $relative ? 1 : $self->feature->start;
- my $stop = $start + $self->feature->length - 1;
-
- my $offset = $relative ? $self->feature->start-1 : 0;
- my $reversed = $self->feature->strand < 0;
-
- my $units = $self->option('units') || '';
- my $divisor = $UNITS{$units} || 1 if $units;
-
- my ($major_ticks,$minor_ticks) = $self->panel->ticks($start,$stop,$font,$divisor);
-
- ## Does the user want to override the internal scale?
- my $scale = $self->option('scale');
-
- my $left = $sw ? $x1+$height : $x1;
- my $right = $ne ? $x2-$height : $x2;
-
- my $format = ($major_ticks->[1]-$major_ticks->[0])/($divisor||1) < 1 ? "%.1f$units" : "%d$units";
-
- for my $i (@$major_ticks) {
- my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
- : $self->map_pt($i + $offset));
- next if $tickpos < $left or $tickpos > $right;
- $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
- my $label = $scale ? $i / $scale : $i;
- if ($units) {
- my $scaled = $label/$divisor;
- $label = sprintf($format,$scaled);
+ my $font = $self->font;
+ my $font_color = $self->fontcolor;
+ my $height = $self->height;
+
+ my $relative = $self->option('relative_coords');
+ my $start = $relative ? 1 : $self->feature->start;
+ my $stop = $start + $self->feature->length - 1;
+
+ my $offset = $relative ? $self->feature->start-1 : 0;
+ my $reversed = $self->feature->strand < 0;
+
+ my $units = $self->option('units') || '';
+ my $divisor = $UNITS{$units} || 1 if $units;
+
+ my ($major_ticks,$minor_ticks) = $self->panel->ticks($start,$stop,$font,$divisor);
+
+ ## Does the user want to override the internal scale?
+ my $scale = $self->option('scale');
+
+ my $left = $sw ? $x1+$height : $x1;
+ my $right = $ne ? $x2-$height : $x2;
+
+ my $format = ($major_ticks->[1]-$major_ticks->[0])/($divisor||1) < 1 ? "%.1f$units" : "%d$units";
+
+ for my $i (@$major_ticks) {
+ my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
+ : $self->map_pt($i + $offset));
+ next if $tickpos < $left or $tickpos > $right;
+ $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
+ my $label = $scale ? $i / $scale : $i;
+ if ($units) {
+ my $scaled = $label/$divisor;
+ $label = sprintf($format,$scaled);
+ }
+ my $middle = $tickpos - $self->string_width($label)/2;
+ $gd->string($font,$middle,$center+$a2-1,$label,$font_color)
+ unless ($self->option('no_tick_label'));
}
- my $middle = $tickpos - (length($label) * $width)/2;
- $gd->string($font,$middle,$center+$a2-1,$label,$font_color)
- unless ($self->option('no_tick_label'));
- }
-
- if ($self->option('tick') >= 2) {
- my $a4 = $self->height/4;
- for my $i (@$minor_ticks) {
- my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
- : $self->map_pt($i + $offset));
- next if $tickpos < $left or $tickpos > $right;
- $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);
+
+ if ($self->option('tick') >= 2) {
+ my $a4 = $self->height/4;
+ for my $i (@$minor_ticks) {
+ my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
+ : $self->map_pt($i + $offset));
+ next if $tickpos < $left or $tickpos > $right;
+ $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);
+ }
}
- }
}
# add a label if requested
@@ -196,7 +195,7 @@ sub draw_label {
$self->top + $top,
$top_left_label,
$self->fontcolor);
- my $x1 = $left + $self->panel->right - $font->width*length($label3);
+ my $x1 = $left + $self->panel->right - $self->string_width($label3);
$gd->string($font,
$x1,
$self->top + $top,
@@ -208,7 +207,7 @@ sub draw_label {
$self->bottom - $self->pad_bottom + $top,
$label3,
$self->fontcolor);
- my $x1 = $left + $self->panel->right - $font->width*length($label5);
+ my $x1 = $left + $self->panel->right - $self->string_width($label5);
$gd->string($font,
$x1,
$self->bottom - $self->pad_bottom + $top,
View
6 lib/Bio/Graphics/Glyph/segments.pm
@@ -174,7 +174,7 @@ sub pad_right {
sub labelwidth {
my $self = shift;
return $self->SUPER::labelwidth unless $self->draw_target && $self->dna_fits && $self->label_position eq 'left';
- return $self->{labelwidth} ||= (length($self->label||'')+1) * $self->font->width;
+ return $self->{labelwidth} ||= (length($self->label||'')+1) * $self->mono_font->width;
}
sub draw_target {
my $self = shift;
@@ -199,7 +199,7 @@ sub height {
if ($self->draw_protein_target) {
return $height unless $self->protein_fits;
}
- my $fontheight = $self->font->height;
+ my $fontheight = $self->mono_font->height;
return $fontheight if $fontheight > $height;
}
@@ -705,7 +705,7 @@ sub draw_multiple_alignment {
my ($red,$green,$blue) = $self->panel->rgb($bgcolor);
my $avg = ($red+$green+$blue)/3;
my $color = $self->translate_color($avg > 128 ? 'black' : 'white');
- my $font = $self->font;
+ my $font = $self->mono_font;
my $lineheight = $font->height;
my $fontwidth = $font->width;
View
4 lib/Bio/Graphics/Glyph/text_in_box.pm
@@ -25,8 +25,8 @@ sub draw_component {
my $text = defined $self->option('text') ? $self->option('text') : $self->default_text();
my $text_pad = defined $self->option('text_pad') ? $self->option('text_pad') : $self->default_text_pad();
- my $width = $font->width * length $text;
- my $height = $font->height;
+ my $width = $self->string_width($text);
+ my $height = $self->font_height;
my $midY = ($y2+$y1) / 2;
View
2  lib/Bio/Graphics/Glyph/trace.pm
@@ -388,7 +388,7 @@ sub draw_component {
}
# Get Text Info
- my $font = $self->font;
+ my $font = $self->mono_font;
my $text_buffer = 2;
my $text_height = $font->height + ( $text_buffer * 2 );
View
2  lib/Bio/Graphics/Glyph/track.pm
@@ -51,7 +51,7 @@ sub draw {
local $Bio::Graphics::Panel::GlyphScratch; # set $GlyphScratch to undef
for (my $i=0; $i<@parts; $i++) {
$parts[$i]->draw_highlight($gd,$left,$top);
- $parts[$i]->draw($gd,$left,$top,0,1);
+ $parts[$i]->draw_it($gd,$left,$top,0,1);
}
$gd->clip(@clip) if @clip;
View
15 lib/Bio/Graphics/Glyph/transcript2.pm
@@ -16,8 +16,9 @@ sub extra_arrow_length {
my $self = shift;
my $strand = $self->feature->strand || 0;
$strand *= -1 if $self->{flip};
- return 0 unless $strand < 0;
- my $first = ($self->parts)[0] || $self;
+ my $first = $strand < 0 ? ($self->parts)[0]
+ : ($self->parts)[-1];
+ $first ||= $self;
my @rect = $first->bounds();
my $width = abs($rect[2] - $rect[0]);
return 0 if $width >= MIN_WIDTH_FOR_ARROW;
@@ -27,6 +28,7 @@ sub extra_arrow_length {
sub pad_left {
my $self = shift;
my $pad = $self->Bio::Graphics::Glyph::generic::pad_left;
+ return $pad if $self->feature->strand > 0;
my $extra_arrow_length = $self->extra_arrow_length;
if ($self->label_position eq 'left' && $self->label) {
return $extra_arrow_length+$pad;
@@ -38,12 +40,9 @@ sub pad_left {
sub pad_right {
my $self = shift;
my $pad = $self->Bio::Graphics::Glyph::generic::pad_right;
- return $pad if $self->{level} > 0;
- my $last = ($self->parts)[-1] || $self;
- my @rect = $last->bounds();
- my $width = abs($rect[2] - $rect[0]);
- return $self->SUPER::pad_right if $width < MIN_WIDTH_FOR_ARROW;
- return $pad
+ return $pad if $self->feature->strand < 0;
+ my $extra_arrow_length = $self->extra_arrow_length;
+ return $extra_arrow_length > $pad ? $extra_arrow_length : $pad;
}
sub draw_connectors {
View
8 lib/Bio/Graphics/Glyph/translation.pm
@@ -26,7 +26,7 @@ sub default_color {
sub height {
my $self = shift;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $lines = $self->translation_type eq '3frame' ? 3
: $self->translation_type eq '6frame' ? 6
: 1;
@@ -69,7 +69,7 @@ sub longprotein_fits {
return unless $self->show_sequence;
my $pixels_per_residue = $self->pixels_per_residue;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $font_width = $font->width * 4; # not 3; leave room for whitespace
return $pixels_per_residue >= $font_width;
@@ -175,7 +175,7 @@ sub draw_frame {
my $awo = 0;
if ($self->protein_fits) {
$self->draw_protein(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
- $awo += $self->font->height/2;
+ $awo += $self->mono_font->height/2;
} else {
$self->draw_orfs(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
}
@@ -189,7 +189,7 @@ sub draw_protein {
my $self = shift;
my ($protein,$strand,$color,$gd,$x1,$y1,$x2,$y2) = @_;
my $pixels_per_base = $self->pixels_per_base;
- my $font = $self->font;
+ my $font = $self->mono_font;
my $flip = $self->{flip};
my $left = $self->panel->left;
my $right = $self->panel->right;
View
10 lib/Bio/Graphics/Glyph/wiggle_xyplot.pm
@@ -298,11 +298,11 @@ sub draw_plot {
my $side = $self->_determine_side();
my $fcolor=$self->panel->translate_color('grey:0.50');
my $font = $self->font('gdTinyFont');
- my $x1 = $left - length('+2sd') * $font->width - ($side=~/left|three/ ? 15 : 0);
- my $x2 = $left - length('mn') * $font->width - ($side=~/left|three/ ? 15 : 0);
- $gd->string($font,$x1,$yy1-$font->height/2,'+2sd',$fcolor) unless $clip_top;
- $gd->string($font,$x1,$yy2-$font->height/2,'-2sd',$fcolor) unless $clip_bottom;
- $gd->string($font,$x2,$y -$font->height/2,'mn', $fcolor);
+ my $x1 = $left - $self->string_width('+2sd',$font) - ($side=~/left|three/ ? 15 : 0);
+ my $x2 = $left - $self->string_width('mn',$font) - ($side=~/left|three/ ? 15 : 0);
+ $gd->string($font,$x1,$yy1-$self->string_height('+2sd',$font),'+2sd',$fcolor) unless $clip_top;
+ $gd->string($font,$x1,$yy2-$self->string_height('-2sd')/2,'-2sd',$fcolor) unless $clip_bottom;
+ $gd->string($font,$x2,$y - $self->string_height('mn',$font),'mn', $fcolor);
}
$self->panel->endGroup($gd);
View
33 lib/Bio/Graphics/Glyph/xyplot.pm
@@ -107,8 +107,8 @@ sub point_radius {
sub pad_top {
my $self = shift;
my $pad = $self->Bio::Graphics::Glyph::generic::pad_top(@_);
- if ($pad < ($self->font('gdTinyFont')->height+8)) {
- $pad = $self->font('gdTinyFont')->height+8; # extra room for the scale
+ if ($pad < $self->font_height('gdTinyFont')+8) {
+ $pad = $self->font_height('gdTinyFont')+8; # extra room for the scale
}
$pad;
}
@@ -116,8 +116,8 @@ sub pad_top {
sub pad_bottom {
my $self = shift;
my $pad = $self->Bio::Graphics::Glyph::generic::pad_bottom(@_);
- if ($pad < ($self->font('gdTinyFont')->height)/4) {
- $pad = ($self->font('gdTinyFont')->height)/4; # extra room for the scale
+ if ($pad < $self->font_height('gdTinyFont')/4) {
+ $pad = $self->font_height('gdTinyFont')/4; # extra room for the scale
}
$pad;
}
@@ -441,15 +441,6 @@ sub _draw_scale {
my $gc = $self->translate_color($p->gridcolor);
my $mgc= $self->translate_color($p->gridmajorcolor);
- # if ($side ne 'none') {
- # for (my $y = $y2-$y_scale; $y > $y1; $y -= $y_scale) {
- # my $yr = int($y+0.5);
- # $gd->line($x1-1,$yr,$x2,$yr,$gc);
- # }
- # $gd->line($x1,$y1,$x2,$y1,$gc);
- # $gd->line($x1,$y2,$x2,$y2,$gc);
- # }
-
$gd->line($x1,$y1,$x1,$y2,$fg) if $side eq 'left' || $side eq 'both' || $side eq 'three';
$gd->line($x2,$y1,$x2,$y2,$fg) if $side eq 'right' || $side eq 'both' || $side eq 'three';
$gd->line($middle,$y1,$middle,$y2,$fg) if $side eq 'three';
@@ -466,13 +457,13 @@ sub _draw_scale {
$gd->line($x2,$_->[0],$x2+3,$_->[0],$fg) if $side eq 'right' || $side eq 'both' || $side eq 'three';
$gd->line($middle,$_->[0],$middle+3,$_->[0],$fg) if $side eq 'three';
- my $font_pos = $_->[0]-($font->height/2);
+ my $font_pos = $_->[0]-($self->font_height($font)/2);
$font_pos-=2 if $_->[1] < 0; # jog a little bit for neg sign
- next unless $font_pos > $last_font_pos + $font->height/2; # prevent labels from clashing
+ next unless $font_pos > $last_font_pos + $self->font_height($font)/2; # prevent labels from clashing
if ($side eq 'left' or $side eq 'both' or $side eq 'three') {
$gd->string($font,
- $x1 - $font->width * length($_->[1]) - 3,$font_pos,
+ $x1 - $self->string_width($_->[1],$font) - 3,$font_pos,
$_->[1],
$fg);
}
@@ -482,7 +473,6 @@ sub _draw_scale {
$_->[1],
$fg);
}
-# if ($side eq 'three' && $_->[1] != 0) {
if ($side eq 'three') {
$gd->string($font,
$middle + 5,$font_pos,
@@ -649,9 +639,10 @@ sub draw_label {
$x += ($self->panel->glyph_scratch||0);
my $font = $self->labelfont;
- my $width = $font->width*(length($label)+4);
+ my $width = $self->string_width($label,$font)+4;
+ my $height= $self->string_height('',$font);
unless ($self->record_label_positions) {
- $gd->filledRectangle($x,$top,$x+$width+6,$top+$font->height,$self->bgcolor);
+ $gd->filledRectangle($x,$top,$x+$width+6,$top+$height,$self->bgcolor);
local $self->{default_opacity} = 1;
$gd->string($font,$x+3,$top,$label,$self->contrasting_label_color($gd,$self->bgcolor));
}
@@ -660,7 +651,7 @@ sub draw_label {
} elsif ($self->label_position eq 'left') {
my $font = $self->labelfont;
- my $x = $self->left + $left - $font->width*length($label) - $self->extra_label_pad;
+ my $x = $self->left + $left - $self->string_width($label,$font) - $self->extra_label_pad;
my $y = $self->{top} + $top;
$self->render_label($gd,
@@ -694,7 +685,7 @@ sub draw_legend {
my $label = "<a id=\"legend_$name\" target=\"_blank\" href=\"#\"> <font color=\'$color\';\">" . $name . "</font></a>" or return;
my $font = $self->labelfont;
- my $x = $self->left + $left - $font->width*length($label) - $self->extra_label_pad;
+ my $x = $self->left + $left - $self->string_width($label,$font) - $self->extra_label_pad;
my $y = $self->{top} + $top;
my $is_legend = 1;
$self->render_label($gd,
View
55 lib/Bio/Graphics/Panel.pm
@@ -511,6 +511,7 @@ sub gd {
my $gd = $existing_gd || $pkg->new($width,$height,
($self->{truecolor} && $pkg->can('isTrueColor') ? 1 : ())
);
+ $self->{gd} = $gd;
if ($self->{truecolor}
&& $pkg->can('saveAlpha')) {
@@ -525,7 +526,9 @@ sub gd {
}
$self->{translations} = \%translation_table;
- $self->{gd} = $gd;
+ $self->{gd} = $gd->isa('GD::SVG') ? $gd
+ : $self->truetype ? Bio::Graphics::GDWrapper->new($gd,$self->truetype)
+ : $gd;
eval {$gd->alphaBlending(0)};
if ($self->bgcolor) {
@@ -607,6 +610,30 @@ sub gd {
return $self->{gd} = $self->rotate ? $gd->copyRotate90 : $gd;
}
+sub string_width {
+ my $self = shift;
+ my ($font,$string) = @_;
+
+ my $class = $self->image_class;
+
+ return $font->width*CORE::length($string)
+ unless $self->truetype && $class ne 'GD::SVG';
+ return Bio::Graphics::GDWrapper->string_width($font,$string);
+}
+
+sub string_height {
+ my $self = shift;
+ my ($font,$string) = @_;
+
+ my $class = $self->image_class;
+
+ return $font->height
+ unless $self->truetype
+ && eval{$class eq 'GD' || $class->isa('GD::Image')};
+
+ return Bio::Graphics::GDWrapper->string_height($font,$string);
+}
+
sub startGroup {
my $self = shift;
my $gd = shift;
@@ -1701,6 +1728,9 @@ a set of tag/value pairs as follows:
Useful when working with the
"image" glyph.
+ -truetype Render text using scaleable vector false
+ fonts rather than bitmap fonts.
+
-image_class To create output in scalable vector
graphics (SVG), optionally pass the image
class parameter 'GD::SVG'. Defaults to
@@ -1763,6 +1793,15 @@ indicate a "gap" in the sequence:
$gd->filledRectangle($gap_start,$top,$gap_end,$bottom,$gray);
}
+The B<-truetype> argument will activate rendering of labels using
+antialiased vector fonts. If it is a value of "1", then labels will be
+rendered using the default font (Verdana). Pass a font name to use
+this font as the default:
+
+ -truetype => 'Times New Roman',
+
+Note that you can change the font on a track-by-track basis simply by
+using a truetype font name as add_track()'s -font argument.
=back
@@ -1793,7 +1832,6 @@ arguments is irrelevant, allowing either of these idioms:
$panel->add_track(arrow => \@features);
$panel->add_track(\@features => 'arrow');
-
The glyph name indicates how each feature is to be rendered. A
variety of glyphs are available, and the number is growing. You may
omit the glyph name entirely by providing a B<-glyph> argument among
@@ -2275,6 +2313,19 @@ ignored.
B<Track color:> The -tkcolor option used to specify the background of
the entire track.
+B<Font:> The -font option controls which font will be used. If the
+Panel was created without passing a true value to -truecolor, then
+only GD bitmapped fonts are available to you. These include
+'gdTinyFont', 'gdSmallFont', 'gdLargeFont', 'gdMediumBoldFont', and
+'gdGiantFont'. If the Panel was creaed using a truevalue for
+-truecolor, then you can pass the name of any truetype font installed
+on the server system. Any of these formats will work:
+
+ -font => 'Times New Roman', # Times font, let the system pick size
+ -font => 'Times New Roman-12' # Times font, 12 points
+ -font => 'Times New Roman-12:Italic' # Times font, 12 points italic
+ -font => 'Times New Roman-12:Bold' # Times font, 12 points bold
+
B<Font color:> The -fontcolor option controls the color of primary
text, such as labels
View
BIN  t/data/t1/version14.gif
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  t/data/t1/version14.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  t/data/t2/version20.gif
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  t/data/t2/version20.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  t/data/t3/version15.gif
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  t/data/t3/version15.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Please sign in to comment.
Something went wrong with that request. Please try again.