[Bioperl-guts-l] bioperl-live/Bio/Graphics/Glyph generic.pm, 1.33, 1.34 segments.pm, 1.41, 1.42

Lincoln Stein lstein at dev.open-bio.org
Fri Jun 2 15:05:57 EDT 2006


Update of /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph
In directory dev.open-bio.org:/tmp/cvs-serv15577/Bio/Graphics/Glyph

Modified Files:
	generic.pm segments.pm 
Log Message:
a number of bug fixes and features enhancements to support forthcoming gbrowse release

Index: generic.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph/generic.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** generic.pm	1 Jun 2006 16:14:18 -0000	1.33
--- generic.pm	2 Jun 2006 19:05:55 -0000	1.34
***************
*** 47,50 ****
--- 47,58 ----
    return $pad + $self->labelwidth;
  }
+ sub labelfont {
+   my $self = shift;
+   return $self->getfont('label_font',$self->font);
+ }
+ sub descfont {
+   my $self = shift;
+   return $self->getfont('desc_font',$self->font);
+ }
  sub labelwidth {
    my $self = shift;
***************
*** 167,171 ****
    my $label = $self->label or return;
    my $x    = $self->left + $left; # valid for both "top" and "left" because the left-hand side is defined by pad_left
!   my $font = $self->font;
    if ($self->label_position eq 'top') {
      $x += $self->pad_left;  # offset to beginning of the drawn part of the feature
--- 175,179 ----
    my $label = $self->label or return;
    my $x    = $self->left + $left; # valid for both "top" and "left" because the left-hand side is defined by pad_left
!   my $font = $self->labelfont;
    if ($self->label_position eq 'top') {
      $x += $self->pad_left;  # offset to beginning of the drawn part of the feature
***************
*** 193,197 ****
    $x = $self->panel->left + 1 if $x <= $self->panel->left;
    my $dy= $self->part_labels ? $self->font->height : 0;
!   $gd->string($self->font,
  	      $x,
  	      $self->bottom - $self->pad_bottom + $top + $dy,
--- 201,205 ----
    $x = $self->panel->left + 1 if $x <= $self->panel->left;
    my $dy= $self->part_labels ? $self->font->height : 0;
!   $gd->string($self->descfont,
  	      $x,
  	      $self->bottom - $self->pad_bottom + $top + $dy,
***************
*** 368,372 ****
    -height       Height of glyph		       10
  
!   -font         Glyph font		       gdSmallFont
  
    -connector    Connector type                 0 (false)
--- 376,384 ----
    -height       Height of glyph		       10
  
!   -font         Default font                   gdSmallFont
! 
!   -label_font   Font used for label	       gdSmallFont
! 
!   -desc_font    Font used for description      gdSmallFont
  
    -connector    Connector type                 0 (false)

Index: segments.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Graphics/Glyph/segments.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -C2 -d -r1.41 -r1.42
*** segments.pm	1 Jun 2006 16:14:18 -0000	1.41
--- segments.pm	2 Jun 2006 19:05:55 -0000	1.42
***************
*** 111,116 ****
  
    elsif ($self->option('draw_dna')) {
!     return $self->SUPER::draw(@_) unless eval {$self->feature->seq};
!     $drew_sequence = $self->draw_dna(@_);
    }
  
--- 111,117 ----
  
    elsif ($self->option('draw_dna')) {
!     my $dna = eval {$self->feature->seq};
!     return $self->SUPER::draw(@_) unless $dna;
!     $drew_sequence = $self->draw_dna(@_,$dna);
    }
  
***************
*** 125,129 ****
    my $self = shift;
    my $gd   = shift;
!   my ($left,$top,$partno,$total_parts) = @_;
    my $flipped              = $self->flip;
    my $pixels_per_base      = $self->scale;
--- 126,130 ----
    my $self = shift;
    my $gd   = shift;
!   my ($left,$top,$partno,$total_parts,$ref_dna) = @_;
    my $flipped              = $self->flip;
    my $pixels_per_base      = $self->scale;
***************
*** 147,155 ****
    for my $s (@s) {
      my ($src_start,$src_end) = ($s->start,$s->end);
      push @segments,[$s,$src_start,$src_end];
    }
  
!   my $ref_dna = lc $feature->seq;
!   $ref_dna    = $self->reversec($ref_dna) if $strand < 0;
  
    for my $seg (@segments) {
--- 148,157 ----
    for my $s (@s) {
      my ($src_start,$src_end) = ($s->start,$s->end);
+     next if $src_end < $panel_start or $src_start > $panel_end;
      push @segments,[$s,$src_start,$src_end];
    }
  
!   $ref_dna = lc ref($ref_dna) ? $ref_dna->seq : $ref_dna;
!   $ref_dna = $self->reversec($ref_dna) if $strand < 0;
  
    for my $seg (@segments) {
***************
*** 163,170 ****
        $seg->[SRC_END] = $panel_end;
      }
!     warn "Clipping gives [@$seg]\n"if DEBUG;
  
      $seg->[SRC_START] -= $abs_start - 1;
      $seg->[SRC_END]   -= $abs_start - 1;
    }
  
--- 165,174 ----
        $seg->[SRC_END] = $panel_end;
      }
!     warn "Clipping gives [@$seg]\n" if DEBUG;
  
      $seg->[SRC_START] -= $abs_start - 1;
      $seg->[SRC_END]   -= $abs_start - 1;
+ 
+     warn "Coordinate translation gives [@$seg]\n" if DEBUG;
    }
  
***************
*** 175,179 ****
    my $fontwidth  = $font->width;
  
!   my $pink = $self->factory->translate_color('lightpink');
    my $grey  = $self->factory->translate_color('gray');
  
--- 179,183 ----
    my $fontwidth  = $font->width;
  
!   my $pink  = $self->factory->translate_color('lightpink');
    my $grey  = $self->factory->translate_color('gray');
  
***************
*** 193,197 ****
    for my $seg (@segments) {
  
!     my $y = $top - $lineheight/4; 
  
      for (my $i=0; $i<$seg->[SRC_END]-$seg->[SRC_START]+1; $i++) {
--- 197,201 ----
    for my $seg (@segments) {
  
!     my $y = $top;
  
      for (my $i=0; $i<$seg->[SRC_END]-$seg->[SRC_START]+1; $i++) {
***************
*** 332,338 ****
    my $ref_dna = lc $feature->subseq(1-$offset_left,$feature->length+$offset_right)->seq;
    my $tgt_dna = lc $feature->hit->subseq(1-$offset_left,$feature->length+$offset_right)->seq;
!   
    # sanity check.  Let's see if they look like they're lining up
!   warn "dna sanity check:\n$ref_dna\n$tgt_dna\n" if DEBUG;
  
    # now we're all lined up, and we're going to adjust everything to fall within the bounds
--- 336,342 ----
    my $ref_dna = lc $feature->subseq(1-$offset_left,$feature->length+$offset_right)->seq;
    my $tgt_dna = lc $feature->hit->subseq(1-$offset_left,$feature->length+$offset_right)->seq;
! 
    # sanity check.  Let's see if they look like they're lining up
!   warn "$feature dna sanity check:\n$ref_dna\n$tgt_dna\n" if DEBUG;
  
    # now we're all lined up, and we're going to adjust everything to fall within the bounds
***************
*** 413,417 ****
    for my $seg (sort {$a->[SRC_START]<=>$b->[SRC_START]} @segments) {
  
!     my $y = $top - $lineheight/4; 
  
      for (my $i=0; $i<$seg->[SRC_END]-$seg->[SRC_START]+1; $i++) {
--- 417,421 ----
    for my $seg (sort {$a->[SRC_START]<=>$b->[SRC_START]} @segments) {
  
!     my $y = $top;
  
      for (my $i=0; $i<$seg->[SRC_END]-$seg->[SRC_START]+1; $i++) {
***************
*** 503,509 ****
    return @subseq if @subseq;
    if ($self->level == 0 && !@subseq && !eval{$feature->compound}) {
-     # my($start,$end) = ($feature->start,$feature->end);
-     # ($start,$end) = ($end,$start) if $start > $end; # to keep Bio::Location::Simple from bitching
-     # return Bio::Location::Simple->new(-start=>$start,-end=>$end);
      return $self->feature;
    } else {
--- 507,510 ----



More information about the Bioperl-guts-l mailing list