1
package Bio::Graphics::Glyph;
3
# $Id: Glyph.pm,v 1.113.4.9 2006/11/29 02:38:33 lstein Exp $
6
use Carp 'croak','cluck';
7
use constant BUMP_SPACING => 2; # vertical distance between bumped glyphs
8
use Bio::Root::Version;
10
use base qw(Bio::Root::Root);
14
# the CM1 and CM2 constants control the size of the hash used to
16
use constant CM1 => 200; # big bin, x axis
17
use constant CM2 => 50; # big bin, y axis
18
use constant CM3 => 50; # small bin, x axis
19
use constant CM4 => 50; # small bin, y axis
20
use constant DEBUG => 0;
22
use constant QUILL_INTERVAL => 8; # number of pixels between Jim Kent style intron "quills"
24
# a bumpable graphical object that has bumpable graphical subparts
26
# args: -feature => $feature_object (may contain subsequences)
27
# -factory => $factory_object (called to create glyphs for subsequences)
28
# In this scheme, the factory decides based on stylesheet information what glyph to
29
# draw and what configurations options to us. This allows for heterogeneous tracks.
34
my $feature = $arg{-feature} or $class->throw("No feature $class");
35
my $factory = $arg{-factory} || $class->default_factory;
36
my $level = $arg{-level} || 0;
37
my $flip = $arg{-flip};
39
my $self = bless {},$class;
40
$self->{feature} = $feature;
41
$self->{factory} = $factory;
42
$self->{level} = $level;
43
$self->{flip}++ if $flip;
46
my $panel = $factory->panel;
47
my $p_start = $panel->start;
48
my $p_end = $panel->end;
54
warn $feature if DEBUG;
56
@subfeatures = $self->subfeat($feature);
58
if ($self->option('ignore_sub_part')) {
60
foreach (@subfeatures) {
61
my $type = $_->method;
63
my @ignore_list = split /\s+/, $self->option('ignore_sub_part');
64
my $ignore_str = join('|', @ignore_list);
66
unless ($type =~ /$ignore_str/) {
70
@subfeatures = @tmparray;
73
my @visible_subfeatures = grep {$p_start <= $_->end && $p_end >= $_->start} @subfeatures;
75
$self->feature_has_subparts(@subfeatures>0);
77
if (@visible_subfeatures) {
78
# dynamic glyph resolution
79
@subglyphs = map { $_->[0] }
80
sort { $a->[1] <=> $b->[1] }
81
map { [$_, $_->left ] }
82
$factory->make_glyph($level+1,@visible_subfeatures);
83
$self->{parts} = \@subglyphs;
86
my ($start,$stop) = ($self->start, $self->stop);
87
if (defined $start && defined $stop && $start ne '') { # more paranoia
88
($start,$stop) = ($stop,$start) if $start > $stop; # sheer paranoia
89
# the +1 here is critical for allowing features to meet nicely at nucleotide resolution
90
my ($left,$right) = $factory->map_pt($start,$stop+1);
91
$self->{left} = $left;
92
$self->{width} = $right - $left + 1;
96
my $l = $subglyphs[0]->left;
97
# this clashes with the pad_left calculation and is unecessary
98
# $self->{left} = $l if !defined($self->{left}) || $l < $self->{left};
101
map {$_->right} @subglyphs)[0];
102
my $w = $right - $self->{left} + 1;
103
# this clashes with the pad_right calculation and is unecessary
104
# $self->{width} = $w if !defined($self->{width}) || $w > $self->{width};
107
$self->{point} = $arg{-point} ? $self->height : undef;
114
return unless $self->{parts};
115
return wantarray ? @{$self->{parts}} : $self->{parts};
118
# this is different than parts(). parts() will return subglyphs
119
# that are contained within the current viewing range. feature_has_subparts()
120
# will return true if the feature has any subparts, even if they are off the
122
sub feature_has_subparts {
125
return $self->{feature_has_subparts} = shift if @_;
126
return 0 if $self->maxdepth == 0;
127
my $feature = $self->feature;
128
return 1 if $feature->can('compound') && $feature->compound;
129
return $self->{feature_has_subparts};
132
sub feature { shift->{feature} }
133
sub factory { shift->{factory} }
134
sub panel { shift->factory->panel }
135
sub point { shift->{point} }
136
sub scale { shift->factory->scale }
139
my $d = $self->{flip};
140
$self->{flip} = shift if @_;
145
return $self->{start} if exists $self->{start};
147
$self->{start} = defined $self->{feature}->end
148
? $self->panel->end + 1 - $self->{feature}->end
151
$self->{start} = defined $self->{feature}->start
152
? $self->{feature}->start
153
: $self->panel->offset - 1
156
return $self->{start};
161
return $self->{stop} if exists $self->{stop};
163
$self->{stop} = defined $self->{feature}->start
164
? $self->panel->end + 1 - $self->{feature}->start
165
: $self->panel->offset - 1;
167
$self->{stop} = defined $self->{feature}->end
168
? $self->{feature}->end
169
: $self->panel->offset+$self->panel->length+1;
174
sub end { shift->stop }
175
sub length { my $self = shift; $self->stop - $self->start };
178
return $self->{score} if exists $self->{score};
179
return $self->{score} = ($self->{feature}->score || 0);
183
return $self->{strand} if exists $self->{strand};
184
return $self->{strand} = ($self->{feature}->strand || 0);
186
sub map_pt { shift->{factory}->map_pt(@_) }
187
sub map_no_trunc { shift->{factory}->map_no_trunc(@_) }
189
# add a feature (or array ref of features) to the list
192
my $factory = $self->factory;
194
for my $feature (@_) {
195
if (ref $feature eq 'ARRAY') {
196
$self->add_group(@$feature);
198
warn $factory if DEBUG;
199
push @{$self->{parts}},$factory->make_glyph(0,$feature);
204
# link a set of features together so that they bump as a group
207
my @features = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_;
208
my $f = Bio::Graphics::Feature->new(
209
-segments=>\@features,
212
$self->add_feature($f);
218
my $g = $self->{top};
219
$self->{top} = shift if @_;
224
return $self->{left} - $self->pad_left;
228
return $self->left + $self->layout_width - 1;
232
$self->top + $self->layout_height - 1;
236
return $self->{height} if exists $self->{height};
237
my $baseheight = $self->option('height'); # what the factory says
238
return $self->{height} = $baseheight;
242
my $g = $self->{width};
243
$self->{width} = shift if @_;
248
return $self->layout;
252
return $self->width + $self->pad_left + $self->pad_right;
255
# returns the rectangle that surrounds the physical part of the
256
# glyph, excluding labels and other "extra" stuff
257
sub calculate_boundaries {return shift->bounds(@_);}
263
($dx + $self->{left},
264
$dy + $self->top + $self->pad_top,
265
$dx + $self->{left} + $self->{width} - 1,
266
$dy + $self->bottom - $self->pad_bottom);
271
my @result = ($self->left,$self->top,$self->right,$self->bottom);
278
my ($x1,$y1,$x2,$y2,$fg,$bg,$lw) = @_;
279
$lw = $self->linewidth;
282
$fg ||= $self->fgcolor;
283
$fg = $self->set_pen($lw,$fg) if $lw > 1;
287
$bg ||= $self->bgcolor;
288
$bg = $self->set_pen($lw,$bg) if $lw > 1;
292
$gd->rectangle($x1,$y1,$x2,$y2,$fg);
294
# if the left end is off the end, then cover over
296
my ($width) = $gd->getBounds;
298
$gd->line($x1,$y1+$lw,$x1,$y2-$lw,$bg)
299
if $x1 < $self->panel->pad_left;
301
$gd->line($x2,$y1+$lw,$x2,$y2-$lw,$bg)
302
if $x2 > $width - $self->panel->pad_right;
305
# return boxes surrounding each part
309
my ($left,$top,$parent) = @_;
310
$top += 0; $left += 0;
315
my $subparts = $self->box_subparts || 0;
317
for my $part ($self->parts) {
318
my $type = $part->feature->primary_tag || '';
319
if ($type eq 'group' or $subparts > $part->level) {
320
push @result,$part->boxes($left,$top+$self->top+$self->pad_top,$parent);
321
next if $type eq 'group';
323
my ($x1,$y1,$x2,$y2) = $part->box;
325
push @result,[$part->feature,
326
$left + $x1,$top+$self->top+$self->pad_top+$y1,
327
$left + $x2,$top+$self->top+$self->pad_top+$y2,
331
return wantarray ? @result : \@result;
336
return $self->{box_subparts} if exists $self->{box_subparts};
337
return $self->{box_subparts} = $self->_box_subparts;
340
sub _box_subparts { shift->option('box_subparts') }
342
# this should be overridden for labels, etc.
343
# allows glyph to make itself thicker or thinner depending on
344
# domain-specific knowledge
355
my @parts = $self->parts or return 0;
358
my $pl = $_->pad_left;
359
$max = $pl if $max < $pl;
365
my @parts = $self->parts or return 0;
368
my $pr = $_->pad_right;
369
$max = $pr if $max < $pr;
374
# move relative to parent
378
$self->{left} += $dx;
381
# because the feature parts use *absolute* not relative addressing
382
# we need to move each of the parts horizontally, but not vertically
383
$_->move($dx,0) foreach $self->parts;
389
my $option_name = shift;
390
my @args = ($option_name,@{$self}{qw(partno total_parts)});
391
my $factory = $self->{factory} or return;
392
return $factory->option($self,@args)
395
# get an option that might be a code reference
398
my $option_name = shift;
399
my $factory = $self->factory or return;
400
$factory->get_option($option_name);
403
# set an option globally
406
my $factory = $self->factory;
407
my $option_map = $factory->option_map;
409
my $option_name = shift;
410
my $option_value = shift;
411
($option_name = lc $option_name) =~ s/^-//;
412
$option_map->{$option_name} = $option_value;
416
# some common options
420
my $index = $self->option($color);
421
# turn into a color index
422
return $self->factory->translate_color($index) if defined $index;
427
return shift->option('connector',@_);
434
# +2 simple bump down
438
return $self->option('bump');
441
# control horizontal and vertical collision control
444
return $self->{_hbumppad} if exists $self->{_hbumppad};
445
return $self->{_hbumppad}= $self->option('hbumppad');
448
# we also look for the "color" option for Ace::Graphics compatibility
451
my $index = $self->option('color') || $self->option('fgcolor');
452
$index = 'black' unless defined $index;
453
$self->factory->translate_color($index);
456
#add for compatibility
459
return $self->bgcolor;
462
# we also look for the "background-color" option for Ace::Graphics compatibility
465
my $bgcolor = $self->option('bgcolor');
466
my $index = defined $bgcolor ? $bgcolor : $self->option('fillcolor');
467
$index = 'white' unless defined $index;
468
$self->factory->translate_color($index);
473
my $option = shift || 'font';
476
my $font = $self->option($option) || $default;
479
my $img_class = $self->image_class;
481
unless (UNIVERSAL::isa($font,$img_class . '::Font')) {
483
gdTinyFont => $img_class->gdTinyFont(),
484
gdSmallFont => $img_class->gdSmallFont(),
485
gdMediumBoldFont => $img_class->gdMediumBoldFont(),
486
gdLargeFont => $img_class->gdLargeFont(),
487
gdGiantFont => $img_class->gdGiantFont(),
490
my $gdfont = $ref->{$font};
491
$self->configure($option => $gdfont);
499
return $self->getfont('font','gdSmallFont');
504
my $fontcolor = $self->color('fontcolor');
505
return defined $fontcolor ? $fontcolor : $self->fgcolor;
509
my $font2color = $self->color('font2color');
510
return defined $font2color ? $font2color : $self->fgcolor;
512
sub tkcolor { # "track color"
514
$self->option('tkcolor') or return;
515
return $self->color('tkcolor')
517
sub connector_color {
519
$self->color('connector_color') || $self->fgcolor;
522
sub image_class { shift->{factory}->{panel}->{image_class}; }
523
sub polygon_package { shift->{factory}->{panel}->{polygon_package}; }
529
my $opt = $self->code_option("sort_order");
532
$sortfunc = sub { $a->left <=> $b->left };
533
} elsif (ref $opt eq 'CODE') {
534
$self->throw('sort_order subroutines must use the $$ prototype') unless prototype($opt) eq '$$';
536
} elsif ($opt =~ /^sub\s+\{/o) {
537
$sortfunc = eval $opt;
539
# build $sortfunc for ourselves:
540
my @sortbys = split(/\s*\|\s*/o, $opt);
541
$sortfunc = 'sub { ';
544
# not sure I can make this schwartzian transformed
545
for my $sortby (@sortbys) {
546
if ($sortby eq "left" || $sortby eq "default") {
547
$sortfunc .= '($a->left <=> $b->left) || ';
549
} elsif ($sortby eq "right") {
550
$sortfunc .= '($a->right <=> $b->right) || ';
551
} elsif ($sortby eq "low_score") {
552
$sortfunc .= '($a->score <=> $b->score) || ';
553
} elsif ($sortby eq "high_score") {
554
$sortfunc .= '($b->score <=> $a->score) || ';
555
} elsif ($sortby eq "longest") {
556
$sortfunc .= '(($b->length) <=> ($a->length)) || ';
557
} elsif ($sortby eq "shortest") {
558
$sortfunc .= '(($a->length) <=> ($b->length)) || ';
559
} elsif ($sortby eq "strand") {
560
$sortfunc .= '($b->strand <=> $a->strand) || ';
561
} elsif ($sortby eq "name") {
562
$sortfunc .= '($a->feature->display_name cmp $b->feature->display_name) || ';
566
$sortfunc .= ' ($a->left <=> $b->left) ';
571
$sortfunc = eval $sortfunc;
575
# $self->factory->set_option(sort_order => $sortfunc);
577
my @things = sort $sortfunc @_;
581
# handle collision detection
584
return $self->{layout_height} if exists $self->{layout_height};
586
my @parts = $self->parts;
587
return $self->{layout_height} = $self->height + $self->pad_top + $self->pad_bottom unless @parts;
589
my $bump_direction = $self->bump;
590
my $bump_limit = $self->option('bump_limit') || -1;
592
$_->layout foreach @parts; # recursively lay out
594
# no bumping requested, or only one part here
595
if (@parts == 1 || !$bump_direction) {
598
my $height = $_->layout_height;
599
$highest = $height > $highest ? $height : $highest;
601
return $self->{layout_height} = $highest + $self->pad_top + $self->pad_bottom;
607
for my $g ($self->layout_sort(@parts)) {
609
my $height = $g->{layout_height};
611
# Simple +/- 2 bumping. Every feature gets its very own line
612
if (abs($bump_direction) >= 2) {
614
$limit += $height + BUMP_SPACING if $bump_direction > 0;
615
$limit -= $height + BUMP_SPACING if $bump_direction < 0;
619
# we get here for +/- 1 bumping
623
my $right = $g->right;
627
# stop bumping if we've gone too far down
628
if ($bump_limit > 0 && $bumplevel++ >= $bump_limit) {
629
$g->{overbumped}++; # this flag can be used to suppress label and description
630
foreach ($g->parts) {
636
# look for collisions
637
my $bottom = $pos + $height;
638
$self->collides(\%bin1,CM1,CM2,$left,$pos,$right,$bottom) or last;
639
my $collision = $self->collides(\%bin2,CM3,CM4,$left,$pos,$right,$bottom) or last;
641
if ($bump_direction > 0) {
642
$pos += $collision->[3]-$collision->[1] + BUMP_SPACING; # collision, so bump
644
$pos -= BUMP_SPACING;
647
$pos++ if $pos % 2; # correct for GD rounding errors
651
$self->add_collision(\%bin1,CM1,CM2,$left,$g->top,$right,$g->bottom);
652
$self->add_collision(\%bin2,CM3,CM4,$left,$g->top,$right,$g->bottom);
655
# If -1 bumping was allowed, then normalize so that the top glyph is at zero
656
if ($bump_direction < 0) {
660
$topmost = $top if !defined($topmost) or $top < $topmost;
662
my $offset = - $topmost;
663
$_->move(0,$offset) foreach @parts;
669
$bottom = $_->bottom if $_->bottom > $bottom;
671
# return $self->{layout_height} = $self->pad_bottom + $self->pad_top + $bottom - $self->top + 1;
672
return $self->{layout_height} = $bottom + $self->pad_top + $self->pad_bottom;
675
# the $%occupied structure is a hash of {left,top} = [left,top,right,bottom]
678
my ($occupied,$cm1,$cm2,$left,$top,$right,$bottom) = @_;
679
my @keys = $self->_collision_keys($cm1,$cm2,$left,$top,$right,$bottom);
680
my $hspacing = $self->hbumppad || 0;
683
next unless exists $occupied->{$k};
684
for my $bounds (@{$occupied->{$k}}) {
685
my ($l,$t,$r,$b) = @$bounds;
686
next unless $right+$hspacing >= $l and $left-$hspacing <= $r
687
and $bottom >= $t and $top <= $b;
697
my ($occupied,$cm1,$cm2,$left,$top,$right,$bottom) = @_;
698
my $value = [$left,$top,$right+2,$bottom];
699
my @keys = $self->_collision_keys($cm1,$cm2,@$value);
700
push @{$occupied->{$_}},$value foreach @keys;
703
sub _collision_keys {
705
my ($binx,$biny,$left,$top,$right,$bottom) = @_;
707
my $bin_left = int($left/$binx);
708
my $bin_right = int($right/$binx);
709
my $bin_top = int($top/$biny);
710
my $bin_bottom = int($bottom/$biny);
711
for (my $x=$bin_left;$x<=$bin_right; $x++) {
712
for (my $y=$bin_top;$y<=$bin_bottom; $y++) {
713
push @keys,join(',',$x,$y);
722
my ($left,$top,$partno,$total_parts) = @_;
724
my $connector = $self->connector;
726
if (my @parts = $self->parts) {
728
# invoke sorter if user wants to sort always and we haven't already sorted
730
@parts = $self->layout_sort(@parts) if !$self->bump && $self->option('always_sort');
733
my $y = $top + $self->top + $self->pad_top;
735
$self->draw_connectors($gd,$x,$y) if $connector && $connector ne 'none';
738
for (my $i=0; $i<@parts; $i++) {
739
# lie just a little bit to avoid lines overlapping and make the picture prettier
741
$fake_x-- if defined $last_x && $parts[$i]->left - $last_x == 1;
742
$parts[$i]->draw($gd,$fake_x,$y,$i,scalar(@parts));
743
$last_x = $parts[$i]->right;
748
$self->draw_connectors($gd,$left,$top)
749
if $connector && $connector ne 'none'; # && $self->{level} == 0;
750
$self->draw_component($gd,$left,$top,$partno,$total_parts) unless $self->feature_has_subparts;
755
# the "level" is the level of testing of the glyph
756
# groups are level -1, top level glyphs are level 0, subcomponents are level 1 and so forth.
761
sub draw_connectors {
764
return if $self->{overbumped};
767
my @parts = sort { $a->left <=> $b->left } $self->parts;
768
for (my $i = 0; $i < @parts-1; $i++) {
769
# don't let connectors double-back on themselves
770
next if ($parts[$i]->bounds)[2] > ($parts[$i+1]->bounds)[0];
771
$self->_connector($gd,$dx,$dy,$parts[$i]->bounds,$parts[$i+1]->bounds);
774
# extra connectors going off ends
776
my($x1,$y1,$x2,$y2) = $self->bounds(0,0);
777
my($xl,$xt,$xr,$xb) = $parts[0]->bounds;
778
$self->_connector($gd,$dx,$dy,$x1,$xt,$x1,$xb,$xl,$xt,$xr,$xb) if $x1 < $xl;
779
my ($xl2,$xt2,$xr2,$xb2) = $parts[-1]->bounds;
781
my $feature = $self->feature;
782
my @p = map {$_->feature} @parts;
783
$self->_connector($gd,$dx,$dy,$parts[-1]->bounds,$x2,$xt2,$x2,$xb2) if $x2 > $xr2;
785
my ($x1,$y1,$x2,$y2) = $self->bounds($dx,$dy);
786
$self->draw_connector($gd,$y1,$y2,$x1,$y1,$y2,$x2);
791
# return true if this feature should be highlited
794
return if $self->level; # only highlite top level glyphs
795
my $index = $self->option('hilite') or return;
796
$self->factory->translate_color($index);
801
my ($gd,$left,$top) = @_;
802
my $color = $self->hilite_color or return;
803
my @bounds = $self->bounds;
804
$gd->filledRectangle($bounds[0]+$left - 3,
806
$bounds[2]+$left + 3,
816
$yl,$yt,$yr,$yb) = @_;
817
my $left = $dx + $xr;
818
my $right = $dx + $yl;
819
my $top1 = $dy + $xt;
820
my $bottom1 = $dy + $xb;
821
my $top2 = $dy + $yt;
822
my $bottom2 = $dy + $yb;
824
# restore this comment if you don't like the group dash working
826
return if $right-$left < 1 && !$self->isa('Bio::Graphics::Glyph::group');
828
$self->draw_connector($gd,
829
$top1,$bottom1,$left,
830
$top2,$bottom2,$right,
838
my $color = $self->connector_color;
839
my $connector_type = $self->connector or return;
841
if ($connector_type eq 'hat') {
842
$self->draw_hat_connector($gd,$color,@_);
843
} elsif ($connector_type eq 'solid') {
844
$self->draw_solid_connector($gd,$color,@_);
845
} elsif ($connector_type eq 'dashed') {
846
$self->draw_dashed_connector($gd,$color,@_);
847
} elsif ($connector_type eq 'quill') {
848
$self->draw_quill_connector($gd,$color,@_);
849
} elsif ($connector_type eq 'crossed') {
850
$self->draw_crossed_connector($gd,$color,@_);
856
sub draw_hat_connector {
860
my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
862
cluck "gd object is $gd" unless ref $gd;
864
my $center1 = ($top1 + $bottom1)/2;
865
my $quarter1 = $top1 + ($bottom1-$top1)/4;
866
my $center2 = ($top2 + $bottom2)/2;
867
my $quarter2 = $top2 + ($bottom2-$top2)/4;
869
if ($center1 != $center2) {
870
$self->draw_solid_connector($gd,$color,@_);
874
if ($right - $left > 4) { # room for the inverted "V"
875
my $middle = $left + int(($right - $left)/2);
876
$gd->line($left,$center1,$middle,$top1,$color);
877
$gd->line($middle,$top1,$right-1,$center1,$color);
878
} elsif ($right-$left > 1) { # no room, just connect
879
$gd->line($left,$quarter1,$right-1,$quarter1,$color);
884
sub draw_solid_connector {
888
my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
890
my $center1 = ($top1 + $bottom1)/2;
891
my $center2 = ($top2 + $bottom2)/2;
893
$gd->line($left,$center1,$right,$center2,$color);
896
sub draw_dashed_connector {
900
my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
902
my $center1 = ($top1 + $bottom1)/2;
903
my $center2 = ($top2 + $bottom2)/2;
904
my $image_class = $self->panel->image_class;
905
my $gdTransparent = $image_class->gdTransparent;
906
my $gdStyled = $image_class->gdStyled;
907
$gd->setStyle($color,$color,$gdTransparent,$gdTransparent);
908
$gd->line($left,$center1,$right,$center2,$gdStyled);
911
sub draw_quill_connector {
915
my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
917
my $center1 = ($top1 + $bottom1)/2;
918
my $center2 = ($top2 + $bottom2)/2;
920
$gd->line($left,$center1,$right,$center2,$color);
921
my $direction = $self->feature->strand;
922
return unless $direction;
923
$direction *= -1 if $self->{flip};
925
if ($direction > 0) {
928
for (my $position=$start; $position <= $end; $position += QUILL_INTERVAL) {
929
$gd->line($position,$center1,$position-2,$center1-2,$color);
930
$gd->line($position,$center1,$position-2,$center1+2,$color);
935
for (my $position=$start; $position <= $end; $position += QUILL_INTERVAL) {
936
$gd->line($position,$center1,$position+2,$center1-2,$color);
937
$gd->line($position,$center1,$position+2,$center1+2,$color);
942
sub draw_crossed_connector {
946
my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;
948
#Draw the horizontal line
949
my $center1 = ($top1 + $bottom1)/2;
950
my $center2 = ($top2 + $bottom2)/2;
952
$gd->line($left,$center1,$right,$center2,$color);
955
($left, $right) = ($right, $left) if ($right < $left);
956
($top1, $bottom1) = ($bottom1, $top1) if ($bottom1 < $top1);
957
($top2, $bottom2) = ($bottom2, $top2) if ($bottom2 < $top2);
960
my $middle = int(($right - $left) / 2) + $left;
961
my $midLen = int(($bottom1 - $top1) / 2);
963
$gd->line($middle-$midLen,$top1, $middle+$midLen,$bottom2,$color);
964
$gd->line($middle-$midLen,$bottom1,$middle+$midLen,$top2,$color);
970
my ($x1,$y1,$x2,$y2,$bg,$fg,$lw) = @_;
972
$bg ||= $self->bgcolor;
973
$fg ||= $self->fgcolor;
974
$lw ||= $self->option('linewidth') || 1;
976
$gd->filledRectangle($x1,$y1,$x2,$y2,$bg);
977
$fg = $self->set_pen($lw,$fg) if $lw > 1;
980
$gd->rectangle($x1,$y1,$x2,$y2,$fg);
982
# if the left end is off the end, then cover over
984
my ($width) = $gd->getBounds;
986
$bg = $self->set_pen($lw,$bg) if $lw > 1;
988
$gd->line($x1,$y1+$lw,$x1,$y2-$lw,$bg)
989
if $x1 < $self->panel->pad_left;
991
$gd->line($x2,$y1+$lw,$x2,$y2-$lw,$bg)
992
if $x2 > $width - $self->panel->pad_right;
998
my ($x1,$y1,$x2,$y2,$bg,$fg,$lw) = @_;
999
my $cx = ($x1+$x2)/2;
1000
my $cy = ($y1+$y2)/2;
1002
$fg ||= $self->fgcolor;
1003
$bg ||= $self->bgcolor;
1004
$lw ||= $self->linewidth;
1006
$fg = $self->set_pen($lw) if $lw > 1;
1008
# Maintain backwards compatability with gd 1.8.4
1009
# which does not support the ellipse methods.
1010
# can() method fails with GD::SVG...
1011
if ($gd->can('ellipse') || $gd =~ /SVG/ ) {
1012
$gd->filledEllipse($cx,$cy,$x2-$x1,$y2-$y1,$bg);
1013
# Draw the edge around the ellipse
1014
$gd->ellipse($cx,$cy,$x2-$x1,$y2-$y1,$fg);
1016
$gd->arc($cx,$cy,$x2-$x1,$y2-$y1,0,360,$fg);
1017
$gd->fillToBorder($cx,$cy,$fg,$bg);
1024
my ($x1,$y1,$x2,$y2) = @_;
1025
my $cx = ($x1+$x2)/2;
1026
my $cy = ($y1+$y2)/2;
1028
my $fg = $self->fgcolor;
1029
my $linewidth = $self->linewidth;
1030
$fg = $self->set_pen($linewidth) if $linewidth > 1;
1032
# Maintain backwards compatability with gd 1.8.4 which does not
1033
# support the ellipse method.
1034
if ($gd->can('ellipse') || $gd =~ /SVG/ ) {
1035
$gd->ellipse($cx,$cy,$x2-$x1,$y2-$y1,$fg);
1037
$gd->arc($cx,$cy,$x2-$x1,$y2-$y1,0,360,$fg);
1044
my $orientation = shift;
1045
my ($x1,$y1,$x2,$y2,$fg,$bg) = @_;
1047
$orientation *= -1 if $self->{flip};
1049
my ($width) = $gd->getBounds;
1050
my $indent = $y2-$y1 < $x2-$x1 ? $y2-$y1 : ($x2-$x1)/2;
1052
return $self->filled_box($gd,@_)
1053
if ($orientation == 0)
1054
or ($x1 < 0 && $orientation < 0)
1055
or ($x2 > $width && $orientation > 0)
1059
$fg ||= $self->fgcolor;
1060
$bg ||= $self->bgcolor;
1061
my $pkg = $self->polygon_package;
1062
my $poly = $pkg->new();
1063
if ($orientation >= 0) {
1064
$poly->addPt($x1,$y1);
1065
$poly->addPt($x2-$indent,$y1);
1066
$poly->addPt($x2,($y2+$y1)/2);
1067
$poly->addPt($x2-$indent,$y2);
1068
$poly->addPt($x1,$y2);
1070
$poly->addPt($x2,$y1);
1071
$poly->addPt($x2,$y2);
1072
$poly->addPt($x1+$indent,$y2);
1073
$poly->addPt($x1,($y2+$y1)/2);
1074
$poly->addPt($x1+$indent,$y1);
1076
$gd->filledPolygon($poly,$bg);
1077
$gd->polygon($poly,$fg);
1079
# blunt it a bit if off the end
1080
# good idea - but isn't inuitive
1081
# if ($orientation >= 0 && $x2 > $width - $self->panel->pad_right) {
1082
# $gd->filledRectangle($x2-3,$y1,$x2,$y2,$self->panel->bgcolor);
1087
shift->option('linewidth') || 1;
1093
my ($x1,$y1,$x2,$y2) = @_;
1094
if ( ($x2-$x1) >= 2 && ($y2-$y1) >= 2 ) {
1095
$gd->fill($x1+1,$y1+1,$self->bgcolor);
1100
my ($linewidth,$color) = @_;
1101
$linewidth ||= $self->linewidth;
1102
$color ||= $self->fgcolor;
1103
return $color unless $linewidth > 1;
1104
$self->panel->set_pen($linewidth,$color);
1107
sub draw_component {
1109
my ($gd,$left,$top,$partno,$total_parts) = @_;
1110
my($x1,$y1,$x2,$y2) = $self->bounds($left,$top);
1113
my $panel = $self->panel;
1114
return unless $x2 >= $panel->left and $x1 <= $panel->right;
1116
if ($self->option('strand_arrow') || $self->option('stranded')) {
1117
$self->filled_arrow($gd,$self->feature->strand,
1121
$self->filled_box($gd,
1129
return shift->option('no_subparts');
1135
my $maxdepth = $self->option('maxdepth');
1136
return $maxdepth if defined $maxdepth;
1138
# $feature->compound is an artefact from aggregators. Sadly, an aggregated feature can miss
1139
# parts that are out of the query range - this is a horrible mis-feature. Aggregated features have
1140
# a compound flag to hack around this.
1141
my $feature = $self->feature;
1142
return 1 if $feature->can('compound') && $feature->compound;
1149
my $max_depth = $self->maxdepth;
1150
return unless defined $max_depth;
1152
my $current_depth = $self->level || 0;
1153
return $current_depth >= $max_depth;
1156
# memoize _subfeat -- it's a bottleneck with segments
1159
my $feature = shift;
1161
return $self->_subfeat($feature) unless ref $self; # protect against class invocation
1163
return if $self->level == 0 && $self->no_subparts;
1164
return if $self->exceeds_depth;
1166
return @{$self->{cached_subfeat}{$feature}} if exists $self->{cached_subfeat}{$feature};
1167
my @ss = $self->_subfeat($feature);
1168
$self->{cached_subfeat}{$feature} = \@ss;
1174
my $feature = shift;
1176
return $feature->segments if $feature->can('segments');
1178
my @split = eval { my $id = $feature->location->seq_id;
1179
my @subs = $feature->location->sub_Location;
1180
grep {$id eq $_->seq_id} @subs;
1183
return @split if @split;
1185
# Either the APIs have changed, or I got confused at some point...
1186
return $feature->get_SeqFeatures if $feature->can('get_SeqFeatures');
1187
return $feature->sub_SeqFeature if $feature->can('sub_SeqFeature');
1191
# synthesize a key glyph
1194
my $feature = $self->make_key_feature;
1195
my $factory = $self->factory->clone;
1196
$factory->set_option(label => 1);
1197
$factory->set_option(description => 0);
1198
$factory->set_option(bump => 0);
1199
$factory->set_option(connector => 'solid');
1200
return $factory->make_glyph(0,$feature);
1203
# synthesize a key glyph
1204
sub make_key_feature {
1207
my $scale = 1/$self->scale; # base pairs/pixel
1209
# one segments, at pixels 0->80
1210
my $offset = $self->panel->offset;
1213
Bio::Graphics::Feature->new(-start =>0 * $scale +$offset,
1214
-end =>80*$scale+$offset,
1215
-name => $self->make_key_name(),
1223
# breaking encapsulation - this should be handled by the panel
1224
my $key = $self->option('key') || '';
1225
return $key unless $self->panel->add_category_labels;
1227
my $category = $self->option('category');
1228
my $name = defined $category ? "$key ($category)" : $key;
1234
return $self->{all_callbacks} if exists $self->{all_callbacks}; # memoize
1235
return $self->{all_callbacks} = $self->_all_callbacks;
1238
sub _all_callbacks {
1240
my $track_level = $self->option('all_callbacks');
1241
return $track_level if defined $track_level;
1242
return $self->panel->all_callbacks;
1245
sub subpart_callbacks {
1247
return $self->{subpart_callbacks} if exists $self->{subpart_callbacks}; # memoize
1248
return $self->{subpart_callbacks} = $self->_subpart_callbacks;
1251
sub _subpart_callbacks {
1253
return 1 if $self->all_callbacks;
1254
my $do_subparts = $self->option('subpart_callbacks');
1255
return $self->{level} == 0 || ($self->{level} > 0 && $do_subparts);
1258
sub default_factory {
1259
croak "no default factory implemented";
1264
delete $self->{factory};
1265
foreach (@{$self->{parts} || []}) {
1268
delete $self->{parts};
1277
Bio::Graphics::Glyph - Base class for Bio::Graphics::Glyph objects
1281
See L<Bio::Graphics::Panel>.
1285
Bio::Graphics::Glyph is the base class for all glyph objects. Each
1286
glyph is a wrapper around an Bio:SeqFeatureI object, knows how to
1287
render itself on an Bio::Graphics::Panel, and has a variety of
1288
configuration variables.
1290
End developers will not ordinarily work directly with
1291
Bio::Graphics::Glyph objects, but with Bio::Graphics::Glyph::generic
1292
and its subclasses. Similarly, most glyph developers will want to
1293
subclass from Bio::Graphics::Glyph::generic because the latter
1294
provides labeling and arrow-drawing facilities.
1298
This section describes the class and object methods for
1299
Bio::Graphics::Glyph.
1303
Bio::Graphics::Glyph objects are constructed automatically by an
1304
Bio::Graphics::Glyph::Factory, and are not usually created by
1309
=item $glyph = Bio::Graphics::Glyph-E<gt>new(-feature=E<gt>$feature,-factory=E<gt>$factory)
1311
Given a sequence feature, creates an Bio::Graphics::Glyph object to
1312
display it. The B<-feature> argument points to the Bio:SeqFeatureI
1313
object to display, and B<-factory> indicates an
1314
Bio::Graphics::Glyph::Factory object from which the glyph will fetch
1315
all its run-time configuration information. Factories are created and
1316
manipulated by the Bio::Graphics::Panel object.
1318
A standard set of options are recognized. See L<OPTIONS>.
1322
=head2 OBJECT METHODS
1324
Once a glyph is created, it responds to a large number of methods. In
1325
this section, these methods are grouped into related categories.
1327
Retrieving glyph context:
1331
=item $factory = $glyph-E<gt>factory
1333
Get the Bio::Graphics::Glyph::Factory associated with this object.
1334
This cannot be changed once it is set.
1336
=item $panel = $glyph-E<gt>panel
1338
Get the Bio::Graphics::Panel associated with this object. This cannot
1339
be changed once it is set.
1341
=item $feature = $glyph-E<gt>feature
1343
Get the sequence feature associated with this object. This cannot be
1344
changed once it is set.
1346
=item $feature = $glyph-E<gt>add_feature(@features)
1348
Add the list of features to the glyph, creating subparts. This is
1349
most common done with the track glyph returned by
1350
Ace::Graphics::Panel-E<gt>add_track().
1352
=item $feature = $glyph-E<gt>add_group(@features)
1354
This is similar to add_feature(), but the list of features is treated
1355
as a group and can be configured as a set.
1357
=item $glyph-E<gt>finished
1359
When you are finished with a glyph, you can call its finished() method
1360
in order to break cycles that would otherwise cause memory leaks.
1361
finished() is typically only used by the Panel object.
1365
Retrieving glyph options:
1369
=item $fgcolor = $glyph-E<gt>fgcolor
1371
=item $bgcolor = $glyph-E<gt>bgcolor
1373
=item $fontcolor = $glyph-E<gt>fontcolor
1375
=item $fontcolor = $glyph-E<gt>font2color
1377
=item $fillcolor = $glyph-E<gt>fillcolor
1379
These methods return the configured foreground, background, font,
1380
alternative font, and fill colors for the glyph in the form of a
1381
GD::Image color index.
1383
=item $color = $glyph-E<gt>tkcolor
1385
This method returns a color to be used to flood-fill the entire glyph
1386
before drawing (currently used by the "track" glyph).
1388
=item $width = $glyph-E<gt>width([$newwidth])
1390
Return the width of the glyph, not including left or right padding.
1391
This is ordinarily set internally based on the size of the feature and
1392
the scale of the panel.
1394
=item $width = $glyph-E<gt>layout_width
1396
Returns the width of the glyph including left and right padding.
1398
=item $width = $glyph-E<gt>height
1400
Returns the height of the glyph, not including the top or bottom
1401
padding. This is calculated from the "height" option and cannot be
1405
=item $font = $glyph-E<gt>font
1407
Return the font for the glyph.
1409
=item $option = $glyph-E<gt>option($option)
1411
Return the value of the indicated option.
1413
=item $index = $glyph-E<gt>color($color)
1415
Given a symbolic or #RRGGBB-form color name, returns its GD index.
1417
=item $level = $glyph-E<gt>level
1419
The "level" is the nesting level of the glyph.
1420
Groups are level -1, top level glyphs are level 0,
1421
subparts (e.g. exons) are level 1 and so forth.
1429
=item $glyph-E<gt>configure(-name=E<gt>$value)
1431
You may change a glyph option after it is created using set_option().
1432
This is most commonly used to configure track glyphs.
1436
Retrieving information about the sequence:
1440
=item $start = $glyph-E<gt>start
1442
=item $end = $glyph-E<gt>end
1444
These methods return the start and end of the glyph in base pair
1447
=item $offset = $glyph-E<gt>offset
1449
Returns the offset of the segment (the base pair at the far left of
1452
=item $length = $glyph-E<gt>length
1454
Returns the length of the sequence segment.
1459
Retrieving formatting information:
1463
=item $top = $glyph-E<gt>top
1465
=item $left = $glyph-E<gt>left
1467
=item $bottom = $glyph-E<gt>bottom
1469
=item $right = $glyph-E<gt>right
1471
These methods return the top, left, bottom and right of the glyph in
1474
=item $height = $glyph-E<gt>height
1476
Returns the height of the glyph. This may be somewhat larger or
1477
smaller than the height suggested by the GlyphFactory, depending on
1478
the type of the glyph.
1480
=item $scale = $glyph-E<gt>scale
1482
Get the scale for the glyph in pixels/bp.
1484
=item $height = $glyph-E<gt>labelheight
1486
Return the height of the label, if any.
1488
=item $label = $glyph-E<gt>label
1490
Return a human-readable label for the glyph.
1494
These methods are called by Bio::Graphics::Track during the layout
1499
=item $glyph-E<gt>move($dx,$dy)
1501
Move the glyph in pixel coordinates by the indicated delta-x and
1504
=item ($x1,$y1,$x2,$y2) = $glyph-E<gt>box
1506
Return the current position of the glyph.
1510
These methods are intended to be overridden in subclasses:
1514
=item $glyph-E<gt>calculate_height
1516
Calculate the height of the glyph.
1518
=item $glyph-E<gt>calculate_left
1520
Calculate the left side of the glyph.
1522
=item $glyph-E<gt>calculate_right
1524
Calculate the right side of the glyph.
1526
=item $glyph-E<gt>draw($gd,$left,$top)
1528
Optionally offset the glyph by the indicated amount and draw it onto
1529
the GD::Image object.
1531
=item $glyph-E<gt>draw_label($gd,$left,$top)
1533
Draw the label for the glyph onto the provided GD::Image object,
1534
optionally offsetting by the amounts indicated in $left and $right.
1536
=item $glyph-E<gt>maxdepth()
1538
This returns the maximum number of levels of feature subparts that the
1539
glyph will recurse through. For example, returning 0 indicates that
1540
the glyph will only draw the top-level feature. Returning 1 indicates
1541
that it will only draw the top-level feature and one level of
1542
subfeatures. Returning 2 will descend down two levels. Overriding this
1543
method will speed up rendering by avoiding creating of a bunch of
1544
subglyphs that will never be drawn.
1546
The default behavior is to return undef (unlimited levels of descent)
1547
unless the -maxdepth option is passed, in which case this number is
1550
Note that Bio::Graphics::Glyph::generic overrides maxdepth() to return
1551
0, meaning no descent into subparts will be performed.
1555
These methods are useful utility routines:
1559
=item $pixels = $glyph-E<gt>map_pt($bases);
1561
Map the indicated base position, given in base pair units, into
1562
pixels, using the current scale and glyph position.
1564
=item $glyph-E<gt>filled_box($gd,$x1,$y1,$x2,$y2)
1566
Draw a filled rectangle with the appropriate foreground and fill
1567
colors, and pen width onto the GD::Image object given by $gd, using
1568
the provided rectangle coordinates.
1570
=item $glyph-E<gt>filled_oval($gd,$x1,$y1,$x2,$y2)
1572
As above, but draws an oval inscribed on the rectangle.
1574
=item $glyph-E<gt>exceeds_depth
1576
Returns true if descending into another level of subfeatures will
1577
exceed the value returned by maxdepth().
1583
The following options are standard among all Glyphs. See individual
1584
glyph pages for more options.
1586
Option Description Default
1587
------ ----------- -------
1589
-fgcolor Foreground color black
1591
-outlinecolor Synonym for -fgcolor
1593
-bgcolor Background color turquoise
1595
-fillcolor Synonym for -bgcolor
1597
-linewidth Line width 1
1599
-height Height of glyph 10
1601
-font Glyph font gdSmallFont
1603
-connector Connector type undef (false)
1606
Connector color black
1608
-strand_arrow Whether to indicate undef (false)
1611
-label Whether to draw a label undef (false)
1613
-description Whether to draw a description undef (false)
1615
-no_subparts Set to true to prevent undef (false)
1616
drawing of the subparts
1619
-ignore_sub_part Give the types/methods of undef
1620
subparts to ignore (as a
1621
space delimited list).
1623
-maxdepth Specifies the maximum number undef (unlimited)
1624
child-generations to decend
1625
when getting subfeatures
1627
-sort_order Specify layout sort order "default"
1629
-always_sort Sort even when bumping is off undef (false)
1631
-bump_limit Maximum number of levels to bump undef (unlimited)
1633
-hilite Highlight color undef (no color)
1635
-link, -title, -target
1636
These options are used when creating imagemaps
1637
for display on the web. See L<Bio::Graphics::Panel/"Creating Imagemaps">.
1640
For glyphs that consist of multiple segments, the B<-connector> option
1641
controls what's drawn between the segments. The default is undef (no
1642
connector). Options include:
1644
"hat" an upward-angling conector
1645
"solid" a straight horizontal connector
1646
"quill" a decorated line with small arrows indicating strandedness
1647
(like the UCSC Genome Browser uses)
1648
"dashed" a horizontal dashed line.
1649
"crossed" a straight horizontal connector with an "X" on it
1650
(Can be used when segments are not yet validated
1651
by some internal experiments...)
1653
The B<-connector_color> option controls the color of the connector, if
1656
The label is printed above the glyph. You may pass an anonymous
1657
subroutine to B<-label>, in which case the subroutine will be invoked
1658
with the feature as its single argument. and is expected to return
1659
the string to use as the description. If you provide the numeric
1660
value "1" to B<-description>, the description will be read off the
1661
feature's seqname(), info() and primary_tag() methods will be called
1662
until a suitable name is found. To create a label with the
1663
text "1", pass the string "1 ". (A 1 followed by a space).
1665
The description is printed below the glyph. You may pass an anonymous
1666
subroutine to B<-description>, in which case the subroutine will be
1667
invoked with the feature as its single argument and is expected to
1668
return the string to use as the description. If you provide the
1669
numeric value "1" to B<-description>, the description will be read off
1670
the feature's source_tag() method. To create a description with the
1671
text "1", pass the string "1 ". (A 1 followed by a space).
1673
In the case of ACEDB Ace::Sequence feature objects, the feature's
1674
info(), Brief_identification() and Locus() methods will be called to
1675
create a suitable description.
1677
The B<-strand_arrow> option, if true, requests that the glyph indicate
1678
which strand it is on, usually by drawing an arrowhead. Not all
1679
glyphs will respond to this request. For historical reasons,
1680
B<-stranded> is a synonym for this option.
1682
B<sort_order>: By default, features are drawn with a layout based only on the
1683
position of the feature, assuring a maximal "packing" of the glyphs
1684
when bumped. In some cases, however, it makes sense to display the
1685
glyphs sorted by score or some other comparison, e.g. such that more
1686
"important" features are nearer the top of the display, stacked above
1687
less important features. The -sort_order option allows a few
1688
different built-in values for changing the default sort order (which
1689
is by "left" position): "low_score" (or "high_score") will cause
1690
features to be sorted from lowest to highest score (or vice versa).
1691
"left" (or "default") and "right" values will cause features to be
1692
sorted by their position in the sequence. "longer" (or "shorter")
1693
will cause the longest (or shortest) features to be sorted first, and
1694
"strand" will cause the features to be sorted by strand: "+1"
1695
(forward) then "0" (unknown, or NA) then "-1" (reverse).
1697
In all cases, the "left" position will be used to break any ties. To
1698
break ties using another field, options may be strung together using a
1699
"|" character; e.g. "strand|low_score|right" would cause the features
1700
to be sorted first by strand, then score (lowest to highest), then by
1701
"right" position in the sequence.
1703
Finally, a subroutine coderef with a $$ prototype can be provided. It
1704
will receive two B<glyph> as arguments and should return -1, 0 or 1
1705
(see Perl's sort() function for more information). For example, to
1706
sort a set of database search hits by bits (stored in the features'
1707
"score" fields), scaled by the log of the alignment length (with
1708
"start" position breaking any ties):
1710
sort_order = sub ($$) {
1711
my ($glyph1,$glyph2) = @_;
1712
my $a = $glyph1->feature;
1713
my $b = $glyph2->feature;
1714
( $b->score/log($b->length)
1716
$a->score/log($a->length) )
1718
( $a->start <=> $b->start )
1721
It is important to remember to use the $$ prototype as shown in the
1722
example. Otherwise Bio::Graphics will quit with an exception. The
1723
arguments are subclasses of Bio::Graphics::Glyph, not the features
1724
themselves. While glyphs implement some, but not all, of the feature
1725
methods, to be safe call the two glyphs' feature() methods in order to
1726
convert them into the actual features.
1728
The '-always_sort' option, if true, will sort features even if bumping
1729
is turned off. This is useful if you would like overlapping features
1730
to stack in a particular order. Features towards the end of the list
1731
will overlay those towards the beginning of the sort order.
1733
The B<-hilite> option draws a colored box behind each feature using the
1734
indicated color. Typically you will pass it a code ref that returns a
1735
color name. For example:
1737
-hilite => sub { my $name = shift->display_name;
1738
return 'yellow' if $name =~ /XYZ/ }
1740
The B<-no_subparts> option will prevent the glyph from searching its
1741
feature for subfeatures. This may enhance performance if you know in
1742
advance that none of your features contain subfeatures.
1744
=head1 SUBCLASSING Bio::Graphics::Glyph
1746
By convention, subclasses are all lower-case. Begin each subclass
1747
with a preamble like this one:
1749
package Bio::Graphics::Glyph::crossbox;
1752
use base qw(Bio::Graphics::Glyph);
1754
Then override the methods you need to. Typically, just the draw()
1755
method will need to be overridden. However, if you need additional
1756
room in the glyph, you may override calculate_height(),
1757
calculate_left() and calculate_right(). Do not directly override
1758
height(), left() and right(), as their purpose is to cache the values
1759
returned by their calculating cousins in order to avoid time-consuming
1762
A simple draw() method looks like this:
1766
$self->SUPER::draw(@_);
1769
# and draw a cross through the box
1770
my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
1771
my $fg = $self->fgcolor;
1772
$gd->line($x1,$y1,$x2,$y2,$fg);
1773
$gd->line($x1,$y2,$x2,$y1,$fg);
1776
This subclass draws a simple box with two lines criss-crossed through
1777
it. We first call our inherited draw() method to generate the filled
1778
box and label. We then call calculate_boundaries() to return the
1779
coordinates of the glyph, disregarding any extra space taken by
1780
labels. We call fgcolor() to return the desired foreground color, and
1781
then call $gd-E<gt>line() twice to generate the criss-cross.
1783
For more complex draw() methods, see Bio::Graphics::Glyph::transcript
1784
and Bio::Graphics::Glyph::segments.
1786
Please avoid using a specific image class (via "use GD" for example)
1787
within your glyph package. Instead, rely on the image package passed
1788
to the draw() method. This approach allows for future expansion of
1789
supported image classes without requiring glyph redesign. If you need
1790
access to the specific image classes such as Polygon, Image, or Font,
1791
generate them like such:
1795
my $image_class = shift;
1797
my $polygon_package = $self->polygon_package->new()
1807
L<Bio::DB::GFF::Feature>,
1809
L<Bio::Graphics::Panel>,
1810
L<Bio::Graphics::Track>,
1811
L<Bio::Graphics::Glyph::anchored_arrow>,
1812
L<Bio::Graphics::Glyph::arrow>,
1813
L<Bio::Graphics::Glyph::box>,
1814
L<Bio::Graphics::Glyph::dna>,
1815
L<Bio::Graphics::Glyph::graded_segments>,
1816
L<Bio::Graphics::Glyph::primers>,
1817
L<Bio::Graphics::Glyph::segments>,
1818
L<Bio::Graphics::Glyph::toomany>,
1819
L<Bio::Graphics::Glyph::transcript>,
1820
L<Bio::Graphics::Glyph::transcript2>,
1821
L<Bio::Graphics::Glyph::wormbase_transcript>
1822
L<Bio::Graphics::Glyph::xyplot>
1823
L<Bio::Graphics::Glyph::whiskerplot>
1827
Lincoln Stein E<lt>lstein@cshl.orgE<gt>
1829
Copyright (c) 2001 Cold Spring Harbor Laboratory
1831
This library is free software; you can redistribute it and/or modify
1832
it under the same terms as Perl itself. See DISCLAIMER.txt for
1833
disclaimers of warranty.
added
removed
Bio/Graphics/Glyph.pm
