Segments glyph now displays correct mismatch color for sequences that…

… begin or end with soft clips. Indels displayed in correct color when indel begins or ends outside current visible region.

Changes

@@ -1,4 +1,11 @@
 Revision history for Perl extension Bio::Graphics.
+
+2.06 Wed May  5 00:51:00 EDT 2010
+     - Segments glyph now displays correct mismatch color for sequences that begin or end with soft clips.
+     - Indels displayed in correct color when indel begins or ends outside current visible region.
+
+2.05 Identical to 2.04.
+
 2.04 Sun Apr 18 17:26:01 EDT 2010
      - Segments glyph now smarter about fetching reference sequence; this improves performance
        on multiple alignments.

lib/Bio/Graphics.pm

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

lib/Bio/Graphics/FeatureFile.pm

@@ -641,9 +641,8 @@ sub render {
 sub _stat {
   my $self = shift;
   my $file = shift;
-  my @stat = do{ no warnings 'unopened'; stat($file) }
-      or return;
-
+  defined fileno($file)  or return;
+  my @stat = stat($file) or return;
   if ($self->{stat} && @{$self->{stat}}) { # merge #includes so that mtime etc are max age
       for (8,9,10) {
 	  $self->{stat}[$_] = $stat[$_] if $stat[$_] > $self->{stat}[$_];

lib/Bio/Graphics/Glyph/segments.pm

@@ -459,7 +459,7 @@ sub draw_multiple_alignment {
   # subfeatures do. There is total breakage of encapsulation here because sometimes
   # a chado alignment places the aligned segment in the top-level feature, and sometimes
   # in the child feature.
-  unless (@s || $feature->isa('Bio::DB::GFF::Feature')) {
+  unless (@s) {            # || $feature->isa('Bio::DB::GFF::Feature')) {
     @s = ($feature);
   }
 
@@ -495,8 +495,9 @@ sub draw_multiple_alignment {
     my $cigar = $self->_get_cigar($s);
     if ($cigar || ($can_realign && $do_realign)) {
 	($ref_dna,$tgt_dna) = ($s->dna,$target->dna);
-	warn "ref/tgt" if DEBUG;
-	warn "$ref_dna\n$tgt_dna" if DEBUG;
+	warn "$s: ",$s->seq_id,":",$s->start,'..',$s->end if DEBUG;
+	warn "ref/tgt"             if DEBUG;
+	warn "$ref_dna\n$tgt_dna"  if DEBUG;
 
 	my @exact_segments;
 
@@ -526,6 +527,7 @@ sub draw_multiple_alignment {
     }
   }
 
+
   # get 'em in the right order so that we don't have to worry about
   # where the beginning and end are.
   @segments = sort {$a->[TGT_START]<=>$b->[TGT_START]} @segments;
@@ -632,7 +634,6 @@ sub draw_multiple_alignment {
     $tgt_dna = $self->reversec($tgt_dna);
   }
 
-
   for my $seg (@segments) {
     $seg->[SRC_START] -= $abs_start - 1;
     $seg->[SRC_END]   -= $abs_start - 1;
@@ -779,7 +780,7 @@ sub draw_multiple_alignment {
 	for (my $i=0;$i<$delta-1;$i++) {
 	  my $x = $base2pixel->($src_last_end,$i+1);
 	  next if $x > $panel_right;
-	  $self->filled_box($gd,$x-$pixels_per_base/2+2,$y,$x+$pixels_per_base/2+1,$y+$lineheight,$indel,$indel)
+	  $self->filled_box($gd,$x-$pixels_per_base/2+2,$y+1,$x+$pixels_per_base/2+1,$y+$lineheight,$indel,$indel)
 	    if $show_mismatch;
 	  $gd->char($font,$x,$y,'-',$color);
 	}
@@ -796,10 +797,18 @@ sub draw_multiple_alignment {
   # alignment for some reason - THIS SHOULD NOT BE NECESSARY AND INDICATES THAT THIS WHOLE METHOD NEEDS
   # TO BE REWRITTEN!
   if (defined $leftmost && $leftmost-$bl > $pixels_per_base) {
-    $gd->char($font,$_,$top-1,'-',$color) for map {$bl+$_*$pixels_per_base} 0..($leftmost-$bl)/$pixels_per_base-1;
+      for (map {$bl+$_*$pixels_per_base} 0..($leftmost-$bl)/$pixels_per_base-1) {
+	  $self->filled_box($gd,$_,$top+1,$_+$pixels_per_base,$top+$lineheight-1,$indel,$indel)
+	    if $show_mismatch;
+	  $gd->char($font,$_+2,$top-1,'-',$color);
+      }
   }
   if (defined $rightmost && $br-$rightmost > $pixels_per_base) {
-    $gd->char($font,$_,$top-1,'-',$color) for map {$rightmost+$_*$pixels_per_base} (0..($br-$rightmost)/$pixels_per_base);
+      for (map {$rightmost+$_*$pixels_per_base} (0..($br-$rightmost)/$pixels_per_base)) {
+	  $self->filled_box($gd,$_,$top+1,$_+$pixels_per_base,$top+$lineheight-1,$indel,$indel)
+	      if $show_mismatch;
+	  $gd->char($font,$_+2,$top-1,'-',$color);
+      }
   }
 
   return $drew_sequence;
@@ -814,7 +823,7 @@ sub _gapped_alignment_to_segments {
     for my $event (@$cigar) {
 	my ($op,$count) = @$event;
 	warn "op=$op, count=$count" if DEBUG;
-	if ($op eq 'I' || $op eq 'S') {
+	if ($op eq 'I') {
 	    $pad_source .= '-' x $count;
 	    $pad_target .= substr($tdna,0,$count,'');
 	    $pad_match  .= ' ' x $count;
@@ -824,6 +833,12 @@ sub _gapped_alignment_to_segments {
 	    $pad_target .= '-' x $count;
 	    $pad_match  .= ' ' x $count;
 	}
+	elsif ($op eq 'S') {
+	    $pad_source .= '-' x $count;
+	    $pad_target .= substr($tdna,0,$count,'');
+	    $pad_match  .= ' ' x $count;
+
+	}
 	elsif ($op eq 'H' || $op eq 'P') {
 	    # Nothing to do. This is simply an informational operation.
 	} else {  # everything else is assumed to be a match -- revisit
@@ -841,6 +856,8 @@ sub _gapped_alignment_to_segments {
 sub pads_to_segments {
     my $self = shift;
     my ($gap1,$align,$gap2) = @_;
+    warn "pads_to_segments" if DEBUG;
+    warn "$gap1\n$align\n$gap2\n" if DEBUG;
 
     # create arrays that map residue positions to gap positions
     my @maps;

lib/Bio/Graphics/Glyph/wiggle_density.pm

@@ -291,6 +291,9 @@ sub draw_segment {
       $max_value ||= $max;
   }
 
+  my $t = 0; for (@$data) {$t+=$_}
+  warn "min=$min_value, max=$max_value, total = $t";
+
   # allocate colors
   # There are two ways to do this. One is a scale from min to max. The other is a
   # bipartite scale using one color range from zero to min, and another color range
@@ -327,7 +330,8 @@ sub draw_segment {
 
     for (my $i = 0; $i <= @$data ; $i++) {
       my $x          = $x1 + $pixels_per_datapoint * $i;
-      my $data_point = $data->[$i] || next;
+      my $data_point = $data->[$i];
+      defined $data_point || next;
       $data_point    = $min_value if $min_value > $data_point;
       $data_point    = $max_value if $max_value < $data_point;
       my ($r,$g,$b)  = $bicolor