0
|
1 package Bio::Graphics::Glyph::translation;
|
|
2
|
|
3 use strict;
|
|
4 use Bio::Graphics::Glyph::generic;
|
|
5 use Bio::Graphics::Util qw(frame_and_offset);
|
|
6 use vars '@ISA';
|
|
7 @ISA = qw(Bio::Graphics::Glyph::generic);
|
|
8
|
|
9 my %default_colors = qw(
|
|
10 frame0f cadetblue
|
|
11 frame1f blue
|
|
12 frame2f darkblue
|
|
13 frame0r darkred
|
|
14 frame1r red
|
|
15 frame2r crimson
|
|
16 );
|
|
17
|
|
18 # turn off description
|
|
19 sub description { 0 }
|
|
20
|
|
21 # turn off label
|
|
22 # sub label { 1 }
|
|
23
|
|
24 sub default_color {
|
|
25 my ($self,$key) = @_;
|
|
26 return $self->factory->translate_color($default_colors{$key});
|
|
27 }
|
|
28
|
|
29 sub height {
|
|
30 my $self = shift;
|
|
31 my $font = $self->font;
|
|
32 my $lines = $self->translation_type eq '3frame' ? 3
|
|
33 : $self->translation_type eq '6frame' ? 6
|
|
34 : 1;
|
|
35 return $self->protein_fits ? $lines*$font->height
|
|
36 : $self->SUPER::height;
|
|
37 }
|
|
38
|
|
39 sub pixels_per_base {
|
|
40 my $self = shift;
|
|
41 return $self->scale;
|
|
42 }
|
|
43
|
|
44 sub pixels_per_residue {
|
|
45 my $self = shift;
|
|
46 return $self->scale * 3;
|
|
47 }
|
|
48
|
|
49 sub gridcolor {
|
|
50 my $self = shift;
|
|
51 my $color = $self->option('gridcolor') || 'lightgrey';
|
|
52 $self->factory->translate_color($color);
|
|
53 }
|
|
54
|
|
55 sub protein_fits {
|
|
56 my $self = shift;
|
|
57
|
|
58 my $pixels_per_base = $self->pixels_per_residue;
|
|
59 my $font = $self->font;
|
|
60 my $font_width = $font->width;
|
|
61
|
|
62 return $pixels_per_base >= $font_width;
|
|
63 }
|
|
64
|
|
65 sub translation_type {
|
|
66 my $self = shift;
|
|
67 return $self->option('translation') || '1frame';
|
|
68 }
|
|
69
|
|
70 sub arrow_height {
|
|
71 my $self = shift;
|
|
72 $self->option('arrow_height') || 1;
|
|
73 }
|
|
74
|
|
75 sub show_stop_codons {
|
|
76 my $self = shift;
|
|
77 my $show = $self->option('stop_codons');
|
|
78 return $show if defined $show;
|
|
79 return 1;
|
|
80 }
|
|
81
|
|
82 sub show_start_codons {
|
|
83 my $self = shift;
|
|
84 my $show = $self->option('start_codons');
|
|
85 return $show if defined $show;
|
|
86 return 0;
|
|
87 }
|
|
88
|
|
89 sub strand {
|
|
90 my $self = shift;
|
|
91 return $self->option('strand') || '+1';
|
|
92 }
|
|
93
|
|
94 sub draw_component {
|
|
95 my $self = shift;
|
|
96 my $gd = shift;
|
|
97 my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
|
|
98
|
|
99 my $type = $self->translation_type;
|
|
100 my $strand = $self->strand;
|
|
101
|
|
102 my @strands = $type eq '6frame' ? (1,-1)
|
|
103 : $strand > 0 ? (1)
|
|
104 : -1;
|
|
105 my @phase = (0,2,1); # looks weird, but gives correct effect
|
|
106 for my $s (@strands) {
|
|
107 for (my $i=0; $i < @phase; $i++) {
|
|
108 $self->draw_frame($self->feature,$s,$i,$phase[$i],$gd,$x1,$y1,$x2,$y2);
|
|
109 }
|
|
110 }
|
|
111
|
|
112 }
|
|
113
|
|
114 sub draw_frame {
|
|
115 my $self = shift;
|
|
116 my ($feature,$strand,$base_offset,$phase,$gd,$x1,$y1,$x2,$y2) = @_;
|
|
117 return unless $feature->seq; # no sequence, arggh.
|
|
118 my ($seq,$pos) = $strand < 0 ? ($feature->revcom,$feature->end)
|
|
119 : ($feature,$feature->start);
|
|
120 my ($frame,$offset) = frame_and_offset($pos,$strand,$phase);
|
|
121 ($strand >= 0 ? $x1 : $x2) += $self->pixels_per_base * $offset;
|
|
122 my $lh;
|
|
123 if ($self->translation_type eq '6frame') {
|
|
124 $lh = $self->height / 6;
|
|
125 $y1 += $lh * $frame;
|
|
126 $y1 += $self->height/2 if $strand < 0;
|
|
127 } else {
|
|
128 $lh = $self->height / 3;
|
|
129 $y1 += $lh * $frame;
|
|
130 }
|
|
131
|
|
132 $y2 = $y1;
|
|
133
|
|
134 my $protein = $seq->translate(undef,undef,$base_offset)->seq;
|
|
135 my $k = $strand>=0 ? 'f' : 'r';
|
|
136 my $color = $self->color("frame$frame$k") ||
|
|
137 $self->color("frame$frame") ||
|
|
138 $self->default_color("frame$frame$k") || $self->fgcolor;
|
|
139 if ($self->protein_fits) {
|
|
140 $self->draw_protein(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
|
|
141 } else {
|
|
142 $self->draw_orfs(\$protein,$strand,$color,$gd,$x1,$y1,$x2,$y2);
|
|
143 }
|
|
144 }
|
|
145
|
|
146 sub draw_protein {
|
|
147 my $self = shift;
|
|
148 my ($protein,$strand,$color,$gd,$x1,$y1,$x2,$y2) = @_;
|
|
149 my $pixels_per_base = $self->pixels_per_base;
|
|
150 my $font = $self->font;
|
|
151
|
|
152 my @residues = split '',$$protein;
|
|
153 for (my $i=0;$i<@residues;$i++) {
|
|
154 my $x = $strand > 0
|
|
155 ? $x1 + 3 * $i * $pixels_per_base
|
|
156 : $x2 - 3 * $i * $pixels_per_base;
|
|
157 next if $x+1 < $x1;
|
|
158 last if $x > $x2;
|
|
159 $gd->char($font,$x,$y1,$residues[$i],$color);
|
|
160 }
|
|
161 }
|
|
162
|
|
163 sub draw_orfs {
|
|
164 my $self = shift;
|
|
165 my ($protein,$strand,$color,$gd,$x1,$y1,$x2,$y2) = @_;
|
|
166 my $pixels_per_base = $self->pixels_per_base * 3;
|
|
167 $y1++;
|
|
168
|
|
169 my $gcolor = $self->gridcolor;
|
|
170 $gd->line($x1,$y1,$x2,$y1,$gcolor);
|
|
171
|
|
172 if ($self->show_stop_codons) {
|
|
173 my $stops = $self->find_codons($protein,'*');
|
|
174
|
|
175 for my $stop (@$stops) {
|
|
176 my $pos = $strand > 0
|
|
177 ? $x1 + $stop * $pixels_per_base
|
|
178 : $x2 - $stop * $pixels_per_base;
|
|
179 next if $pos+1 < $x1;
|
|
180 last if $pos > $x2;
|
|
181 $gd->line($pos,$y1-2,$pos,$y1+2,$color);
|
|
182 }
|
|
183 }
|
|
184
|
|
185 my $arrowhead_height = $self->arrow_height;
|
|
186
|
|
187 if ($self->show_start_codons) {
|
|
188 my $starts = $self->find_codons($protein,'M');
|
|
189
|
|
190 for my $start (@$starts) {
|
|
191 my $pos = $strand > 0
|
|
192 ? $x1 + $start * $pixels_per_base
|
|
193 : $x2 - $start * $pixels_per_base;
|
|
194 next if $pos+1 < $x1;
|
|
195 last if $pos > $x2;
|
|
196
|
|
197 # little arrowheads at the start codons
|
|
198 $strand > 0 ? $self->arrowhead($gd,$pos-$arrowhead_height,$y1,
|
|
199 $arrowhead_height,+1)
|
|
200 : $self->arrowhead($gd,$pos+$arrowhead_height,$y1,
|
|
201 $arrowhead_height,-1)
|
|
202 }
|
|
203 }
|
|
204
|
|
205 $strand > 0 ? $self->arrowhead($gd,$x2-1,$y1,3,+1)
|
|
206 : $self->arrowhead($gd,$x1,$y1,3,-1)
|
|
207 }
|
|
208
|
|
209 sub find_codons {
|
|
210 my $self = shift;
|
|
211 my $protein = shift;
|
|
212 my $codon = shift || '*';
|
|
213 my $pos = -1;
|
|
214 my @stops;
|
|
215 while ( ($pos = index($$protein,$codon,$pos+1)) >= 0) {
|
|
216 push @stops,$pos;
|
|
217 }
|
|
218 \@stops;
|
|
219 }
|
|
220
|
|
221 sub make_key_feature {
|
|
222 my $self = shift;
|
|
223 my @gatc = qw(g a t c);
|
|
224 my $offset = $self->panel->offset;
|
|
225 my $scale = 1/$self->scale; # base pairs/pixel
|
|
226 my $start = $offset;
|
|
227 my $stop = $offset + 100 * $scale;
|
|
228 my $seq = join('',map{$gatc[rand 4]} (1..500));
|
|
229 my $feature =
|
|
230 Bio::Graphics::Feature->new(-start=> $start,
|
|
231 -end => $stop,
|
|
232 -seq => $seq,
|
|
233 -name => $self->option('key')
|
|
234 );
|
|
235 $feature;
|
|
236 }
|
|
237
|
|
238 1;
|
|
239
|
|
240 __END__
|
|
241
|
|
242 =head1 NAME
|
|
243
|
|
244 Bio::Graphics::Glyph::translation - The "6-frame translation" glyph
|
|
245
|
|
246 =head1 SYNOPSIS
|
|
247
|
|
248 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
249
|
|
250 =head1 DESCRIPTION
|
|
251
|
|
252 This glyph draws the conceptual translation of DNA sequences. At high
|
|
253 magnifications, it simply draws lines indicating open reading frames.
|
|
254 At low magnifications, it draws a conceptual protein translation.
|
|
255 Options can be used to set 1-frame, 3-frame or 6-frame translations.
|
|
256
|
|
257 =head2 OPTIONS
|
|
258
|
|
259 The following options are standard among all Glyphs. See
|
|
260 L<Bio::Graphics::Glyph> for a full explanation.
|
|
261
|
|
262 Option Description Default
|
|
263 ------ ----------- -------
|
|
264
|
|
265 -fgcolor Foreground color black
|
|
266
|
|
267 -outlinecolor Synonym for -fgcolor
|
|
268
|
|
269 -bgcolor Background color turquoise
|
|
270
|
|
271 -fillcolor Synonym for -bgcolor
|
|
272
|
|
273 -linewidth Line width 1
|
|
274
|
|
275 -height Height of glyph 10
|
|
276
|
|
277 -font Glyph font gdSmallFont
|
|
278
|
|
279 -connector Connector type 0 (false)
|
|
280
|
|
281 -connector_color
|
|
282 Connector color black
|
|
283
|
|
284 -label Whether to draw a label 0 (false)
|
|
285
|
|
286 -description Whether to draw a description 0 (false)
|
|
287
|
|
288 In addition to the common options, the following glyph-specific
|
|
289 options are recognized:
|
|
290
|
|
291 Option Description Default
|
|
292 ------ ----------- -------
|
|
293
|
|
294 -translation Type of translation to 1frame
|
|
295 perform. One of "1frame",
|
|
296 "3frame", or "6frame"
|
|
297
|
|
298 -strand Forward (+1) or reverse (-1) +1
|
|
299 translation.
|
|
300
|
|
301 -frame0 Color for the first frame fgcolor
|
|
302
|
|
303 -frame1 Color for the second frame fgcolor
|
|
304
|
|
305 -frame2 Color for the third frame fgcolor
|
|
306
|
|
307 -gridcolor Color for the horizontal lightgrey
|
|
308 lines of the reading frames
|
|
309
|
|
310 -start_codons Draw little arrowheads 0 (false)
|
|
311 indicating start codons
|
|
312
|
|
313 -stop_codons Draw little vertical ticks 1 (true)
|
|
314 indicating stop codons
|
|
315
|
|
316 -arrow_height Height of the start codon 1
|
|
317 arrowheads
|
|
318
|
|
319 =head1 SUGGESTED STANZA FOR GENOME BROWSER
|
|
320
|
|
321 This produces a nice gbrowse display in which the DNA/GC Content glyph
|
|
322 is sandwiched between the forward and reverse three-frame
|
|
323 translations. The frames are color-coordinated with the example
|
|
324 configuration for the "cds" glyph.
|
|
325
|
|
326 [TranslationF]
|
|
327 glyph = translation
|
|
328 global feature = 1
|
|
329 frame0 = cadetblue
|
|
330 frame1 = blue
|
|
331 frame2 = darkblue
|
|
332 height = 20
|
|
333 fgcolor = purple
|
|
334 strand = +1
|
|
335 translation = 3frame
|
|
336 key = 3-frame translation (forward)
|
|
337
|
|
338 [DNA/GC Content]
|
|
339 glyph = dna
|
|
340 global feature = 1
|
|
341 height = 40
|
|
342 do_gc = 1
|
|
343 fgcolor = red
|
|
344 axis_color = blue
|
|
345
|
|
346 [TranslationR]
|
|
347 glyph = translation
|
|
348 global feature = 1
|
|
349 frame0 = darkred
|
|
350 frame1 = red
|
|
351 frame2 = crimson
|
|
352 height = 20
|
|
353 fgcolor = blue
|
|
354 strand = -1
|
|
355 translation = 3frame
|
|
356 key = 3-frame translation (reverse)
|
|
357
|
|
358 =head1 BUGS
|
|
359
|
|
360 Please report them.
|
|
361
|
|
362 =head1 SEE ALSO
|
|
363
|
|
364
|
|
365 L<Bio::Graphics::Panel>,
|
|
366 L<Bio::Graphics::Glyph>,
|
|
367 L<Bio::Graphics::Glyph::arrow>,
|
|
368 L<Bio::Graphics::Glyph::cds>,
|
|
369 L<Bio::Graphics::Glyph::crossbox>,
|
|
370 L<Bio::Graphics::Glyph::diamond>,
|
|
371 L<Bio::Graphics::Glyph::dna>,
|
|
372 L<Bio::Graphics::Glyph::dot>,
|
|
373 L<Bio::Graphics::Glyph::ellipse>,
|
|
374 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
375 L<Bio::Graphics::Glyph::generic>,
|
|
376 L<Bio::Graphics::Glyph::graded_segments>,
|
|
377 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
378 L<Bio::Graphics::Glyph::line>,
|
|
379 L<Bio::Graphics::Glyph::pinsertion>,
|
|
380 L<Bio::Graphics::Glyph::primers>,
|
|
381 L<Bio::Graphics::Glyph::rndrect>,
|
|
382 L<Bio::Graphics::Glyph::segments>,
|
|
383 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
384 L<Bio::Graphics::Glyph::toomany>,
|
|
385 L<Bio::Graphics::Glyph::transcript>,
|
|
386 L<Bio::Graphics::Glyph::transcript2>,
|
|
387 L<Bio::Graphics::Glyph::translation>,
|
|
388 L<Bio::Graphics::Glyph::triangle>,
|
|
389 L<Bio::DB::GFF>,
|
|
390 L<Bio::SeqI>,
|
|
391 L<Bio::SeqFeatureI>,
|
|
392 L<Bio::Das>,
|
|
393 L<GD>
|
|
394
|
|
395 =head1 AUTHOR
|
|
396
|
|
397 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
|
|
398
|
|
399 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
400
|
|
401 This library is free software; you can redistribute it and/or modify
|
|
402 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
403 disclaimers of warranty.
|
|
404
|
|
405 =cut
|