implemented workaround to allow image glyph to display certain URL-ba…

…sed images in SVG
GMOD · May 8, 2009 · caaca3a · caaca3a
1 parent 96dc2e0
commit caaca3a
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 19 deletions.
diff --git a/lib/Bio/Graphics/Glyph/ideogram.pm b/lib/Bio/Graphics/Glyph/ideogram.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::ideogram;
 
-# $Id: ideogram.pm,v 1.8 2009-04-02 22:22:07 lstein Exp $
+# $Id: ideogram.pm,v 1.9 2009-05-08 17:20:12 lstein Exp $
 # Glyph to draw chromosome ideograms
 
 use strict qw/vars refs/;
@@ -127,9 +127,9 @@ sub draw {
   my @last;
   for my $part (@parts) {
     push @last, $part and next if
-        $part->feature->method =~ /centromere/i ||
-	$part->feature->start <= $fstart ||
-	$part->feature->end   >= $fstop;
+        $part->feature->primary_tag =~ /centromere/i ||
+	$part->feature->start      <= $fstart ||
+	$part->feature->end        >= $fstop;
     my $tile = $part->create_tile('left');
     $part->draw_component($gd,$left,$top);
   }

diff --git a/lib/Bio/Graphics/Glyph/image.pm b/lib/Bio/Graphics/Glyph/image.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::image;
 
-# $Id: image.pm,v 1.3 2009-04-02 22:22:07 lstein Exp $
+# $Id: image.pm,v 1.4 2009-05-08 17:20:12 lstein Exp $
 
 use strict;
 use GD;
@@ -223,11 +223,22 @@ sub draw_component {
 
   my $delta = (($x2-$x1) - $image->width)/2;
   my($x,$y) = ($x1+$delta,$y1+$vs+$self->height);
-  if ($gd->can('copy')) {
-    $gd->copy($image,$x,$y,0,0,$image->width,$image->height) ;
-  } else {
-    my $gray = $self->panel->translate_color('gray');
-    $gd->filledRectangle($x,$y,$x+$image->width,$y+$image->height,$gray);
+  if ($gd->can('copy') && !$gd->isa('GD::SVG::Image')) {
+      $gd->copy($image,$x,$y,0,0,$image->width,$image->height) ;
+  } 
+  elsif ($gd->isa('GD::SVG::Image') 
+	 && $self->image_path =~ m!^(ftp|http)+:/!) { # a URL
+      my ($img,$id) = $gd->_prep($x,$y);
+      $img->image('x'    => $x,
+		  'y'    => $y,
+                  width  => $image->width,
+		  height => $image->height,
+		  id     => $id,
+		  'xlink:href' => $self->image_path);
+  }
+  else {
+      my $gray = $self->panel->translate_color('gray');
+      $gd->filledRectangle($x,$y,$x+$image->width,$y+$image->height,$gray);
   }
 
   if ($vs > 0) {

diff --git a/lib/Bio/Graphics/Glyph/segments.pm b/lib/Bio/Graphics/Glyph/segments.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::segments;
-#$Id: segments.pm,v 1.2 2009-03-20 13:03:01 lstein Exp $
+#$Id: segments.pm,v 1.3 2009-05-08 17:20:13 lstein Exp $
 
 use strict;
 use Bio::Location::Simple;
@@ -219,9 +219,14 @@ sub draw_multiple_alignment {
   my ($bl,$bt,$br,$bb)     = $self->bounds($left,$top);
   $top = $bt;
 
-  for my $p ($self->parts) {
-    my @bounds = $p->bounds($left,$top);
-    $self->filled_box($gd,@bounds,$self->bgcolor,$self->bgcolor);
+  if (my @p = $self->parts) {
+      for my $p (@p) {
+	  my @bounds = $p->bounds($left,$top);
+	  $self->filled_box($gd,@bounds,$self->bgcolor,$self->bgcolor);
+      }
+  } else {
+      my @bounds = $self->bounds($left,$top);
+      $self->filled_box($gd,@bounds,$self->bgcolor,$self->bgcolor);
   }
 
   my @s                     = $self->_subfeat($feature);
@@ -393,7 +398,9 @@ sub draw_multiple_alignment {
   }
 
   # draw
-  my $color = $self->fgcolor;
+  my $color = $self->bgcolor == $self->fgcolor 
+              ? $self->factory->translate_color('white')
+	      : $self->fgcolor;
   my $font  = $self->font;
   my $lineheight = $font->height;
   my $fontwidth  = $font->width;
@@ -428,7 +435,12 @@ sub draw_multiple_alignment {
 
       next unless $tgt_base && $x >= $panel_left && $x <= $panel_right;
 
-      $self->filled_box($gd,$x-$pixels_per_base/2+2,$y+1,$x+$pixels_per_base/2+1,$y+$lineheight,$mismatch,$mismatch)
+      $self->filled_box($gd,
+			$x-$pixels_per_base/2+3,
+			$y+1,
+			$x+$pixels_per_base/2+3,
+			$y+$lineheight,
+			$mismatch,$mismatch)
 	if $show_mismatch && $tgt_base && $src_base ne $tgt_base && $tgt_base !~ /[nN]/;
       $tgt_base = $complement{$tgt_base} if $true_target && $strand < 0;
       $gd->char($font,$x,$y,$tgt_base,$tgt_base =~ /[nN]/ ? $grey : $color);

diff --git a/scripts/glyph_help.pl b/scripts/glyph_help.pl
@@ -14,6 +14,7 @@
 my $PICT   = 0;
 my $VIEW   = 0;
 my $BOXES  = 0;
+my $SVG    = 0;
 
 my $usage = <<USAGE;
 Usage: $0 [options] glyph_type 
@@ -28,8 +29,9 @@
                     The PNG will be written to stdout
     -v --view     Launch a viewer ("xv", "display" or "firefox") to show the
                     glyph.
-
     -b --boxes    Outline the boxes around each glyph
+    --svg         When used in conjunction with --picture, will create
+                    an SVG rather than a png using GD::SVG
 
 If neither -m nor -l are specified, the default is to print a summary
 of the glyph\'s options.
@@ -48,6 +50,7 @@
 	    'picture'  => \$PICT,
 	    'view'     => \$VIEW,
 	    'boxes'    => \$BOXES,
+	    'svg'      => \$SVG,
 	   ) or die $usage;
 
 my $glyph = shift;
@@ -69,7 +72,7 @@
 }
 
 if ($PICT || $VIEW) {
-    print_picture($glyph,$VIEW);
+    print_picture($glyph,$VIEW,$SVG);
     exit 0;
 }
 
@@ -112,6 +115,7 @@ sub print_list {
 sub print_picture {
     my $glyph  = shift;
     my $viewit = shift;
+    my $svg    = shift;
 
     my $panel = Bio::Graphics::Panel->new(-length => 500,
 					  -width  => 250,
@@ -121,6 +125,8 @@ sub print_picture {
 					  -pad_bottom => 10,
 					  -key_style  => 'between',
 					  -truecolor  => 1,
+					  -image_class => $svg ? 
+					            'GD::SVG' : 'GD'
 	);
 
 
@@ -167,7 +173,7 @@ sub print_picture {
 	}
     }
 
-    my $png = $panel->png;
+    my $png = $svg ? $panel->svg : $panel->png;
     unless ($viewit) {
 	print $png;
 	return;