|
0
|
1 package Bio::Graphics::Glyph::cds;
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use Bio::Graphics::Glyph::segments;
|
|
|
5 use Bio::Graphics::Util qw(frame_and_offset);
|
|
|
6 use Bio::Tools::CodonTable;
|
|
|
7 use Bio::Graphics::Glyph::translation;
|
|
|
8 use vars '@ISA';
|
|
|
9 @ISA = qw(Bio::Graphics::Glyph::segmented_keyglyph Bio::Graphics::Glyph::translation);
|
|
|
10
|
|
|
11 my %default_colors = qw(
|
|
|
12 frame0f cadetblue
|
|
|
13 frame1f blue
|
|
|
14 frame2f darkblue
|
|
|
15 frame0r darkred
|
|
|
16 frame1r red
|
|
|
17 frame2r crimson
|
|
|
18 );
|
|
|
19
|
|
|
20 sub connector { 0 };
|
|
|
21 sub description {
|
|
|
22 my $self = shift;
|
|
|
23 return if $self->level;
|
|
|
24 return $self->SUPER::description;
|
|
|
25 };
|
|
|
26
|
|
|
27 sub default_color {
|
|
|
28 my ($self,$key) = @_;
|
|
|
29 return $self->factory->translate_color($default_colors{$key});
|
|
|
30 }
|
|
|
31
|
|
|
32 sub sixframe {
|
|
|
33 my $self = shift;
|
|
|
34 $self->{sixframe} = $self->option('sixframe')
|
|
|
35 unless exists $self->{sixframe};
|
|
|
36 return $self->{sixframe};
|
|
|
37 }
|
|
|
38
|
|
|
39 sub require_subparts {
|
|
|
40 my $self = shift;
|
|
|
41 my $rs = $self->option('require_subparts');
|
|
|
42 $rs = $self->feature->type eq 'coding' if !defined $rs; # shortcut for the "coding" aggregator
|
|
|
43 $rs;
|
|
|
44 }
|
|
|
45
|
|
|
46 # figure out (in advance) the color of each component
|
|
|
47 sub draw {
|
|
|
48 my $self = shift;
|
|
|
49 my ($gd,$left,$top) = @_;
|
|
|
50
|
|
|
51 my @parts = $self->parts;
|
|
|
52 @parts = $self if !@parts && $self->level == 0 && !$self->require_subparts;
|
|
|
53
|
|
|
54 my $fits = $self->protein_fits;
|
|
|
55
|
|
|
56 # draw the staff (musically speaking)
|
|
|
57 my ($x1,$y1,$x2,$y2) = $self->bounds($left,$top);
|
|
|
58 my $line_count = $self->sixframe ? 6 : 3;
|
|
|
59 my $height = ($y2-$y1)/$line_count;
|
|
|
60 my $grid = $self->gridcolor;
|
|
|
61 for (0..$line_count-1) {
|
|
|
62 my $offset = $y1+$height*$_+1;
|
|
|
63 $gd->line($x1,$offset,$x2,$offset,$grid);
|
|
|
64 }
|
|
|
65
|
|
|
66 $self->{cds_part2color} ||= {};
|
|
|
67 my $fill = $self->bgcolor;
|
|
|
68 my $strand = $self->feature->strand;
|
|
|
69
|
|
|
70 # figure out the colors of each part
|
|
|
71 # sort minus strand features backward
|
|
|
72 @parts = map { $_->[0] }
|
|
|
73 sort { $b->[1] <=> $a->[1] }
|
|
|
74 map { [$_, $_->left ] } @parts if $strand < 0;
|
|
|
75 my $translate_table = Bio::Tools::CodonTable->new;
|
|
|
76
|
|
|
77 for (my $i=0; $i < @parts; $i++) {
|
|
|
78 my $part = $parts[$i];
|
|
|
79 my $feature = $part->feature;
|
|
|
80 my $pos = $strand > 0 ? $feature->start : $feature->end;
|
|
|
81 my $phase = eval {$feature->phase} || 0;
|
|
|
82 my ($frame,$offset) = frame_and_offset($pos,
|
|
|
83 $feature->strand,
|
|
|
84 -$phase);
|
|
|
85 my $suffix = $strand < 0 ? 'r' : 'f';
|
|
|
86 my $key = "frame$frame$suffix";
|
|
|
87 $self->{cds_frame2color}{$key} ||= $self->color($key) || $self->default_color($key) || $fill;
|
|
|
88 $part->{cds_partcolor} = $self->{cds_frame2color}{$key};
|
|
|
89 $part->{cds_frame} = $frame;
|
|
|
90 $part->{cds_offset} = $offset;
|
|
|
91
|
|
|
92 if ($fits && $part->feature->seq) {
|
|
|
93
|
|
|
94 # do in silico splicing in order to find the codon that
|
|
|
95 # arises from the splice
|
|
|
96 my $protein = $part->feature->translate(undef,undef,$phase)->seq;
|
|
|
97 $part->{cds_translation} = $protein;
|
|
|
98
|
|
|
99 BLOCK: {
|
|
|
100 length $protein >= $feature->length/3 and last BLOCK;
|
|
|
101 ($feature->length - $phase) % 3 == 0 and last BLOCK;
|
|
|
102
|
|
|
103 my $next_part = $parts[$i+1]
|
|
|
104 or do {
|
|
|
105 $part->{cds_splice_residue} = '?';
|
|
|
106 last BLOCK; };
|
|
|
107
|
|
|
108 my $next_feature = $next_part->feature or last BLOCK;
|
|
|
109 my $next_phase = eval {$next_feature->phase} or last BLOCK;
|
|
|
110 my $splice_codon = '';
|
|
|
111 my $left_of_splice = substr($feature->seq,-$next_phase,$next_phase);
|
|
|
112 my $right_of_splice = substr($next_feature->seq,0,3-$next_phase);
|
|
|
113 $splice_codon = $left_of_splice . $right_of_splice;
|
|
|
114 length $splice_codon == 3 or last BLOCK;
|
|
|
115 my $amino_acid = $translate_table->translate($splice_codon);
|
|
|
116 $part->{cds_splice_residue} = $amino_acid;
|
|
|
117 }
|
|
|
118 }
|
|
|
119 }
|
|
|
120
|
|
|
121 $self->Bio::Graphics::Glyph::generic::draw($gd,$left,$top);
|
|
|
122 }
|
|
|
123
|
|
|
124
|
|
|
125 # draw the notes on the staff
|
|
|
126 sub draw_component {
|
|
|
127 my $self = shift;
|
|
|
128 my $gd = shift;
|
|
|
129 my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
|
|
|
130
|
|
|
131 my $color = $self->{cds_partcolor} or return;
|
|
|
132 my $feature = $self->feature;
|
|
|
133 my $frame = $self->{cds_frame};
|
|
|
134 my $linecount = $self->sixframe ? 6 : 3;
|
|
|
135
|
|
|
136 unless ($self->protein_fits) {
|
|
|
137 my $height = ($y2-$y1)/$linecount;
|
|
|
138 my $offset = $y1 + $height*$frame;
|
|
|
139 $offset += ($y2-$y1)/2 if $self->sixframe && $self->strand < 0;
|
|
|
140 $gd->filledRectangle($x1,$offset,$x2,$offset+2,$color);
|
|
|
141 return;
|
|
|
142 }
|
|
|
143
|
|
|
144 # we get here if there's room to draw the primary sequence
|
|
|
145 my $font = $self->font;
|
|
|
146 my $pixels_per_residue = $self->pixels_per_residue;
|
|
|
147 my $strand = $feature->strand;
|
|
|
148 my $y = $y1-1;
|
|
|
149
|
|
|
150 $strand *= -1 if $self->{flip};
|
|
|
151
|
|
|
152 # have to remap feature start and end into pixel coords in order to:
|
|
|
153 # 1) correctly align the amino acids with the nucleotide seq
|
|
|
154 # 2) correct for the phase offset
|
|
|
155 my $start = $self->map_no_trunc($feature->start + $self->{cds_offset});
|
|
|
156 my $stop = $self->map_no_trunc($feature->end + $self->{cds_offset});
|
|
|
157 ($start,$stop) = ($stop,$start) if $self->{flip};
|
|
|
158
|
|
|
159 my @residues = split '',$self->{cds_translation};
|
|
|
160
|
|
|
161 push @residues,$self->{cds_splice_residue} if $self->{cds_splice_residue};
|
|
|
162 for (my $i=0;$i<@residues;$i++) {
|
|
|
163 my $x = $strand > 0 ? $start + $i * $pixels_per_residue
|
|
|
164 : $stop - $i * $pixels_per_residue;
|
|
|
165 next unless ($x >= $x1 && $x <= $x2);
|
|
|
166 $gd->char($font,$x+1,$y,$residues[$i],$color);
|
|
|
167 }
|
|
|
168 }
|
|
|
169
|
|
|
170 sub make_key_feature {
|
|
|
171 my $self = shift;
|
|
|
172 my @gatc = qw(g a t c);
|
|
|
173 my $offset = $self->panel->offset;
|
|
|
174 my $scale = 1/$self->scale; # base pairs/pixel
|
|
|
175 my $start = $offset;
|
|
|
176 my $stop = $offset + 100 * $scale;
|
|
|
177 my $seq = join('',map{$gatc[rand 4]} (1..1500));
|
|
|
178 my $feature =
|
|
|
179 Bio::Graphics::Feature->new(-start=> $start,
|
|
|
180 -end => $stop,
|
|
|
181 -seq => $seq,
|
|
|
182 -name => $self->option('key'),
|
|
|
183 -strand=> +1,
|
|
|
184 );
|
|
|
185 $feature->add_segment(Bio::Graphics::Feature->new(
|
|
|
186 -start=> $start,
|
|
|
187 -end => $start + ($stop - $start)/2,
|
|
|
188 -seq => $seq,
|
|
|
189 -name => $self->option('key'),
|
|
|
190 -strand=> +1,
|
|
|
191 ),
|
|
|
192 Bio::Graphics::Feature->new(
|
|
|
193 -start=> $start + ($stop - $start)/2+1,
|
|
|
194 -end => $stop,
|
|
|
195 -seq => $seq,
|
|
|
196 -name => $self->option('key'),
|
|
|
197 -phase=> 1,
|
|
|
198 -strand=> +1,
|
|
|
199 ));
|
|
|
200 $feature;
|
|
|
201 }
|
|
|
202
|
|
|
203 # never allow our components to bump
|
|
|
204 sub bump {
|
|
|
205 my $self = shift;
|
|
|
206 return $self->SUPER::bump(@_) if $self->all_callbacks;
|
|
|
207 return 0;
|
|
|
208 }
|
|
|
209
|
|
|
210 1;
|
|
|
211
|
|
|
212 __END__
|
|
|
213
|
|
|
214 =head1 NAME
|
|
|
215
|
|
|
216 Bio::Graphics::Glyph::cds - The "cds" glyph
|
|
|
217
|
|
|
218 =head1 SYNOPSIS
|
|
|
219
|
|
|
220 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
|
221
|
|
|
222 =head1 DESCRIPTION
|
|
|
223
|
|
|
224 This glyph draws features that are associated with a protein coding
|
|
|
225 region. At high magnifications, draws a series of boxes that are
|
|
|
226 color-coded to indicate the frame in which the translation occurs. At
|
|
|
227 low magnifications, draws the amino acid sequence of the resulting
|
|
|
228 protein. Amino acids that are created by a splice are optionally
|
|
|
229 shown in a distinctive color.
|
|
|
230
|
|
|
231 =head2 OPTIONS
|
|
|
232
|
|
|
233 The following options are standard among all Glyphs. See
|
|
|
234 L<Bio::Graphics::Glyph> for a full explanation.
|
|
|
235
|
|
|
236 Option Description Default
|
|
|
237 ------ ----------- -------
|
|
|
238
|
|
|
239 -fgcolor Foreground color black
|
|
|
240
|
|
|
241 -outlinecolor Synonym for -fgcolor
|
|
|
242
|
|
|
243 -bgcolor Background color turquoise
|
|
|
244
|
|
|
245 -fillcolor Synonym for -bgcolor
|
|
|
246
|
|
|
247 -linewidth Line width 1
|
|
|
248
|
|
|
249 -height Height of glyph 10
|
|
|
250
|
|
|
251 -font Glyph font gdSmallFont
|
|
|
252
|
|
|
253 -connector Connector type 0 (false)
|
|
|
254
|
|
|
255 -connector_color
|
|
|
256 Connector color black
|
|
|
257
|
|
|
258 -label Whether to draw a label 0 (false)
|
|
|
259
|
|
|
260 -description Whether to draw a description 0 (false)
|
|
|
261
|
|
|
262 -strand_arrow Whether to indicate 0 (false)
|
|
|
263 strandedness
|
|
|
264
|
|
|
265 In addition, the alignment glyph recognizes the following
|
|
|
266 glyph-specific options:
|
|
|
267
|
|
|
268 Option Description Default
|
|
|
269 ------ ----------- -------
|
|
|
270
|
|
|
271 -frame0f Color for first (+) frame background color
|
|
|
272
|
|
|
273 -frame1f Color for second (+) frame background color
|
|
|
274
|
|
|
275 -frame2f Color for third (+) frame background color
|
|
|
276
|
|
|
277 -frame0r Color for first (-) frame background color
|
|
|
278
|
|
|
279 -frame1r Color for second (-) frame background color
|
|
|
280
|
|
|
281 -frame2r Color for third (-) frame background color
|
|
|
282
|
|
|
283 -gridcolor Color for the "staff" lightslategray
|
|
|
284
|
|
|
285 -sixframe Draw a six-frame staff 0 (false; usually draws 3 frame)
|
|
|
286
|
|
|
287 -require_subparts
|
|
|
288 Don't draw the reading frame 0 (false)
|
|
|
289 unless it is a feature
|
|
|
290 subpart.
|
|
|
291
|
|
|
292 The -require_subparts option is suggested when rendering spliced
|
|
|
293 transcripts which contain multiple CDS subparts. Otherwise, the glyph
|
|
|
294 will hickup when zoomed way down onto an intron between two CDSs (a
|
|
|
295 phantom reading frame will appear). For unspliced sequences, do *not*
|
|
|
296 use -require_subparts.
|
|
|
297
|
|
|
298 =head1 SUGGESTED STANZA FOR GENOME BROWSER
|
|
|
299
|
|
|
300 Using the "coding" aggregator, this produces a nice gbrowse display.
|
|
|
301
|
|
|
302 [CDS]
|
|
|
303 feature = coding
|
|
|
304 glyph = cds
|
|
|
305 frame0f = cadetblue
|
|
|
306 frame1f = blue
|
|
|
307 frame2f = darkblue
|
|
|
308 frame0r = darkred
|
|
|
309 frame1r = red
|
|
|
310 frame2r = crimson
|
|
|
311 description = 0
|
|
|
312 height = 13
|
|
|
313 label = CDS frame
|
|
|
314 key = CDS
|
|
|
315 citation = This track shows CDS reading frames.
|
|
|
316
|
|
|
317 =head1 BUGS
|
|
|
318
|
|
|
319 Please report them.
|
|
|
320
|
|
|
321 =head1 SEE ALSO
|
|
|
322
|
|
|
323 L<Bio::Graphics::Panel>,
|
|
|
324 L<Bio::Graphics::Glyph>,
|
|
|
325 L<Bio::Graphics::Glyph::arrow>,
|
|
|
326 L<Bio::Graphics::Glyph::cds>,
|
|
|
327 L<Bio::Graphics::Glyph::crossbox>,
|
|
|
328 L<Bio::Graphics::Glyph::diamond>,
|
|
|
329 L<Bio::Graphics::Glyph::dna>,
|
|
|
330 L<Bio::Graphics::Glyph::dot>,
|
|
|
331 L<Bio::Graphics::Glyph::ellipse>,
|
|
|
332 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
|
333 L<Bio::Graphics::Glyph::generic>,
|
|
|
334 L<Bio::Graphics::Glyph::graded_segments>,
|
|
|
335 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
|
336 L<Bio::Graphics::Glyph::line>,
|
|
|
337 L<Bio::Graphics::Glyph::pinsertion>,
|
|
|
338 L<Bio::Graphics::Glyph::primers>,
|
|
|
339 L<Bio::Graphics::Glyph::rndrect>,
|
|
|
340 L<Bio::Graphics::Glyph::segments>,
|
|
|
341 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
|
342 L<Bio::Graphics::Glyph::toomany>,
|
|
|
343 L<Bio::Graphics::Glyph::transcript>,
|
|
|
344 L<Bio::Graphics::Glyph::transcript2>,
|
|
|
345 L<Bio::Graphics::Glyph::translation>,
|
|
|
346 L<Bio::Graphics::Glyph::triangle>,
|
|
|
347 L<Bio::DB::GFF>,
|
|
|
348 L<Bio::SeqI>,
|
|
|
349 L<Bio::SeqFeatureI>,
|
|
|
350 L<Bio::Das>,
|
|
|
351 L<GD>
|
|
|
352
|
|
|
353 =head1 AUTHOR
|
|
|
354
|
|
|
355 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
|
|
|
356
|
|
|
357 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
|
358
|
|
|
359 This library is free software; you can redistribute it and/or modify
|
|
|
360 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
|
361 disclaimers of warranty.
|
|
|
362
|
|
|
363 =cut
|
