Added "hat" and "hidden" glyphs, and changed way that the "line" glyp…

…h works in order to support DAS 1.5.

Changes

@@ -1,4 +1,7 @@
 Revision history for Perl extension Bio::Graphics.
+1.96 Thu Jun  4 17:49:57 EDT 2009
+     - Added "hat" and "hidden" glyphs, and changed way that the "line" glyph works in order to
+     support DAS 1.5.
 1.95 Sat May 30 18:07:21 EDT 2009
      - In the substitution pattern rules, $id is replaced with the
      output of either the feature_id or primary_id methods depending 

MANIFEST

@@ -42,6 +42,7 @@ lib/Bio/Graphics/Glyph/hat.pm
 lib/Bio/Graphics/Glyph/heat_map.pm
 lib/Bio/Graphics/Glyph/heat_map_ideogram.pm
 lib/Bio/Graphics/Glyph/heterogeneous_segments.pm
+lib/Bio/Graphics/Glyph/hidden.pm
 lib/Bio/Graphics/Glyph/hybrid_plot.pm
 lib/Bio/Graphics/Glyph/ideogram.pm
 lib/Bio/Graphics/Glyph/image.pm

lib/Bio/Graphics.pm

@@ -2,7 +2,7 @@ package Bio::Graphics;
 
 use strict;
 use Bio::Graphics::Panel;
-our $VERSION = '1.95';
+our $VERSION = '1.96';
 
 1;
 

lib/Bio/Graphics/Glyph.pm

@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph;
 
-# $Id: Glyph.pm,v 1.9 2009-04-23 05:36:08 lstein Exp $
+# $Id: Glyph.pm,v 1.10 2009-06-04 21:51:08 lstein Exp $
 
 use strict;
 use Carp 'croak','cluck';
@@ -1403,6 +1403,7 @@ sub subfeat {
   my $self    = shift;
   my $feature = shift;
 
+
   return $self->_subfeat($feature) unless ref $self;  # protect against class invocation
 
   return if $self->level == 0 && $self->no_subparts;

lib/Bio/Graphics/Glyph/Factory.pm

@@ -127,7 +127,12 @@ sub clone {
 
 =cut
 
-sub stylesheet { shift->{stylesheet}  }
+sub stylesheet { 
+    my $self = shift;
+    my $d    = $self->{stylesheet};
+    $self->{stylesheet} = shift if @_;
+    $d;
+}
 
 =head2 glyph_map
 
@@ -306,6 +311,7 @@ sub make_glyph {
 
   for my $f (@_) {
     my $type = $forced_type || $self->feature_to_glyph($f);
+
     my $glyphclass = 'Bio::Graphics::Glyph';
     $type ||= 'generic';
     $glyphclass .= "\:\:\L$type";
@@ -342,14 +348,25 @@ sub feature_to_glyph {
   my $self    = shift;
   my $feature = shift;
 
-  return scalar $self->{stylesheet}->glyph($feature) if $self->{stylesheet};
-  my $map = $self->glyph_map    or return 'generic';
-  if (ref($map) eq 'CODE') {
-    my $val = eval {$map->($feature)};
-    warn $@ if $@;
-    return $val || 'generic';
+  my $val;
+
+  if ($self->{stylesheet} && $feature->type !~ /track|group/) {
+      $val = scalar $self->{stylesheet}->glyph($feature);
+      return $val || 'generic';
+  }
+
+  my $map = $self->glyph_map;
+  if ($map) {
+      if (ref($map) eq 'CODE') {
+	  $val = eval {$map->($feature)};
+	  warn $@ if $@;
+      }
+      else {
+	  $val = $map->{$feature->primary_tag};
+      }
   }
-  return $map->{$feature->primary_tag} || 'generic';
+
+  return $val || 'generic';
 }
 
 
@@ -384,6 +401,12 @@ sub option {
   return $self->{overriding_options}{$option_name} 
     if exists $self->{overriding_options} && exists $self->{overriding_options}{$option_name};
 
+  if (exists $self->{stylesheet} && (my $ss = $self->{stylesheet})) {
+    my(undef,%options) = $ss->glyph($glyph->feature);
+    my $value = $options{$option_name};
+    return $value if defined $value;
+  }
+
   if (exists $self->{options} && (my $map    = $self->{options})) {
     if (exists $map->{$option_name} && defined(my $value  = $map->{$option_name})) {
       my $feature = $glyph->feature;
@@ -396,12 +419,6 @@ sub option {
     }
   }
 
-  if (exists $self->{stylesheet} && (my $ss = $self->{stylesheet})) {
-    my($glyph,%options) = $ss->glyph($glyph->feature);
-    my $value = $options{$option_name};
-    return $value if defined $value;
-  }
-
   return $GENERIC_OPTIONS{$option_name};
 }
 

lib/Bio/Graphics/Glyph/hat.pm

@@ -1,33 +1,25 @@
 package Bio::Graphics::Glyph::hat;
-# $Id: hat.pm,v 1.1 2009-06-03 20:22:17 lstein Exp $
+# $Id: hat.pm,v 1.2 2009-06-04 21:51:08 lstein Exp $
 # a simple inverted V (used by DAS)
 
 use strict;
-use base qw(Bio::Graphics::Glyph::generic);
+use base qw(Bio::Graphics::Glyph::line);
 
 sub my_description {
     return <<END;
 This glyph draws an inverted V spanning the feature.
 END
 }
 
-sub draw_component {
-  my $self = shift;
-  my $gd = shift;
-  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
-
-  my $fg = $self->fgcolor;
-  my $center = ($y1+$y2)/2;
-  my $middle = ($x1+$x2)/2;
-
-  my $linewidth = $self->linewidth;
-  $fg = $self->set_pen($linewidth) if $linewidth > 1;
-
-  $gd->line($x1,$center,$middle,$y1,$fg);
-  $gd->line($middle,$y1,$x2,$center,$fg);
-  # add a label if requested
-  $self->draw_label($gd,@_) if $self->option('label');
-
+sub draw_connector {
+    my $self = shift;
+    my $gd   = shift;
+    my ($left,$right,$high,$low) = @_;
+    my $fg = $self->fgcolor;
+    my $center = ($high+$low)/2;
+    my $middle = ($left+$right)/2;
+    $gd->line($left,$center,$middle,$high,$fg);
+    $gd->line($middle,$high,$right,$center,$fg);
 }
 
 1;
@@ -36,15 +28,18 @@ __END__
 
 =head1 NAME
 
-Bio::Graphics::Glyph::line - The "line" glyph
+Bio::Graphics::Glyph::hat - The "hat" glyph
 
 =head1 SYNOPSIS
 
   See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
 
 =head1 DESCRIPTION
 
-This glyph draws a line parallel to the sequence segment.
+This glyph draws an inverted V parallel to the sequence segment. It is
+different from other glyphs in that it is designed to work with DAS
+tracks. The inverted V is drawn BETWEEN subparts as if you specified a
+connector type of "hat".
 
 =head2 OPTIONS
 

lib/Bio/Graphics/Glyph/line.pm

@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::line;
-# an arrow without the arrowheads
+# $Id: line.pm,v 1.3 2009-06-04 21:51:08 lstein Exp $
 
 use strict;
 use base qw(Bio::Graphics::Glyph::generic);
@@ -10,32 +10,71 @@ This glyph draws a horizontal line spanning the feature.
 END
 }
 
-sub bottom {
-  my $self = shift;
-  my $val = $self->SUPER::bottom(@_);
-  $val += $self->font->height if $self->option('tick');
-  $val += $self->labelheight if $self->option('label');
-  $val;
-}
+sub draw {
+    my $self = shift;
+    $self->SUPER::draw(@_);
+
+    my $gd = shift;
+
+    my $fg = $self->fgcolor;
+    my $linewidth = $self->linewidth;
+    $fg = $self->set_pen($linewidth) if $linewidth > 1;
+
+    my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
+    my $center = ($y1+$y2)/2;
+
+    my ($lowest,$highest);
+
+    my @parts = $self->parts;
+    for (my $i = 0;$i<@parts;$i++) {
+	my $part      = $parts[$i];
+	my ($l,undef,$xx1,$yy1) = $part->calculate_boundaries(@_);
+
+	$lowest  = $l   if !defined $lowest  || $lowest > $l;
+	$highest = $xx1 if !defined $xx1     || $highest < $xx1;
 
-sub draw_component {
-  my $self = shift;
-  my $gd = shift;
-  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
+	my $next_part = $parts[$i+1] or last;
+	my ($xx2,$yy2,undef,undef) = $next_part->calculate_boundaries(@_);
 
-  my $fg = $self->fgcolor;
-  my $a2 = $self->SUPER::height/2;
-  my $center = $y1+$a2;
+	my $middle = ($xx1+$xx2)/2;
+	$self->draw_connector($gd,$xx1,$xx2,$y1,$y2);
+    }
 
-  my $linewidth = $self->linewidth;
-  $fg = $self->set_pen($linewidth) if $linewidth > 1;
+    if ($lowest && $x1 < $lowest) {
+	my $middle = ($x1+$lowest)/2;
+	$self->draw_connector($gd,$x1,$lowest,$y1,$y2);
+    }
 
-  $gd->line($x1,$center,$x2,$center,$fg);
-  # add a label if requested
-  $self->draw_label($gd,@_) if $self->option('label');
+    if ($highest && $x2 > $highest) {
+	my $middle = ($x2+$highest)/2;
+	$self->draw_connector($gd,$highest,$x2,$y1,$y2);
+    }
 
+    my $height = $self->height;
+    $height    = 12 unless $height > 12;
+
+    return unless $self->parts;
+    if ($self->feature->strand > 0) {
+	$self->arrow($gd,$x2,$x2+$height/2,$center);
+    } elsif ($self->feature->strand < 0) {
+	$self->arrow($gd,$x1,$x1-$height/2,$center);
+    }
+}
+
+sub draw_connector {
+    my $self = shift;
+    my $gd   = shift;
+    my ($left,$right,$high,$low) = @_;
+    my $fg = $self->fgcolor;
+    my $center = ($high+$low)/2;
+    $gd->line($left,$center,$right,$center,$fg);
 }
 
+sub bump { 0 }
+
+sub maxdepth { return }
+
+
 1;
 
 __END__
@@ -50,7 +89,10 @@ Bio::Graphics::Glyph::line - The "line" glyph
 
 =head1 DESCRIPTION
 
-This glyph draws a line parallel to the sequence segment.
+This glyph draws a line parallel to the sequence segment. It is
+different from other glyphs in that it is designed to work with DAS
+tracks. The line is drawn BETWEEN the subparts, as if you specified a
+connector type of "line".
 
 =head2 OPTIONS
 

lib/Bio/Graphics/Panel.pm

@@ -369,7 +369,6 @@ sub _do_add_track {
      return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'group' };
      return $glyph_name;
    };
-
   $self->_add_track($position,$features,-map=>$panel_map,-stylesheet=>$ss,-options=>\%options);
 }