[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