0
|
1 package Bio::Graphics::Glyph::graded_segments;
|
|
2 #$Id: graded_segments.pm,v 1.12.2.1 2003/07/05 00:32:04 lstein Exp $
|
|
3
|
|
4 use strict;
|
|
5 use Bio::Graphics::Glyph::segments;
|
|
6 use vars '@ISA';
|
|
7 @ISA = 'Bio::Graphics::Glyph::segments';
|
|
8
|
|
9 # override draw method to calculate the min and max values for the components
|
|
10 sub draw {
|
|
11 my $self = shift;
|
|
12
|
|
13 # bail out if this isn't the right kind of feature
|
|
14 # handle both das-style and Bio::SeqFeatureI style,
|
|
15 # which use different names for subparts.
|
|
16 my @parts = $self->parts;
|
|
17 @parts = $self if !@parts && $self->level == 0;
|
|
18 return $self->SUPER::draw(@_) unless @parts;
|
|
19
|
|
20 # figure out the colors
|
|
21 my $max_score = $self->option('max_score');
|
|
22 my $min_score = $self->option('min_score');
|
|
23 unless (defined $max_score && defined $min_score) {
|
|
24 for my $part (@parts) {
|
|
25 my $s = eval { $part->feature->score };
|
|
26 next unless defined $s;
|
|
27 $max_score = $s if !defined $max_score or $s > $max_score;
|
|
28 $min_score = $s if !defined $min_score or $s < $min_score;
|
|
29 }
|
|
30 }
|
|
31
|
|
32 return $self->SUPER::draw(@_)
|
|
33 unless defined($max_score) && defined($min_score)
|
|
34 && $min_score < $max_score;
|
|
35
|
|
36 my $span = $max_score - $min_score;
|
|
37
|
|
38 # allocate colors
|
|
39 my $fill = $self->bgcolor;
|
|
40 my ($red,$green,$blue) = $self->panel->rgb($fill);
|
|
41
|
|
42 foreach my $part (@parts) {
|
|
43 my $s = eval { $part->feature->score };
|
|
44 unless (defined $s) {
|
|
45 $part->{partcolor} = $fill;
|
|
46 next;
|
|
47 }
|
|
48 my ($r,$g,$b) = $self->calculate_color($s,[$red,$green,$blue],$min_score,$span);
|
|
49 my $idx = $self->panel->translate_color($r,$g,$b);
|
|
50 $part->{partcolor} = $idx;
|
|
51 }
|
|
52 $self->SUPER::draw(@_);
|
|
53 }
|
|
54
|
|
55 sub calculate_color {
|
|
56 my $self = shift;
|
|
57 my ($s,$rgb,$min_score,$span) = @_;
|
|
58 return map { 255 - (255-$_) * min(max( ($s-$min_score)/$span, 0), 1) } @$rgb;
|
|
59 }
|
|
60
|
|
61 sub min { $_[0] < $_[1] ? $_[0] : $_[1] }
|
|
62 sub max { $_[0] > $_[1] ? $_[0] : $_[1] }
|
|
63
|
|
64 sub subseq {
|
|
65 my $class = shift;
|
|
66 my $feature = shift;
|
|
67 return $feature->segments if $feature->can('segments');
|
|
68 return $feature->sub_SeqFeature if $feature->can('sub_SeqFeature');
|
|
69 return;
|
|
70 }
|
|
71
|
|
72 # synthesize a key glyph
|
|
73 sub keyglyph {
|
|
74 my $self = shift;
|
|
75
|
|
76 my $scale = 1/$self->scale; # base pairs/pixel
|
|
77
|
|
78 # two segments, at pixels 0->50, 60->80
|
|
79 my $offset = $self->panel->offset;
|
|
80
|
|
81 my $feature =
|
|
82 Bio::Graphics::Feature->new(
|
|
83 -segments=>[ [ 0*$scale +$offset,20*$scale+$offset],
|
|
84 [ 30*$scale +$offset,50*$scale+$offset],
|
|
85 [60*$scale+$offset, 80*$scale+$offset]
|
|
86 ],
|
|
87 -name => $self->option('key'),
|
|
88 -strand => '+1');
|
|
89 ($feature->segments)[0]->score(10);
|
|
90 ($feature->segments)[1]->score(50);
|
|
91 ($feature->segments)[2]->score(100);
|
|
92 my $factory = $self->factory->clone;
|
|
93 $factory->set_option(label => 1);
|
|
94 $factory->set_option(bump => 0);
|
|
95 $factory->set_option(connector => 'solid');
|
|
96 return $factory->make_glyph($feature);
|
|
97 }
|
|
98
|
|
99 # component draws a shaded box
|
|
100 sub bgcolor {
|
|
101 my $self = shift;
|
|
102 return $self->{partcolor} || $self->SUPER::bgcolor;
|
|
103 }
|
|
104 sub fgcolor {
|
|
105 my $self = shift;
|
|
106 return $self->{partcolor} || $self->SUPER::fgcolor;
|
|
107 }
|
|
108
|
|
109 1;
|
|
110
|
|
111 =head1 NAME
|
|
112
|
|
113 Bio::Graphics::Glyph::graded_segments - The "graded_segments" glyph
|
|
114
|
|
115 =head1 SYNOPSIS
|
|
116
|
|
117 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
118
|
|
119 =head1 DESCRIPTION
|
|
120
|
|
121 This is identical to the "alignment" glyph, and is used for
|
|
122 drawing features that consist of discontinuous segments. The
|
|
123 color intensity of each segment is proportionate to the score.
|
|
124
|
|
125 =head2 OPTIONS
|
|
126
|
|
127 The following options are standard among all Glyphs. See
|
|
128 L<Bio::Graphics::Glyph> for a full explanation.
|
|
129
|
|
130 Option Description Default
|
|
131 ------ ----------- -------
|
|
132
|
|
133 -fgcolor Foreground color black
|
|
134
|
|
135 -outlinecolor Synonym for -fgcolor
|
|
136
|
|
137 -bgcolor Background color turquoise
|
|
138
|
|
139 -fillcolor Synonym for -bgcolor
|
|
140
|
|
141 -linewidth Line width 1
|
|
142
|
|
143 -height Height of glyph 10
|
|
144
|
|
145 -font Glyph font gdSmallFont
|
|
146
|
|
147 -connector Connector type 0 (false)
|
|
148
|
|
149 -connector_color
|
|
150 Connector color black
|
|
151
|
|
152 -label Whether to draw a label 0 (false)
|
|
153
|
|
154 -description Whether to draw a description 0 (false)
|
|
155
|
|
156 In addition, the alignment glyph recognizes the following
|
|
157 glyph-specific options:
|
|
158
|
|
159 Option Description Default
|
|
160 ------ ----------- -------
|
|
161
|
|
162 -max_score Maximum value of the Calculated
|
|
163 feature's "score" attribute
|
|
164
|
|
165 -min_score Minimum value of the Calculated
|
|
166 feature's "score" attribute
|
|
167
|
|
168 If max_score and min_score are not specified, then the glyph will
|
|
169 calculate the local maximum and minimum scores at run time.
|
|
170
|
|
171
|
|
172 =head1 BUGS
|
|
173
|
|
174 Please report them.
|
|
175
|
|
176 =head1 SEE ALSO
|
|
177
|
|
178 L<Bio::Graphics::Panel>,
|
|
179 L<Bio::Graphics::Glyph>,
|
|
180 L<Bio::Graphics::Glyph::arrow>,
|
|
181 L<Bio::Graphics::Glyph::cds>,
|
|
182 L<Bio::Graphics::Glyph::crossbox>,
|
|
183 L<Bio::Graphics::Glyph::diamond>,
|
|
184 L<Bio::Graphics::Glyph::dna>,
|
|
185 L<Bio::Graphics::Glyph::dot>,
|
|
186 L<Bio::Graphics::Glyph::ellipse>,
|
|
187 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
188 L<Bio::Graphics::Glyph::generic>,
|
|
189 L<Bio::Graphics::Glyph::graded_segments>,
|
|
190 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
191 L<Bio::Graphics::Glyph::line>,
|
|
192 L<Bio::Graphics::Glyph::pinsertion>,
|
|
193 L<Bio::Graphics::Glyph::primers>,
|
|
194 L<Bio::Graphics::Glyph::rndrect>,
|
|
195 L<Bio::Graphics::Glyph::segments>,
|
|
196 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
197 L<Bio::Graphics::Glyph::toomany>,
|
|
198 L<Bio::Graphics::Glyph::transcript>,
|
|
199 L<Bio::Graphics::Glyph::transcript2>,
|
|
200 L<Bio::Graphics::Glyph::translation>,
|
|
201 L<Bio::Graphics::Glyph::triangle>,
|
|
202 L<Bio::DB::GFF>,
|
|
203 L<Bio::SeqI>,
|
|
204 L<Bio::SeqFeatureI>,
|
|
205 L<Bio::Das>,
|
|
206 L<GD>
|
|
207
|
|
208 =head1 AUTHOR
|
|
209
|
|
210 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
|
|
211
|
|
212 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
213
|
|
214 This library is free software; you can redistribute it and/or modify
|
|
215 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
216 disclaimers of warranty.
|
|
217
|
|
218 =cut
|