|
0
|
1 package Bio::Graphics::Panel;
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use Bio::Graphics::Glyph::Factory;
|
|
|
5 use Bio::Graphics::Feature;
|
|
|
6 use GD;;
|
|
|
7
|
|
|
8
|
|
|
9 use constant KEYLABELFONT => gdMediumBoldFont;
|
|
|
10 use constant KEYSPACING => 5; # extra space between key columns
|
|
|
11 use constant KEYPADTOP => 5; # extra padding before the key starts
|
|
|
12 use constant KEYCOLOR => 'wheat';
|
|
|
13 use constant KEYSTYLE => 'bottom';
|
|
|
14 use constant KEYALIGN => 'left';
|
|
|
15 use constant GRIDCOLOR => 'lightcyan';
|
|
|
16 use constant MISSING_TRACK_COLOR =>'gray';
|
|
|
17
|
|
|
18 my %COLORS; # translation table for symbolic color names to RGB triple
|
|
|
19
|
|
|
20 # Create a new panel of a given width and height, and add lists of features
|
|
|
21 # one by one
|
|
|
22 sub new {
|
|
|
23 my $class = shift;
|
|
|
24 my %options = @_;
|
|
|
25
|
|
|
26 $class->read_colors() unless %COLORS;
|
|
|
27
|
|
|
28 my $length = $options{-length} || 0;
|
|
|
29 my $offset = $options{-offset} || 0;
|
|
|
30 my $spacing = $options{-spacing} || 5;
|
|
|
31 my $bgcolor = $options{-bgcolor} || 0;
|
|
|
32 my $keyfont = $options{-key_font} || KEYLABELFONT;
|
|
|
33 my $keycolor = $options{-key_color} || KEYCOLOR;
|
|
|
34 my $keyspacing = $options{-key_spacing} || KEYSPACING;
|
|
|
35 my $keystyle = $options{-key_style} || KEYSTYLE;
|
|
|
36 my $keyalign = $options{-key_align} || KEYALIGN;
|
|
|
37 my $allcallbacks = $options{-all_callbacks} || 0;
|
|
|
38 my $gridcolor = $options{-gridcolor} || GRIDCOLOR;
|
|
|
39 my $grid = $options{-grid} || 0;
|
|
|
40 my $flip = $options{-flip} || 0;
|
|
|
41 my $empty_track_style = $options{-empty_tracks} || 'key';
|
|
|
42 my $truecolor = $options{-truecolor} || 0;
|
|
|
43
|
|
|
44 if (my $seg = $options{-segment}) {
|
|
|
45 $offset = eval {$seg->start-1} || 0;
|
|
|
46 $length = $seg->length;
|
|
|
47 }
|
|
|
48
|
|
|
49 $offset ||= $options{-start}-1 if defined $options{-start};
|
|
|
50 $length ||= $options{-stop}-$options{-start}+1
|
|
|
51 if defined $options{-start} && defined $options{-stop};
|
|
|
52
|
|
|
53 return bless {
|
|
|
54 tracks => [],
|
|
|
55 width => $options{-width} || 600,
|
|
|
56 pad_top => $options{-pad_top}||0,
|
|
|
57 pad_bottom => $options{-pad_bottom}||0,
|
|
|
58 pad_left => $options{-pad_left}||0,
|
|
|
59 pad_right => $options{-pad_right}||0,
|
|
|
60 length => $length,
|
|
|
61 offset => $offset,
|
|
|
62 gridcolor => $gridcolor,
|
|
|
63 grid => $grid,
|
|
|
64 bgcolor => $bgcolor,
|
|
|
65 height => 0, # AUTO
|
|
|
66 spacing => $spacing,
|
|
|
67 key_font => $keyfont,
|
|
|
68 key_color => $keycolor,
|
|
|
69 key_spacing => $keyspacing,
|
|
|
70 key_style => $keystyle,
|
|
|
71 key_align => $keyalign,
|
|
|
72 all_callbacks => $allcallbacks,
|
|
|
73 truecolor => $truecolor,
|
|
|
74 flip => $flip,
|
|
|
75 empty_track_style => $empty_track_style,
|
|
|
76 },$class;
|
|
|
77 }
|
|
|
78
|
|
|
79 sub pad_left {
|
|
|
80 my $self = shift;
|
|
|
81 my $g = $self->{pad_left};
|
|
|
82 $self->{pad_left} = shift if @_;
|
|
|
83 $g;
|
|
|
84 }
|
|
|
85 sub pad_right {
|
|
|
86 my $self = shift;
|
|
|
87 my $g = $self->{pad_right};
|
|
|
88 $self->{pad_right} = shift if @_;
|
|
|
89 $g;
|
|
|
90 }
|
|
|
91 sub pad_top {
|
|
|
92 my $self = shift;
|
|
|
93 my $g = $self->{pad_top};
|
|
|
94 $self->{pad_top} = shift if @_;
|
|
|
95 $g;
|
|
|
96 }
|
|
|
97 sub pad_bottom {
|
|
|
98 my $self = shift;
|
|
|
99 my $g = $self->{pad_bottom};
|
|
|
100 $self->{pad_bottom} = shift if @_;
|
|
|
101 $g;
|
|
|
102 }
|
|
|
103
|
|
|
104 sub flip {
|
|
|
105 my $self = shift;
|
|
|
106 my $g = $self->{flip};
|
|
|
107 $self->{flip} = shift if @_;
|
|
|
108 $g;
|
|
|
109 }
|
|
|
110
|
|
|
111 # values of empty_track_style are:
|
|
|
112 # "suppress" -- suppress empty tracks entirely (default)
|
|
|
113 # "key" -- show just the key in "between" mode
|
|
|
114 # "line" -- draw a thin grey line
|
|
|
115 # "dashed" -- draw a dashed line
|
|
|
116 sub empty_track_style {
|
|
|
117 my $self = shift;
|
|
|
118 my $g = $self->{empty_track_style};
|
|
|
119 $self->{empty_track_style} = shift if @_;
|
|
|
120 $g;
|
|
|
121 }
|
|
|
122
|
|
|
123 sub key_style {
|
|
|
124 my $self = shift;
|
|
|
125 my $g = $self->{key_style};
|
|
|
126 $self->{key_style} = shift if @_;
|
|
|
127 $g;
|
|
|
128 }
|
|
|
129
|
|
|
130 # public routine for mapping from a base pair
|
|
|
131 # location to pixel coordinates
|
|
|
132 sub location2pixel {
|
|
|
133 my $self = shift;
|
|
|
134 my $end = $self->end + 1;
|
|
|
135 my @coords = $self->{flip} ? map { $end-$_ } @_ : @_;
|
|
|
136 $self->map_pt(@coords);
|
|
|
137 }
|
|
|
138
|
|
|
139 # numerous direct calls into array used here for performance considerations
|
|
|
140 sub map_pt {
|
|
|
141 my $self = shift;
|
|
|
142 my $offset = $self->{offset};
|
|
|
143 my $scale = $self->{scale} || $self->scale;
|
|
|
144 my $pl = $self->{pad_left};
|
|
|
145 my $pr = $self->{width} - $self->{pad_right};
|
|
|
146 my $flip = $self->{flip};
|
|
|
147 my $length = $self->{length};
|
|
|
148 my @result;
|
|
|
149 foreach (@_) {
|
|
|
150 my $val = $flip ? int (0.5 + $pr - ($length - ($_- 1)) * $scale) : int (0.5 + $pl + ($_-$offset-1) * $scale);
|
|
|
151 $val = $pl-1 if $val < $pl;
|
|
|
152 $val = $pr+1 if $val > $pr;
|
|
|
153 push @result,$val;
|
|
|
154 }
|
|
|
155 @result;
|
|
|
156 }
|
|
|
157
|
|
|
158 sub map_no_trunc {
|
|
|
159 my $self = shift;
|
|
|
160 my $offset = $self->{offset};
|
|
|
161 my $scale = $self->scale;
|
|
|
162 my $pl = $self->{pad_left};
|
|
|
163 my $pr = $self->{width} - $self->{pad_right};
|
|
|
164 my $flip = $self->{flip};
|
|
|
165 my $length = $self->{length};
|
|
|
166 my $end = $offset+$length;
|
|
|
167 my @result;
|
|
|
168 foreach (@_) {
|
|
|
169 my $val = $flip ? int (0.5 + $pl + ($end - ($_- 1)) * $scale) : int (0.5 + $pl + ($_-$offset-1) * $scale);
|
|
|
170 push @result,$val;
|
|
|
171 }
|
|
|
172 @result;
|
|
|
173 }
|
|
|
174
|
|
|
175 sub scale {
|
|
|
176 my $self = shift;
|
|
|
177 $self->{scale} ||= ($self->{width}-$self->pad_left-$self->pad_right)/($self->length);
|
|
|
178 }
|
|
|
179
|
|
|
180 sub start { shift->{offset}+1}
|
|
|
181 sub end { $_[0]->start + $_[0]->{length}-1}
|
|
|
182
|
|
|
183 sub offset { shift->{offset} }
|
|
|
184 sub width {
|
|
|
185 my $self = shift;
|
|
|
186 my $d = $self->{width};
|
|
|
187 $self->{width} = shift if @_;
|
|
|
188 $d;
|
|
|
189 # $d + $self->pad_left + $self->pad_right;
|
|
|
190 }
|
|
|
191
|
|
|
192 sub left {
|
|
|
193 my $self = shift;
|
|
|
194 $self->pad_left;
|
|
|
195 }
|
|
|
196 sub right {
|
|
|
197 my $self = shift;
|
|
|
198 $self->width - $self->pad_right;
|
|
|
199 }
|
|
|
200
|
|
|
201 sub spacing {
|
|
|
202 my $self = shift;
|
|
|
203 my $d = $self->{spacing};
|
|
|
204 $self->{spacing} = shift if @_;
|
|
|
205 $d;
|
|
|
206 }
|
|
|
207
|
|
|
208 sub key_spacing {
|
|
|
209 my $self = shift;
|
|
|
210 my $d = $self->{key_spacing};
|
|
|
211 $self->{key_spacing} = shift if @_;
|
|
|
212 $d;
|
|
|
213 }
|
|
|
214
|
|
|
215 sub length {
|
|
|
216 my $self = shift;
|
|
|
217 my $d = $self->{length};
|
|
|
218 if (@_) {
|
|
|
219 my $l = shift;
|
|
|
220 $l = $l->length if ref($l) && $l->can('length');
|
|
|
221 $self->{length} = $l;
|
|
|
222 }
|
|
|
223 $d;
|
|
|
224 }
|
|
|
225
|
|
|
226 sub gridcolor {shift->{gridcolor}}
|
|
|
227
|
|
|
228 sub all_callbacks { shift->{all_callbacks} }
|
|
|
229
|
|
|
230 sub add_track {
|
|
|
231 my $self = shift;
|
|
|
232 $self->_do_add_track(scalar(@{$self->{tracks}}),@_);
|
|
|
233 }
|
|
|
234
|
|
|
235 sub unshift_track {
|
|
|
236 my $self = shift;
|
|
|
237 $self->_do_add_track(0,@_);
|
|
|
238 }
|
|
|
239
|
|
|
240 sub insert_track {
|
|
|
241 my $self = shift;
|
|
|
242 my $position = shift;
|
|
|
243 $self->_do_add_track($position,@_);
|
|
|
244 }
|
|
|
245
|
|
|
246
|
|
|
247 # create a feature and factory pair
|
|
|
248 # see Factory.pm for the format of the options
|
|
|
249 # The thing returned is actually a generic Glyph
|
|
|
250 sub _do_add_track {
|
|
|
251 my $self = shift;
|
|
|
252 my $position = shift;
|
|
|
253
|
|
|
254 # due to indecision, we accept features
|
|
|
255 # and/or glyph types in the first two arguments
|
|
|
256 my ($features,$glyph_name) = ([],undef);
|
|
|
257 while ( @_ && $_[0] !~ /^-/) {
|
|
|
258 my $arg = shift;
|
|
|
259 $features = $arg and next if ref($arg);
|
|
|
260 $glyph_name = $arg and next unless ref($arg);
|
|
|
261 }
|
|
|
262
|
|
|
263 my %args = @_;
|
|
|
264 my ($map,$ss,%options);
|
|
|
265
|
|
|
266 foreach (keys %args) {
|
|
|
267 (my $canonical = lc $_) =~ s/^-//;
|
|
|
268 if ($canonical eq 'glyph') {
|
|
|
269 $map = $args{$_};
|
|
|
270 delete $args{$_};
|
|
|
271 } elsif ($canonical eq 'stylesheet') {
|
|
|
272 $ss = $args{$_};
|
|
|
273 delete $args{$_};
|
|
|
274 } else {
|
|
|
275 $options{$canonical} = $args{$_};
|
|
|
276 }
|
|
|
277 }
|
|
|
278
|
|
|
279 $glyph_name = $map if defined $map;
|
|
|
280 $glyph_name ||= 'generic';
|
|
|
281
|
|
|
282 local $^W = 0; # uninitialized variable warnings under 5.00503
|
|
|
283
|
|
|
284 my $panel_map =
|
|
|
285 ref($map) eq 'CODE' ? sub {
|
|
|
286 my $feature = shift;
|
|
|
287 return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' };
|
|
|
288 return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' };
|
|
|
289 return $map->($feature);
|
|
|
290 }
|
|
|
291 : ref($map) eq 'HASH' ? sub {
|
|
|
292 my $feature = shift;
|
|
|
293 return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' };
|
|
|
294 return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' };
|
|
|
295 return eval {$map->{$feature->primary_tag}} || 'generic';
|
|
|
296 }
|
|
|
297 : sub {
|
|
|
298 my $feature = shift;
|
|
|
299 return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' };
|
|
|
300 return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' };
|
|
|
301 return $glyph_name;
|
|
|
302 };
|
|
|
303
|
|
|
304 $self->_add_track($position,$features,-map=>$panel_map,-stylesheet=>$ss,-options=>\%options);
|
|
|
305 }
|
|
|
306
|
|
|
307 sub _add_track {
|
|
|
308 my $self = shift;
|
|
|
309 my ($position,$features,@options) = @_;
|
|
|
310
|
|
|
311 # build the list of features into a Bio::Graphics::Feature object
|
|
|
312 $features = [$features] unless ref $features eq 'ARRAY';
|
|
|
313
|
|
|
314 # optional middle-level glyph is the group
|
|
|
315 foreach my $f (grep {ref $_ eq 'ARRAY'} @$features) {
|
|
|
316 next unless ref $f eq 'ARRAY';
|
|
|
317 $f = Bio::Graphics::Feature->new(
|
|
|
318 -segments=>$f,
|
|
|
319 -type => 'group'
|
|
|
320 );
|
|
|
321 }
|
|
|
322
|
|
|
323 # top-level glyph is the track
|
|
|
324 my $feature = Bio::Graphics::Feature->new(
|
|
|
325 -segments=>$features,
|
|
|
326 -start => $self->offset+1,
|
|
|
327 -stop => $self->offset+$self->length,
|
|
|
328 -type => 'track'
|
|
|
329 );
|
|
|
330
|
|
|
331 my $factory = Bio::Graphics::Glyph::Factory->new($self,@options);
|
|
|
332 my $track = $factory->make_glyph(-1,$feature);
|
|
|
333
|
|
|
334 splice(@{$self->{tracks}},$position,0,$track);
|
|
|
335 return $track;
|
|
|
336 }
|
|
|
337
|
|
|
338 sub height {
|
|
|
339 my $self = shift;
|
|
|
340 my $spacing = $self->spacing;
|
|
|
341 my $key_height = $self->format_key;
|
|
|
342 my $empty_track_style = $self->empty_track_style;
|
|
|
343 my $key_style = $self->key_style;
|
|
|
344 my $bottom_key = $key_style eq 'bottom';
|
|
|
345 my $between_key = $key_style eq 'between';
|
|
|
346 my $draw_empty = $empty_track_style =~ /^(line|dashed)$/;
|
|
|
347 my $keyheight = $self->{key_font}->height;
|
|
|
348 my $height = 0;
|
|
|
349 for my $track (@{$self->{tracks}}) {
|
|
|
350 my $draw_between = $between_key && $track->option('key');
|
|
|
351 my $has_parts = $track->parts;
|
|
|
352 next if !$has_parts && ($empty_track_style eq 'suppress'
|
|
|
353 or $empty_track_style eq 'key' && $bottom_key);
|
|
|
354 $height += $keyheight if $draw_between;
|
|
|
355 $height += $self->spacing;
|
|
|
356 $height += $track->layout_height;
|
|
|
357 }
|
|
|
358
|
|
|
359 # get rid of spacing under last track
|
|
|
360 $height -= $self->spacing unless $bottom_key;
|
|
|
361 return $height + $key_height + $self->pad_top + $self->pad_bottom;
|
|
|
362 }
|
|
|
363
|
|
|
364 sub gd {
|
|
|
365 my $self = shift;
|
|
|
366 my $existing_gd = shift;
|
|
|
367
|
|
|
368 local $^W = 0; # can't track down the uninitialized variable warning
|
|
|
369
|
|
|
370 return $self->{gd} if $self->{gd};
|
|
|
371
|
|
|
372 my $width = $self->width;
|
|
|
373 my $height = $self->height;
|
|
|
374
|
|
|
375 my $gd = $existing_gd || GD::Image->new($width,$height,
|
|
|
376 ($self->{truecolor} && GD::Image->can('isTrueColor') ? 1 : ())
|
|
|
377 );
|
|
|
378
|
|
|
379 my %translation_table;
|
|
|
380 for my $name ('white','black',keys %COLORS) {
|
|
|
381 my $idx = $gd->colorAllocate(@{$COLORS{$name}});
|
|
|
382 $translation_table{$name} = $idx;
|
|
|
383 }
|
|
|
384
|
|
|
385 $self->{translations} = \%translation_table;
|
|
|
386 $self->{gd} = $gd;
|
|
|
387 if ($self->bgcolor) {
|
|
|
388 $gd->fill(0,0,$self->bgcolor);
|
|
|
389 } elsif (eval {$gd->isTrueColor}) {
|
|
|
390 $gd->fill(0,0,$translation_table{'white'});
|
|
|
391 }
|
|
|
392
|
|
|
393 my $pl = $self->pad_left;
|
|
|
394 my $pt = $self->pad_top;
|
|
|
395 my $offset = $pt;
|
|
|
396 my $keyheight = $self->{key_font}->height;
|
|
|
397 my $bottom_key = $self->{key_style} eq 'bottom';
|
|
|
398 my $between_key = $self->{key_style} eq 'between';
|
|
|
399 my $left_key = $self->{key_style} eq 'left';
|
|
|
400 my $right_key = $self->{key_style} eq 'right';
|
|
|
401 my $empty_track_style = $self->empty_track_style;
|
|
|
402 my $spacing = $self->spacing;
|
|
|
403
|
|
|
404 # we draw in two steps, once for background of tracks, and once for
|
|
|
405 # the contents. This allows the grid to sit on top of the track background.
|
|
|
406 for my $track (@{$self->{tracks}}) {
|
|
|
407 my $draw_between = $between_key && $track->option('key');
|
|
|
408 next if !$track->parts && ($empty_track_style eq 'suppress'
|
|
|
409 or $empty_track_style eq 'key' && $bottom_key);
|
|
|
410 $gd->filledRectangle($pl,
|
|
|
411 $offset,
|
|
|
412 $width-$self->pad_right,
|
|
|
413 $offset+$track->layout_height
|
|
|
414 + ($between_key ? $self->{key_font}->height : 0),
|
|
|
415 $track->tkcolor)
|
|
|
416 if defined $track->tkcolor;
|
|
|
417 $offset += $keyheight if $draw_between;
|
|
|
418 $offset += $track->layout_height + $spacing;
|
|
|
419 }
|
|
|
420
|
|
|
421 $self->draw_grid($gd) if $self->{grid};
|
|
|
422
|
|
|
423 $offset = $pt;
|
|
|
424 for my $track (@{$self->{tracks}}) {
|
|
|
425 my $draw_between = $between_key && $track->option('key');
|
|
|
426 my $has_parts = $track->parts;
|
|
|
427 next if !$has_parts && ($empty_track_style eq 'suppress'
|
|
|
428 or $empty_track_style eq 'key' && $bottom_key);
|
|
|
429
|
|
|
430 if ($draw_between) {
|
|
|
431 $offset += $self->draw_between_key($gd,$track,$offset);
|
|
|
432 }
|
|
|
433
|
|
|
434 elsif ($self->{key_style} =~ /^(left|right)$/) {
|
|
|
435 $self->draw_side_key($gd,$track,$offset,$self->{key_style});
|
|
|
436 }
|
|
|
437
|
|
|
438 $self->draw_empty($gd,$offset,$empty_track_style)
|
|
|
439 if !$has_parts && $empty_track_style=~/^(line|dashed)$/;
|
|
|
440
|
|
|
441 $track->draw($gd,0,$offset,0,1);
|
|
|
442 $self->track_position($track,$offset);
|
|
|
443 $offset += $track->layout_height + $spacing;
|
|
|
444 }
|
|
|
445
|
|
|
446
|
|
|
447 $self->draw_bottom_key($gd,$pl,$offset) if $self->{key_style} eq 'bottom';
|
|
|
448
|
|
|
449 return $self->{gd} = $gd;
|
|
|
450 }
|
|
|
451
|
|
|
452 sub boxes {
|
|
|
453 my $self = shift;
|
|
|
454 my @boxes;
|
|
|
455 my $offset = 0;
|
|
|
456
|
|
|
457 my $pl = $self->pad_left;
|
|
|
458 my $pt = $self->pad_top;
|
|
|
459 my $between_key = $self->{key_style} eq 'between';
|
|
|
460 my $bottom_key = $self->{key_style} eq 'bottom';
|
|
|
461 my $empty_track_style = $self->empty_track_style;
|
|
|
462 my $keyheight = $self->{key_font}->height;
|
|
|
463 my $spacing = $self->spacing;
|
|
|
464
|
|
|
465 for my $track (@{$self->{tracks}}) {
|
|
|
466 my $draw_between = $between_key && $track->option('key');
|
|
|
467 next if !$track->parts && ($empty_track_style eq 'suppress'
|
|
|
468 or $empty_track_style eq 'key' && $bottom_key);
|
|
|
469 $offset += $keyheight if $draw_between;
|
|
|
470 my $boxes = $track->boxes(0,$offset+$pt);
|
|
|
471 $self->track_position($track,$offset);
|
|
|
472 push @boxes,@$boxes;
|
|
|
473 $offset += $track->layout_height + $self->spacing;
|
|
|
474 }
|
|
|
475 return wantarray ? @boxes : \@boxes;
|
|
|
476 }
|
|
|
477
|
|
|
478 sub track_position {
|
|
|
479 my $self = shift;
|
|
|
480 my $track = shift;
|
|
|
481 my $d = $self->{_track_position}{$track};
|
|
|
482 $self->{_track_position}{$track} = shift if @_;
|
|
|
483 $d;
|
|
|
484 }
|
|
|
485
|
|
|
486 # draw the keys -- between
|
|
|
487 sub draw_between_key {
|
|
|
488 my $self = shift;
|
|
|
489 my ($gd,$track,$offset) = @_;
|
|
|
490 my $key = $track->option('key') or return 0;
|
|
|
491 my $x = $self->{key_align} eq 'center' ? $self->width - (CORE::length($key) * $self->{key_font}->width)/2
|
|
|
492 : $self->{key_align} eq 'right' ? $self->width - CORE::length($key)
|
|
|
493 : $self->pad_left;
|
|
|
494 $gd->string($self->{key_font},$x,$offset,$key,1);
|
|
|
495 return $self->{key_font}->height;
|
|
|
496 }
|
|
|
497
|
|
|
498 # draw the keys -- left or right side
|
|
|
499 sub draw_side_key {
|
|
|
500 my $self = shift;
|
|
|
501 my ($gd,$track,$offset,$side) = @_;
|
|
|
502 my $key = $track->option('key') or return;
|
|
|
503 my $pos = $side eq 'left' ? $self->pad_left - $self->{key_font}->width * CORE::length($key)-3
|
|
|
504 : $self->width - $self->pad_right+3;
|
|
|
505 $gd->string($self->{key_font},$pos,$offset,$key,1);
|
|
|
506 }
|
|
|
507
|
|
|
508 # draw the keys -- bottom
|
|
|
509 sub draw_bottom_key {
|
|
|
510 my $self = shift;
|
|
|
511 my ($gd,$left,$top) = @_;
|
|
|
512 my $key_glyphs = $self->{key_glyphs} or return;
|
|
|
513
|
|
|
514 my $color = $self->translate_color($self->{key_color});
|
|
|
515 $gd->filledRectangle($left,$top,$self->width - $self->pad_right,$self->height-$self->pad_bottom,$color);
|
|
|
516 $gd->string($self->{key_font},$left,KEYPADTOP+$top,"KEY:",1);
|
|
|
517 $top += $self->{key_font}->height + KEYPADTOP;
|
|
|
518
|
|
|
519 $_->draw($gd,$left,$top) foreach @$key_glyphs;
|
|
|
520 }
|
|
|
521
|
|
|
522 # Format the key section, and return its height
|
|
|
523 sub format_key {
|
|
|
524 my $self = shift;
|
|
|
525 return 0 unless $self->key_style eq 'bottom';
|
|
|
526
|
|
|
527 return $self->{key_height} if defined $self->{key_height};
|
|
|
528
|
|
|
529 my $suppress = $self->{empty_track_style} eq 'suppress';
|
|
|
530 my $between = $self->{key_style} eq 'between';
|
|
|
531
|
|
|
532 if ($between) {
|
|
|
533 my @key_tracks = $suppress
|
|
|
534 ? grep {$_->option('key') && $_->parts} @{$self->{tracks}}
|
|
|
535 : grep {$_->option('key')} @{$self->{tracks}};
|
|
|
536 return $self->{key_height} = @key_tracks * $self->{key_font}->height;
|
|
|
537 }
|
|
|
538
|
|
|
539 elsif ($self->{key_style} eq 'bottom') {
|
|
|
540
|
|
|
541 my ($height,$width) = (0,0);
|
|
|
542 my %tracks;
|
|
|
543 my @glyphs;
|
|
|
544
|
|
|
545 # determine how many glyphs become part of the key
|
|
|
546 # and their max size
|
|
|
547 for my $track (@{$self->{tracks}}) {
|
|
|
548
|
|
|
549 next unless $track->option('key');
|
|
|
550 next if $suppress && !$track->parts;
|
|
|
551
|
|
|
552 my $glyph;
|
|
|
553 if (my @parts = $track->parts) {
|
|
|
554 $glyph = $parts[0]->keyglyph;
|
|
|
555 } else {
|
|
|
556 my $t = Bio::Graphics::Feature->new(-segments=>
|
|
|
557 [Bio::Graphics::Feature->new(-start => $self->offset,
|
|
|
558 -stop => $self->offset+$self->length)]);
|
|
|
559 my $g = $track->factory->make_glyph(0,$t);
|
|
|
560 $glyph = $g->keyglyph;
|
|
|
561 }
|
|
|
562 next unless $glyph;
|
|
|
563
|
|
|
564
|
|
|
565 $tracks{$track} = $glyph;
|
|
|
566 my ($h,$w) = ($glyph->layout_height,
|
|
|
567 $glyph->layout_width);
|
|
|
568 $height = $h if $h > $height;
|
|
|
569 $width = $w if $w > $width;
|
|
|
570 push @glyphs,$glyph;
|
|
|
571
|
|
|
572 }
|
|
|
573
|
|
|
574 $width += $self->key_spacing;
|
|
|
575
|
|
|
576 # no key glyphs, no key
|
|
|
577 return $self->{key_height} = 0 unless @glyphs;
|
|
|
578
|
|
|
579 # now height and width hold the largest glyph, and $glyph_count
|
|
|
580 # contains the number of glyphs. We will format them into a
|
|
|
581 # box that is roughly 3 height/4 width (golden mean)
|
|
|
582 my $rows = 0;
|
|
|
583 my $cols = 0;
|
|
|
584 my $maxwidth = $self->width - $self->pad_left - $self->pad_right;
|
|
|
585 while (++$rows) {
|
|
|
586 $cols = @glyphs / $rows;
|
|
|
587 $cols = int ($cols+1) if $cols =~ /\./; # round upward for fractions
|
|
|
588 my $total_width = $cols * $width;
|
|
|
589 my $total_height = $rows * $width;
|
|
|
590 last if $total_width < $maxwidth;
|
|
|
591 }
|
|
|
592
|
|
|
593 # move glyphs into row-major format
|
|
|
594 my $spacing = $self->key_spacing;
|
|
|
595 my $i = 0;
|
|
|
596 for (my $c = 0; $c < $cols; $c++) {
|
|
|
597 for (my $r = 0; $r < $rows; $r++) {
|
|
|
598 my $x = $c * ($width + $spacing);
|
|
|
599 my $y = $r * ($height + $spacing);
|
|
|
600 next unless defined $glyphs[$i];
|
|
|
601 $glyphs[$i]->move($x,$y);
|
|
|
602 $i++;
|
|
|
603 }
|
|
|
604 }
|
|
|
605
|
|
|
606 $self->{key_glyphs} = \@glyphs; # remember our key glyphs
|
|
|
607 # remember our key height
|
|
|
608 return $self->{key_height} =
|
|
|
609 ($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP;
|
|
|
610 }
|
|
|
611
|
|
|
612 else { # no known key style, neither "between" nor "bottom"
|
|
|
613 return $self->{key_height} = 0;
|
|
|
614 }
|
|
|
615 }
|
|
|
616
|
|
|
617 sub draw_empty {
|
|
|
618 my $self = shift;
|
|
|
619 my ($gd,$offset,$style) = @_;
|
|
|
620 $offset += $self->spacing/2;
|
|
|
621 my $left = $self->pad_left;
|
|
|
622 my $right = $self->width-$self->pad_right;
|
|
|
623 my $color = $self->translate_color(MISSING_TRACK_COLOR);
|
|
|
624 if ($style eq 'dashed') {
|
|
|
625 $gd->setStyle($color,$color,gdTransparent,gdTransparent);
|
|
|
626 $gd->line($left,$offset,$right,$offset,gdStyled);
|
|
|
627 } else {
|
|
|
628 $gd->line($left,$offset,$right,$offset,$color);
|
|
|
629 }
|
|
|
630 $offset;
|
|
|
631 }
|
|
|
632
|
|
|
633 # draw a grid
|
|
|
634 sub draw_grid {
|
|
|
635 my $self = shift;
|
|
|
636 my $gd = shift;
|
|
|
637
|
|
|
638 my $gridcolor = $self->translate_color($self->{gridcolor});
|
|
|
639 my @positions;
|
|
|
640 if (ref $self->{grid} eq 'ARRAY') {
|
|
|
641 @positions = @{$self->{grid}};
|
|
|
642 } else {
|
|
|
643 my ($major,$minor) = $self->ticks;
|
|
|
644 my $first_tick = $minor * int(0.5 + $self->start/$minor);
|
|
|
645 for (my $i = $first_tick; $i < $self->end; $i += $minor) {
|
|
|
646 push @positions,$i;
|
|
|
647 }
|
|
|
648 }
|
|
|
649 my $pl = $self->pad_left;
|
|
|
650 my $pt = $self->pad_top;
|
|
|
651 my $pb = $self->height - $self->pad_bottom;
|
|
|
652 local $self->{flip} = 0;
|
|
|
653 for my $tick (@positions) {
|
|
|
654 my ($pos) = $self->map_pt($tick);
|
|
|
655 $gd->line($pos,$pt,$pos,$pb,$gridcolor);
|
|
|
656 }
|
|
|
657 }
|
|
|
658
|
|
|
659 # calculate major and minor ticks, given a start position
|
|
|
660 sub ticks {
|
|
|
661 my $self = shift;
|
|
|
662 my ($length,$minwidth) = @_;
|
|
|
663
|
|
|
664 $length = $self->{length} unless defined $length;
|
|
|
665 $minwidth = gdSmallFont->width*7 unless defined $minwidth;
|
|
|
666
|
|
|
667 my ($major,$minor);
|
|
|
668
|
|
|
669 # figure out tick mark scale
|
|
|
670 # we want no more than 1 major tick mark every 40 pixels
|
|
|
671 # and enough room for the labels
|
|
|
672 my $scale = $self->scale;
|
|
|
673
|
|
|
674 my $interval = 1;
|
|
|
675
|
|
|
676 while (1) {
|
|
|
677 my $pixels = $interval * $scale;
|
|
|
678 last if $pixels >= $minwidth;
|
|
|
679 $interval *= 10;
|
|
|
680 }
|
|
|
681
|
|
|
682 # to make sure a major tick shows up somewhere in the first half
|
|
|
683 #
|
|
|
684 $interval *= .5 if ($interval > 0.5*$length);
|
|
|
685
|
|
|
686 return ($interval,$interval/10);
|
|
|
687 }
|
|
|
688
|
|
|
689 # reverse of translate(); given index, return rgb triplet
|
|
|
690 sub rgb {
|
|
|
691 my $self = shift;
|
|
|
692 my $idx = shift;
|
|
|
693 my $gd = $self->{gd} or return;
|
|
|
694 return $gd->rgb($idx);
|
|
|
695 }
|
|
|
696
|
|
|
697 sub translate_color {
|
|
|
698 my $self = shift;
|
|
|
699 my @colors = @_;
|
|
|
700 if (@colors == 3) {
|
|
|
701 my $gd = $self->gd or return 1;
|
|
|
702 return $self->colorClosest($gd,@colors);
|
|
|
703 }
|
|
|
704 elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
|
|
|
705 my $gd = $self->gd or return 1;
|
|
|
706 my ($r,$g,$b) = (hex($1),hex($2),hex($3));
|
|
|
707 return $self->colorClosest($gd,$r,$g,$b);
|
|
|
708 }
|
|
|
709 else {
|
|
|
710 my $color = $colors[0];
|
|
|
711 my $table = $self->{translations} or return 1;
|
|
|
712 return defined $table->{$color} ? $table->{$color} : 1;
|
|
|
713 }
|
|
|
714 }
|
|
|
715
|
|
|
716 # workaround for bad GD
|
|
|
717 sub colorClosest {
|
|
|
718 my ($self,$gd,@c) = @_;
|
|
|
719 return $self->{closestcache}{"@c"} if exists $self->{closestcache}{"@c"};
|
|
|
720 return $self->{closestcache}{"@c"} = $gd->colorClosest(@c) if $GD::VERSION < 2.04;
|
|
|
721 my ($value,$index);
|
|
|
722 for (keys %COLORS) {
|
|
|
723 my ($r,$g,$b) = @{$COLORS{$_}};
|
|
|
724 my $dist = ($r-$c[0])**2 + ($g-$c[1])**2 + ($b-$c[2])**2;
|
|
|
725 ($value,$index) = ($dist,$_) if !defined($value) || $dist < $value;
|
|
|
726 }
|
|
|
727 return $self->{closestcache}{"@c"} = $self->{translations}{$index};
|
|
|
728 }
|
|
|
729
|
|
|
730 sub bgcolor {
|
|
|
731 my $self = shift;
|
|
|
732 return unless $self->{bgcolor};
|
|
|
733 $self->translate_color($self->{bgcolor});
|
|
|
734 }
|
|
|
735
|
|
|
736 sub set_pen {
|
|
|
737 my $self = shift;
|
|
|
738 my ($linewidth,$color) = @_;
|
|
|
739 return $self->{pens}{$linewidth,$color} if $self->{pens}{$linewidth,$color};
|
|
|
740
|
|
|
741 my $pen = $self->{pens}{$linewidth} = GD::Image->new($linewidth,$linewidth);
|
|
|
742 my @rgb = $self->rgb($color);
|
|
|
743 my $bg = $pen->colorAllocate(255,255,255);
|
|
|
744 my $fg = $pen->colorAllocate(@rgb);
|
|
|
745 $pen->fill(0,0,$fg);
|
|
|
746 $self->{gd}->setBrush($pen);
|
|
|
747 return gdBrushed;
|
|
|
748 }
|
|
|
749
|
|
|
750 sub png {
|
|
|
751 my $gd = shift->gd;
|
|
|
752 $gd->png;
|
|
|
753 }
|
|
|
754
|
|
|
755 sub read_colors {
|
|
|
756 my $class = shift;
|
|
|
757 while (<DATA>) {
|
|
|
758 chomp;
|
|
|
759 last if /^__END__/;
|
|
|
760 my ($name,$r,$g,$b) = split /\s+/;
|
|
|
761 $COLORS{$name} = [hex $r,hex $g,hex $b];
|
|
|
762 }
|
|
|
763 }
|
|
|
764
|
|
|
765 sub color_name_to_rgb {
|
|
|
766 my $class = shift;
|
|
|
767 my $color_name = shift;
|
|
|
768 $class->read_colors() unless %COLORS;
|
|
|
769 return unless $COLORS{$color_name};
|
|
|
770 return wantarray ? @{$COLORS{$color_name}}
|
|
|
771 : $COLORS{$color_name};
|
|
|
772 }
|
|
|
773
|
|
|
774 sub color_names {
|
|
|
775 my $class = shift;
|
|
|
776 $class->read_colors unless %COLORS;
|
|
|
777 return wantarray ? keys %COLORS : [keys %COLORS];
|
|
|
778 }
|
|
|
779
|
|
|
780 1;
|
|
|
781
|
|
|
782 __DATA__
|
|
|
783 white FF FF FF
|
|
|
784 black 00 00 00
|
|
|
785 aliceblue F0 F8 FF
|
|
|
786 antiquewhite FA EB D7
|
|
|
787 aqua 00 FF FF
|
|
|
788 aquamarine 7F FF D4
|
|
|
789 azure F0 FF FF
|
|
|
790 beige F5 F5 DC
|
|
|
791 bisque FF E4 C4
|
|
|
792 blanchedalmond FF EB CD
|
|
|
793 blue 00 00 FF
|
|
|
794 blueviolet 8A 2B E2
|
|
|
795 brown A5 2A 2A
|
|
|
796 burlywood DE B8 87
|
|
|
797 cadetblue 5F 9E A0
|
|
|
798 chartreuse 7F FF 00
|
|
|
799 chocolate D2 69 1E
|
|
|
800 coral FF 7F 50
|
|
|
801 cornflowerblue 64 95 ED
|
|
|
802 cornsilk FF F8 DC
|
|
|
803 crimson DC 14 3C
|
|
|
804 cyan 00 FF FF
|
|
|
805 darkblue 00 00 8B
|
|
|
806 darkcyan 00 8B 8B
|
|
|
807 darkgoldenrod B8 86 0B
|
|
|
808 darkgray A9 A9 A9
|
|
|
809 darkgreen 00 64 00
|
|
|
810 darkkhaki BD B7 6B
|
|
|
811 darkmagenta 8B 00 8B
|
|
|
812 darkolivegreen 55 6B 2F
|
|
|
813 darkorange FF 8C 00
|
|
|
814 darkorchid 99 32 CC
|
|
|
815 darkred 8B 00 00
|
|
|
816 darksalmon E9 96 7A
|
|
|
817 darkseagreen 8F BC 8F
|
|
|
818 darkslateblue 48 3D 8B
|
|
|
819 darkslategray 2F 4F 4F
|
|
|
820 darkturquoise 00 CE D1
|
|
|
821 darkviolet 94 00 D3
|
|
|
822 deeppink FF 14 100
|
|
|
823 deepskyblue 00 BF FF
|
|
|
824 dimgray 69 69 69
|
|
|
825 dodgerblue 1E 90 FF
|
|
|
826 firebrick B2 22 22
|
|
|
827 floralwhite FF FA F0
|
|
|
828 forestgreen 22 8B 22
|
|
|
829 fuchsia FF 00 FF
|
|
|
830 gainsboro DC DC DC
|
|
|
831 ghostwhite F8 F8 FF
|
|
|
832 gold FF D7 00
|
|
|
833 goldenrod DA A5 20
|
|
|
834 gray 80 80 80
|
|
|
835 green 00 80 00
|
|
|
836 greenyellow AD FF 2F
|
|
|
837 honeydew F0 FF F0
|
|
|
838 hotpink FF 69 B4
|
|
|
839 indianred CD 5C 5C
|
|
|
840 indigo 4B 00 82
|
|
|
841 ivory FF FF F0
|
|
|
842 khaki F0 E6 8C
|
|
|
843 lavender E6 E6 FA
|
|
|
844 lavenderblush FF F0 F5
|
|
|
845 lawngreen 7C FC 00
|
|
|
846 lemonchiffon FF FA CD
|
|
|
847 lightblue AD D8 E6
|
|
|
848 lightcoral F0 80 80
|
|
|
849 lightcyan E0 FF FF
|
|
|
850 lightgoldenrodyellow FA FA D2
|
|
|
851 lightgreen 90 EE 90
|
|
|
852 lightgrey D3 D3 D3
|
|
|
853 lightpink FF B6 C1
|
|
|
854 lightsalmon FF A0 7A
|
|
|
855 lightseagreen 20 B2 AA
|
|
|
856 lightskyblue 87 CE FA
|
|
|
857 lightslategray 77 88 99
|
|
|
858 lightsteelblue B0 C4 DE
|
|
|
859 lightyellow FF FF E0
|
|
|
860 lime 00 FF 00
|
|
|
861 limegreen 32 CD 32
|
|
|
862 linen FA F0 E6
|
|
|
863 magenta FF 00 FF
|
|
|
864 maroon 80 00 00
|
|
|
865 mediumaquamarine 66 CD AA
|
|
|
866 mediumblue 00 00 CD
|
|
|
867 mediumorchid BA 55 D3
|
|
|
868 mediumpurple 100 70 DB
|
|
|
869 mediumseagreen 3C B3 71
|
|
|
870 mediumslateblue 7B 68 EE
|
|
|
871 mediumspringgreen 00 FA 9A
|
|
|
872 mediumturquoise 48 D1 CC
|
|
|
873 mediumvioletred C7 15 85
|
|
|
874 midnightblue 19 19 70
|
|
|
875 mintcream F5 FF FA
|
|
|
876 mistyrose FF E4 E1
|
|
|
877 moccasin FF E4 B5
|
|
|
878 navajowhite FF DE AD
|
|
|
879 navy 00 00 80
|
|
|
880 oldlace FD F5 E6
|
|
|
881 olive 80 80 00
|
|
|
882 olivedrab 6B 8E 23
|
|
|
883 orange FF A5 00
|
|
|
884 orangered FF 45 00
|
|
|
885 orchid DA 70 D6
|
|
|
886 palegoldenrod EE E8 AA
|
|
|
887 palegreen 98 FB 98
|
|
|
888 paleturquoise AF EE EE
|
|
|
889 palevioletred DB 70 100
|
|
|
890 papayawhip FF EF D5
|
|
|
891 peachpuff FF DA B9
|
|
|
892 peru CD 85 3F
|
|
|
893 pink FF C0 CB
|
|
|
894 plum DD A0 DD
|
|
|
895 powderblue B0 E0 E6
|
|
|
896 purple 80 00 80
|
|
|
897 red FF 00 00
|
|
|
898 rosybrown BC 8F 8F
|
|
|
899 royalblue 41 69 E1
|
|
|
900 saddlebrown 8B 45 13
|
|
|
901 salmon FA 80 72
|
|
|
902 sandybrown F4 A4 60
|
|
|
903 seagreen 2E 8B 57
|
|
|
904 seashell FF F5 EE
|
|
|
905 sienna A0 52 2D
|
|
|
906 silver C0 C0 C0
|
|
|
907 skyblue 87 CE EB
|
|
|
908 slateblue 6A 5A CD
|
|
|
909 slategray 70 80 90
|
|
|
910 snow FF FA FA
|
|
|
911 springgreen 00 FF 7F
|
|
|
912 steelblue 46 82 B4
|
|
|
913 tan D2 B4 8C
|
|
|
914 teal 00 80 80
|
|
|
915 thistle D8 BF D8
|
|
|
916 tomato FF 63 47
|
|
|
917 turquoise 40 E0 D0
|
|
|
918 violet EE 82 EE
|
|
|
919 wheat F5 DE B3
|
|
|
920 whitesmoke F5 F5 F5
|
|
|
921 yellow FF FF 00
|
|
|
922 yellowgreen 9A CD 32
|
|
|
923 gradient1 00 ff 00
|
|
|
924 gradient2 0a ff 00
|
|
|
925 gradient3 14 ff 00
|
|
|
926 gradient4 1e ff 00
|
|
|
927 gradient5 28 ff 00
|
|
|
928 gradient6 32 ff 00
|
|
|
929 gradient7 3d ff 00
|
|
|
930 gradient8 47 ff 00
|
|
|
931 gradient9 51 ff 00
|
|
|
932 gradient10 5b ff 00
|
|
|
933 gradient11 65 ff 00
|
|
|
934 gradient12 70 ff 00
|
|
|
935 gradient13 7a ff 00
|
|
|
936 gradient14 84 ff 00
|
|
|
937 gradient15 8e ff 00
|
|
|
938 gradient16 99 ff 00
|
|
|
939 gradient17 a3 ff 00
|
|
|
940 gradient18 ad ff 00
|
|
|
941 gradient19 b7 ff 00
|
|
|
942 gradient20 c1 ff 00
|
|
|
943 gradient21 cc ff 00
|
|
|
944 gradient22 d6 ff 00
|
|
|
945 gradient23 e0 ff 00
|
|
|
946 gradient24 ea ff 00
|
|
|
947 gradient25 f4 ff 00
|
|
|
948 gradient26 ff ff 00
|
|
|
949 gradient27 ff f4 00
|
|
|
950 gradient28 ff ea 00
|
|
|
951 gradient29 ff e0 00
|
|
|
952 gradient30 ff d6 00
|
|
|
953 gradient31 ff cc 00
|
|
|
954 gradient32 ff c1 00
|
|
|
955 gradient33 ff b7 00
|
|
|
956 gradient34 ff ad 00
|
|
|
957 gradient35 ff a3 00
|
|
|
958 gradient36 ff 99 00
|
|
|
959 gradient37 ff 8e 00
|
|
|
960 gradient38 ff 84 00
|
|
|
961 gradient39 ff 7a 00
|
|
|
962 gradient40 ff 70 00
|
|
|
963 gradient41 ff 65 00
|
|
|
964 gradient42 ff 5b 00
|
|
|
965 gradient43 ff 51 00
|
|
|
966 gradient44 ff 47 00
|
|
|
967 gradient45 ff 3d 00
|
|
|
968 gradient46 ff 32 00
|
|
|
969 gradient47 ff 28 00
|
|
|
970 gradient48 ff 1e 00
|
|
|
971 gradient49 ff 14 00
|
|
|
972 gradient50 ff 0a 00
|
|
|
973 __END__
|
|
|
974
|
|
|
975 =head1 NAME
|
|
|
976
|
|
|
977 Bio::Graphics::Panel - Generate GD images of Bio::Seq objects
|
|
|
978
|
|
|
979 =head1 SYNOPSIS
|
|
|
980
|
|
|
981 # This script parses a GenBank or EMBL file named on the command
|
|
|
982 # line and produces a PNG rendering of it. Call it like this:
|
|
|
983 # render.pl my_file.embl | display -
|
|
|
984
|
|
|
985 use strict;
|
|
|
986 use Bio::Graphics;
|
|
|
987 use Bio::SeqIO;
|
|
|
988
|
|
|
989 my $file = shift or die "provide a sequence file as the argument";
|
|
|
990 my $io = Bio::SeqIO->new(-file=>$file) or die "could not create Bio::SeqIO";
|
|
|
991 my $seq = $io->next_seq or die "could not find a sequence in the file";
|
|
|
992
|
|
|
993 my @features = $seq->all_SeqFeatures;
|
|
|
994
|
|
|
995 # sort features by their primary tags
|
|
|
996 my %sorted_features;
|
|
|
997 for my $f (@features) {
|
|
|
998 my $tag = $f->primary_tag;
|
|
|
999 push @{$sorted_features{$tag}},$f;
|
|
|
1000 }
|
|
|
1001
|
|
|
1002 my $panel = Bio::Graphics::Panel->new(
|
|
|
1003 -length => $seq->length,
|
|
|
1004 -key_style => 'between',
|
|
|
1005 -width => 800,
|
|
|
1006 -pad_left => 10,
|
|
|
1007 -pad_right => 10,
|
|
|
1008 );
|
|
|
1009 $panel->add_track( arrow => Bio::SeqFeature::Generic->new(-start=>1,
|
|
|
1010 -end=>$seq->length),
|
|
|
1011 -bump => 0,
|
|
|
1012 -double=>1,
|
|
|
1013 -tick => 2);
|
|
|
1014 $panel->add_track(generic => Bio::SeqFeature::Generic->new(-start=>1,
|
|
|
1015 -end=>$seq->length),
|
|
|
1016 -glyph => 'generic',
|
|
|
1017 -bgcolor => 'blue',
|
|
|
1018 -label => 1,
|
|
|
1019 );
|
|
|
1020
|
|
|
1021 # general case
|
|
|
1022 my @colors = qw(cyan orange blue purple green chartreuse magenta yellow aqua);
|
|
|
1023 my $idx = 0;
|
|
|
1024 for my $tag (sort keys %sorted_features) {
|
|
|
1025 my $features = $sorted_features{$tag};
|
|
|
1026 $panel->add_track($features,
|
|
|
1027 -glyph => 'generic',
|
|
|
1028 -bgcolor => $colors[$idx++ % @colors],
|
|
|
1029 -fgcolor => 'black',
|
|
|
1030 -font2color => 'red',
|
|
|
1031 -key => "${tag}s",
|
|
|
1032 -bump => +1,
|
|
|
1033 -height => 8,
|
|
|
1034 -label => 1,
|
|
|
1035 -description => 1,
|
|
|
1036 );
|
|
|
1037 }
|
|
|
1038
|
|
|
1039 print $panel->png;
|
|
|
1040 exit 0;
|
|
|
1041
|
|
|
1042 =head1 DESCRIPTION
|
|
|
1043
|
|
|
1044 The Bio::Graphics::Panel class provides drawing and formatting
|
|
|
1045 services for any object that implements the Bio::SeqFeatureI
|
|
|
1046 interface, including Ace::Sequence::Feature and Das::Segment::Feature
|
|
|
1047 objects. It can be used to draw sequence annotations, physical
|
|
|
1048 (contig) maps, or any other type of map in which a set of discrete
|
|
|
1049 ranges need to be laid out on the number line.
|
|
|
1050
|
|
|
1051 The module supports a drawing style in which each type of feature
|
|
|
1052 occupies a discrete "track" that spans the width of the display. Each
|
|
|
1053 track will have its own distinctive "glyph", a configurable graphical
|
|
|
1054 representation of the feature.
|
|
|
1055
|
|
|
1056 The module also supports a more flexible style in which several
|
|
|
1057 different feature types and their associated glyphs can occupy the
|
|
|
1058 same track. The choice of glyph is under run-time control.
|
|
|
1059
|
|
|
1060 Semantic zooming (for instance, changing the type of glyph depending
|
|
|
1061 on the density of features) is supported by a callback system for
|
|
|
1062 configuration variables. The module has built-in support for Bio::Das
|
|
|
1063 stylesheets, and stylesheet-driven configuration can be intermixed
|
|
|
1064 with semantic zooming, if desired.
|
|
|
1065
|
|
|
1066 You can add a key to the generated image using either of two key
|
|
|
1067 styles. One style places the key captions at the top of each track.
|
|
|
1068 The other style generates a graphical key at the bottom of the image.
|
|
|
1069
|
|
|
1070 Note that this modules depends on GD.
|
|
|
1071
|
|
|
1072 =head1 METHODS
|
|
|
1073
|
|
|
1074 This section describes the class and object methods for
|
|
|
1075 Bio::Graphics::Panel.
|
|
|
1076
|
|
|
1077 Typically you will begin by creating a new Bio::Graphics::Panel
|
|
|
1078 object, passing it the desired width of the image to generate and an
|
|
|
1079 origin and length describing the coordinate range to display. The
|
|
|
1080 Bio::Graphics::Panel-E<gt>new() method has may configuration variables
|
|
|
1081 that allow you to control the appearance of the image.
|
|
|
1082
|
|
|
1083 You will then call add_track() one or more times to add sets of
|
|
|
1084 related features to the picture. add_track() places a new horizontal
|
|
|
1085 track on the image, and is likewise highly configurable. When you
|
|
|
1086 have added all the features you desire, you may call png() to convert
|
|
|
1087 the image into a PNG-format image, or boxes() to return coordinate
|
|
|
1088 information that can be used to create an imagemap.
|
|
|
1089
|
|
|
1090 =head2 CONSTRUCTORS
|
|
|
1091
|
|
|
1092 new() is the constructor for Bio::Graphics::Panel:
|
|
|
1093
|
|
|
1094 =over 4
|
|
|
1095
|
|
|
1096 =item $panel = Bio::Graphics::Panel-E<gt>new(@options)
|
|
|
1097
|
|
|
1098 The new() method creates a new panel object. The options are
|
|
|
1099 a set of tag/value pairs as follows:
|
|
|
1100
|
|
|
1101 Option Value Default
|
|
|
1102 ------ ----- -------
|
|
|
1103
|
|
|
1104 -offset Base pair to place at extreme left none
|
|
|
1105 of image, in zero-based coordinates
|
|
|
1106
|
|
|
1107 -length Length of sequence segment, in bp none
|
|
|
1108
|
|
|
1109 -start Start of range, in 1-based none
|
|
|
1110 coordinates.
|
|
|
1111
|
|
|
1112 -stop Stop of range, in 1-based none
|
|
|
1113 coordinates.
|
|
|
1114
|
|
|
1115 -segment A Bio::SeqI or Das::Segment none
|
|
|
1116 object, used to derive sequence
|
|
|
1117 range if not otherwise specified.
|
|
|
1118
|
|
|
1119 -width Desired width of image, in pixels 600
|
|
|
1120
|
|
|
1121 -spacing Spacing between tracks, in pixels 5
|
|
|
1122
|
|
|
1123 -pad_top Additional whitespace between top 0
|
|
|
1124 of image and contents, in pixels
|
|
|
1125
|
|
|
1126 -pad_bottom Additional whitespace between top 0
|
|
|
1127 of image and bottom, in pixels
|
|
|
1128
|
|
|
1129 -pad_left Additional whitespace between left 0
|
|
|
1130 of image and contents, in pixels
|
|
|
1131
|
|
|
1132 -pad_right Additional whitespace between right 0
|
|
|
1133 of image and bottom, in pixels
|
|
|
1134
|
|
|
1135 -bgcolor Background color for the panel as a white
|
|
|
1136 whole
|
|
|
1137
|
|
|
1138 -key_color Background color for the key printed wheat
|
|
|
1139 at bottom of panel (if any)
|
|
|
1140
|
|
|
1141 -key_spacing Spacing between key glyphs in the 10
|
|
|
1142 key printed at bottom of panel
|
|
|
1143 (if any)
|
|
|
1144
|
|
|
1145 -key_font Font to use in printed key gdMediumBoldFont
|
|
|
1146 captions.
|
|
|
1147
|
|
|
1148 -key_style Whether to print key at bottom of none
|
|
|
1149 panel ("bottom"), between each
|
|
|
1150 track ("between"), to the left of
|
|
|
1151 each track ("left"), to the right
|
|
|
1152 of each track ("right") or
|
|
|
1153 not at all ("none").
|
|
|
1154
|
|
|
1155 -empty_tracks What to do when a track is empty. suppress
|
|
|
1156 Options are to suppress the track
|
|
|
1157 completely ("suppress"), to show just
|
|
|
1158 the key in "between" mode ("key"),
|
|
|
1159 to draw a thin grey line ("line"),
|
|
|
1160 or to draw a dashed line ("dashed").
|
|
|
1161
|
|
|
1162 -flip flip the drawing coordinates left false
|
|
|
1163 to right, so that lower coordinates
|
|
|
1164 are to the right. This can be
|
|
|
1165 useful for drawing (-) strand
|
|
|
1166 features.
|
|
|
1167
|
|
|
1168 -all_callbacks Whether to invoke callbacks on false
|
|
|
1169 the automatic "track" and "group"
|
|
|
1170 glyphs.
|
|
|
1171
|
|
|
1172 -grid Whether to draw a vertical grid in false
|
|
|
1173 the background. Pass a scalar true
|
|
|
1174 value to have a grid drawn at
|
|
|
1175 regular intervals (corresponding
|
|
|
1176 to the minor ticks of the arrow
|
|
|
1177 glyph). Pass an array reference
|
|
|
1178 to draw the grid at the specified
|
|
|
1179 positions.
|
|
|
1180
|
|
|
1181 -gridcolor Color of the grid lightcyan
|
|
|
1182
|
|
|
1183
|
|
|
1184 Typically you will pass new() an object that implements the
|
|
|
1185 Bio::RangeI interface, providing a length() method, from which the
|
|
|
1186 panel will derive its scale.
|
|
|
1187
|
|
|
1188 $panel = Bio::Graphics::Panel->new(-segment => $sequence,
|
|
|
1189 -width => 800);
|
|
|
1190
|
|
|
1191 new() will return undef in case of an error.
|
|
|
1192
|
|
|
1193 Note that if you use the "left" or "right" key styles, you are
|
|
|
1194 responsible for allocating sufficient -pad_left or -pad_right room for
|
|
|
1195 the labels to appear. The necessary width is the number of characters
|
|
|
1196 in the longest key times the font width (gdMediumBoldFont by default)
|
|
|
1197 plus 3 pixels of internal padding. The simplest way to calculate this
|
|
|
1198 is to iterate over the possible track labels, find the largest one,
|
|
|
1199 and then to compute its width using the formula:
|
|
|
1200
|
|
|
1201 $width = gdMediumBoldFont->width * length($longest_key) +3;
|
|
|
1202
|
|
|
1203 =back
|
|
|
1204
|
|
|
1205 =head2 OBJECT METHODS
|
|
|
1206
|
|
|
1207 =over 4
|
|
|
1208
|
|
|
1209 =item $track = $panel-E<gt>add_track($glyph,$features,@options)
|
|
|
1210
|
|
|
1211 The add_track() method adds a new track to the image.
|
|
|
1212
|
|
|
1213 Tracks are horizontal bands which span the entire width of the panel.
|
|
|
1214 Each track contains a number of graphical elements called "glyphs",
|
|
|
1215 corresponding to a sequence feature.
|
|
|
1216
|
|
|
1217 There are a large number of glyph types. By default, each track will
|
|
|
1218 be homogeneous on a single glyph type, but you can mix several glyph
|
|
|
1219 types on the same track by providing a code reference to the -glyph
|
|
|
1220 argument. Other options passed to add_track() control the color and
|
|
|
1221 size of the glyphs, whether they are allowed to overlap, and other
|
|
|
1222 formatting attributes. The height of a track is determined from its
|
|
|
1223 contents and cannot be directly influenced.
|
|
|
1224
|
|
|
1225 The first two arguments are the glyph name and an array reference
|
|
|
1226 containing the list of features to display. The order of the
|
|
|
1227 arguments is irrelevant, allowing either of these idioms:
|
|
|
1228
|
|
|
1229 $panel->add_track(arrow => \@features);
|
|
|
1230 $panel->add_track(\@features => 'arrow');
|
|
|
1231
|
|
|
1232
|
|
|
1233 The glyph name indicates how each feature is to be rendered. A
|
|
|
1234 variety of glyphs are available, and the number is growing. You may
|
|
|
1235 omit the glyph name entirely by providing a B<-glyph> argument among
|
|
|
1236 @options, as described below.
|
|
|
1237
|
|
|
1238 Currently, the following glyphs are available:
|
|
|
1239
|
|
|
1240 Name Description
|
|
|
1241 ---- -----------
|
|
|
1242
|
|
|
1243 anchored_arrow
|
|
|
1244 a span with vertical bases |---------|. If one or
|
|
|
1245 the other end of the feature is off-screen, the base
|
|
|
1246 will be replaced by an arrow.
|
|
|
1247
|
|
|
1248 arrow An arrow; can be unidirectional or bidirectional.
|
|
|
1249 It is also capable of displaying a scale with
|
|
|
1250 major and minor tickmarks, and can be oriented
|
|
|
1251 horizontally or vertically.
|
|
|
1252
|
|
|
1253 cds Draws CDS features, using the phase information to
|
|
|
1254 show the reading frame usage. At high magnifications
|
|
|
1255 draws the protein translation.
|
|
|
1256
|
|
|
1257 crossbox A box with a big "X" inside it.
|
|
|
1258
|
|
|
1259 diamond A diamond, useful for point features like SNPs.
|
|
|
1260
|
|
|
1261 dna At high magnification draws the DNA sequence. At
|
|
|
1262 low magnifications draws the GC content.
|
|
|
1263
|
|
|
1264 dot A circle, useful for point features like SNPs, stop
|
|
|
1265 codons, or promoter elements.
|
|
|
1266
|
|
|
1267 ellipse An oval.
|
|
|
1268
|
|
|
1269 extending_arrow
|
|
|
1270 Similar to arrow, but a dotted line indicates when the
|
|
|
1271 feature extends beyond the end of the canvas.
|
|
|
1272
|
|
|
1273 generic A filled rectangle, nondirectional.
|
|
|
1274
|
|
|
1275 graded_segments
|
|
|
1276 Similar to segments, but the intensity of the color
|
|
|
1277 is proportional to the score of the feature. This
|
|
|
1278 is used for showing the intensity of blast hits or
|
|
|
1279 other alignment features.
|
|
|
1280
|
|
|
1281 group A group of related features connected by a dashed line.
|
|
|
1282 This is used internally by Panel.
|
|
|
1283
|
|
|
1284 heterogeneous_segments
|
|
|
1285 Like segments, but you can use the source field of the feature
|
|
|
1286 to change the color of each segment.
|
|
|
1287
|
|
|
1288 line A simple line.
|
|
|
1289
|
|
|
1290 pinsertion A triangle designed to look like an insertion location
|
|
|
1291 (e.g. a transposon insertion).
|
|
|
1292
|
|
|
1293 processed_transcript multi-purpose representation of a spliced mRNA, including
|
|
|
1294 positions of UTRs
|
|
|
1295
|
|
|
1296 primers Two inward pointing arrows connected by a line.
|
|
|
1297 Used for STSs.
|
|
|
1298
|
|
|
1299 redgreen_box A box that changes from green->yellow->red as the score
|
|
|
1300 of the feature increases from 0.0 to 1.0. Useful for
|
|
|
1301 representing microarray results.
|
|
|
1302
|
|
|
1303 rndrect A round-cornered rectangle.
|
|
|
1304
|
|
|
1305 segments A set of filled rectangles connected by solid lines.
|
|
|
1306 Used for interrupted features, such as gapped
|
|
|
1307 alignments.
|
|
|
1308
|
|
|
1309 ruler_arrow An arrow with major and minor tick marks and interval
|
|
|
1310 labels.
|
|
|
1311
|
|
|
1312 toomany Tries to show many features as a cloud. Not very successful.
|
|
|
1313
|
|
|
1314 track A group of related features not connected by a line.
|
|
|
1315 This is used internally by Panel.
|
|
|
1316
|
|
|
1317 transcript Similar to segments, but the connecting line is
|
|
|
1318 a "hat" shape, and the direction of transcription
|
|
|
1319 is indicated by a small arrow.
|
|
|
1320
|
|
|
1321 transcript2 Similar to transcript, but the direction of
|
|
|
1322 transcription is indicated by a terminal exon
|
|
|
1323 in the shape of an arrow.
|
|
|
1324
|
|
|
1325 translation 1, 2 and 3-frame translations. At low magnifications,
|
|
|
1326 can be configured to show start and stop codon locations.
|
|
|
1327 At high magnifications, shows the multi-frame protein
|
|
|
1328 translation.
|
|
|
1329
|
|
|
1330 triangle A triangle whose width and orientation can be altered.
|
|
|
1331
|
|
|
1332 xyplot Histograms and other graphs plotted against the genome.
|
|
|
1333
|
|
|
1334 If the glyph name is omitted from add_track(), the "generic" glyph
|
|
|
1335 will be used by default. To get more information about a glyph, run
|
|
|
1336 perldoc on "Bio::Graphics::Glyph::glyphname", replacing "glyphname"
|
|
|
1337 with the name of the glyph you are interested in.
|
|
|
1338
|
|
|
1339 The @options array is a list of name/value pairs that control the
|
|
|
1340 attributes of the track. Some options are interpretered directly by
|
|
|
1341 the track. Others are passed down to the individual glyphs (see
|
|
|
1342 L<"GLYPH OPTIONS">). The following options are track-specific:
|
|
|
1343
|
|
|
1344 Option Description Default
|
|
|
1345 ------ ----------- -------
|
|
|
1346
|
|
|
1347 -tkcolor Track color white
|
|
|
1348
|
|
|
1349 -glyph Glyph class to use. "generic"
|
|
|
1350
|
|
|
1351 -stylesheet Bio::Das::Stylesheet to none
|
|
|
1352 use to generate glyph
|
|
|
1353 classes and options.
|
|
|
1354
|
|
|
1355 B<-tkcolor> controls the background color of the track as a whole.
|
|
|
1356
|
|
|
1357 B<-glyph> controls the glyph type. If present, it supersedes the
|
|
|
1358 glyph name given in the first or second argument to add_track(). The
|
|
|
1359 value of B<-glyph> may be a constant string, a hash reference, or a
|
|
|
1360 code reference. In the case of a constant string, that string will be
|
|
|
1361 used as the class name for all generated glyphs. If a hash reference
|
|
|
1362 is passed, then the feature's primary_tag() will be used as the key to
|
|
|
1363 the hash, and the value, if any, used to generate the glyph type. If
|
|
|
1364 a code reference is passed, then this callback will be passed each
|
|
|
1365 feature in turn as its single argument. The callback is expected to
|
|
|
1366 examine the feature and return a glyph name as its single result.
|
|
|
1367
|
|
|
1368 Example:
|
|
|
1369
|
|
|
1370 $panel->add_track(\@exons,
|
|
|
1371 -glyph => sub { my $feature = shift;
|
|
|
1372 $feature->source_tag eq 'curated'
|
|
|
1373 ? 'ellipse' : 'generic'; }
|
|
|
1374 );
|
|
|
1375
|
|
|
1376 The B<-stylesheet> argument is used to pass a Bio::Das stylesheet
|
|
|
1377 object to the panel. This stylesheet will be called to determine both
|
|
|
1378 the glyph and the glyph options. If both a stylesheet and direct
|
|
|
1379 options are provided, the latter take precedence.
|
|
|
1380
|
|
|
1381 If successful, add_track() returns an Bio::Graphics::Glyph object.
|
|
|
1382 You can use this object to add additional features or to control the
|
|
|
1383 appearance of the track with greater detail, or just ignore it.
|
|
|
1384 Tracks are added in order from the top of the image to the bottom. To
|
|
|
1385 add tracks to the top of the image, use unshift_track().
|
|
|
1386
|
|
|
1387 B<Adding groups of features:> It is not uncommon to add a group of
|
|
|
1388 features which are logically connected, such as the 5' and 3' ends of
|
|
|
1389 EST reads. To group features into sets that remain on the same
|
|
|
1390 horizontal position and bump together, pass the sets as an anonymous
|
|
|
1391 array. For example:
|
|
|
1392
|
|
|
1393 $panel->add_track(segments => [[$abc_5,$abc_3],
|
|
|
1394 [$xxx_5,$xxx_3],
|
|
|
1395 [$yyy_5,$yyy_3]]
|
|
|
1396 );
|
|
|
1397
|
|
|
1398 Typical usage is:
|
|
|
1399
|
|
|
1400 $panel->add_track( transcript => \@genes,
|
|
|
1401 -fillcolor => 'green',
|
|
|
1402 -fgcolor => 'black',
|
|
|
1403 -bump => +1,
|
|
|
1404 -height => 10,
|
|
|
1405 -label => 1);
|
|
|
1406
|
|
|
1407 =item $track = unshift_track($glyph,$features,@options)
|
|
|
1408
|
|
|
1409 unshift_track() works like add_track(), except that the new track is
|
|
|
1410 added to the top of the image rather than the bottom.
|
|
|
1411
|
|
|
1412 =item $gd = $panel-E<gt>gd([$gd])
|
|
|
1413
|
|
|
1414 The gd() method lays out the image and returns a GD::Image object
|
|
|
1415 containing it. You may then call the GD::Image object's png() or
|
|
|
1416 jpeg() methods to get the image data.
|
|
|
1417
|
|
|
1418 Optionally, you may pass gd() a preexisting GD::Image object that you
|
|
|
1419 wish to draw on top of. If you do so, you should call the width() and
|
|
|
1420 height() methods first to ensure that the image has sufficient
|
|
|
1421 dimensions.
|
|
|
1422
|
|
|
1423 =item $png = $panel-E<gt>png
|
|
|
1424
|
|
|
1425 The png() method returns the image as a PNG-format drawing, without
|
|
|
1426 the intermediate step of returning a GD::Image object.
|
|
|
1427
|
|
|
1428 =item $boxes = $panel-E<gt>boxes
|
|
|
1429
|
|
|
1430 =item @boxes = $panel-E<gt>boxes
|
|
|
1431
|
|
|
1432 The boxes() method returns the coordinates of each glyph, useful for
|
|
|
1433 constructing an image map. In a scalar context, boxes() returns an
|
|
|
1434 array ref. In an list context, the method returns the array directly.
|
|
|
1435
|
|
|
1436 Each member of the list is an anonymous array of the following format:
|
|
|
1437
|
|
|
1438 [ $feature, $x1, $y1, $x2, $y2 ]
|
|
|
1439
|
|
|
1440 The first element is the feature object; either an
|
|
|
1441 Ace::Sequence::Feature, a Das::Segment::Feature, or another Bioperl
|
|
|
1442 Bio::SeqFeatureI object. The coordinates are the topleft and
|
|
|
1443 bottomright corners of the glyph, including any space allocated for
|
|
|
1444 labels.
|
|
|
1445
|
|
|
1446 =item $position = $panel-E<gt>track_position($track)
|
|
|
1447
|
|
|
1448 After calling gd() or boxes(), you can learn the resulting Y
|
|
|
1449 coordinate of a track by calling track_position() with the value
|
|
|
1450 returned by add_track() or unshift_track(). This will return undef if
|
|
|
1451 called before gd() or boxes() or with an invalid track.
|
|
|
1452
|
|
|
1453 =item @pixel_coords = $panel-E<gt>location2pixel(@feature_coords)
|
|
|
1454
|
|
|
1455 Public routine to map feature coordinates (in base pairs) into pixel
|
|
|
1456 coordinates relative to the left-hand edge of the picture.
|
|
|
1457
|
|
|
1458 =back
|
|
|
1459
|
|
|
1460 =head1 GLYPH OPTIONS
|
|
|
1461
|
|
|
1462 Each glyph has its own specialized subset of options, but
|
|
|
1463 some are shared by all glyphs:
|
|
|
1464
|
|
|
1465 Option Description Default
|
|
|
1466 ------ ----------- -------
|
|
|
1467
|
|
|
1468 -fgcolor Foreground color black
|
|
|
1469
|
|
|
1470 -bgcolor Background color turquoise
|
|
|
1471
|
|
|
1472 -linewidth Width of lines drawn by 1
|
|
|
1473 glyph
|
|
|
1474
|
|
|
1475 -height Height of glyph 10
|
|
|
1476
|
|
|
1477 -font Glyph font gdSmallFont
|
|
|
1478
|
|
|
1479 -fontcolor Primary font color black
|
|
|
1480
|
|
|
1481 -font2color Secondary font color turquoise
|
|
|
1482
|
|
|
1483 -label Whether to draw a label false
|
|
|
1484
|
|
|
1485 -description Whether to draw a false
|
|
|
1486 description
|
|
|
1487
|
|
|
1488 -bump Bump direction 0
|
|
|
1489
|
|
|
1490 -sort_order Specify layout sort order "default"
|
|
|
1491
|
|
|
1492 -bump_limit Maximum number of levels undef (unlimited)
|
|
|
1493 to bump
|
|
|
1494
|
|
|
1495 -strand_arrow Whether to indicate undef (false)
|
|
|
1496 strandedness
|
|
|
1497
|
|
|
1498 -stranded Synonym for -strand_arrow undef (false)
|
|
|
1499
|
|
|
1500 -connector Type of connector to none
|
|
|
1501 use to connect related
|
|
|
1502 features. Options are
|
|
|
1503 "solid," "hat", "dashed",
|
|
|
1504 "quill" and "none".
|
|
|
1505
|
|
|
1506 -key Description of track for undef
|
|
|
1507 use in key.
|
|
|
1508
|
|
|
1509 -all_callbacks Whether to invoke undef
|
|
|
1510 callbacks for autogenerated
|
|
|
1511 "track" and "group" glyphs
|
|
|
1512
|
|
|
1513 -box_subparts Return boxes around feature false
|
|
|
1514 subparts rather than around the
|
|
|
1515 feature itself.
|
|
|
1516
|
|
|
1517
|
|
|
1518 B<Specifying colors:> Colors can be expressed in either of two ways:
|
|
|
1519 as symbolic names such as "cyan" and as HTML-style #RRGGBB triples.
|
|
|
1520 The symbolic names are the 140 colors defined in the Netscape/Internet
|
|
|
1521 Explorer color cube, and can be retrieved using the
|
|
|
1522 Bio::Graphics::Panel-E<gt>color_names() method.
|
|
|
1523
|
|
|
1524 B<Foreground color:> The -fgcolor option controls the foreground
|
|
|
1525 color, including the edges of boxes and the like.
|
|
|
1526
|
|
|
1527 B<Background color:> The -bgcolor option controls the background used
|
|
|
1528 for filled boxes and other "solid" glyphs. The foreground color
|
|
|
1529 controls the color of lines and strings. The -tkcolor argument
|
|
|
1530 controls the background color of the entire track.
|
|
|
1531
|
|
|
1532 B<Track color:> The -tkcolor option used to specify the background of
|
|
|
1533 the entire track.
|
|
|
1534
|
|
|
1535 B<Font color:> The -fontcolor option controls the color of primary
|
|
|
1536 text, such as labels
|
|
|
1537
|
|
|
1538 B<Secondary Font color:> The -font2color option controls the color of
|
|
|
1539 secondary text, such as descriptions.
|
|
|
1540
|
|
|
1541 B<Labels:> The -label argument controls whether or not the ID of the
|
|
|
1542 feature should be printed next to the feature. It is accepted by all
|
|
|
1543 glyphs. By default, the label is printed just above the glyph and
|
|
|
1544 left aligned with it.
|
|
|
1545
|
|
|
1546 -label can be a constant string or a code reference. Values can be
|
|
|
1547 any of:
|
|
|
1548
|
|
|
1549 -label value Description
|
|
|
1550 ------------ -----------
|
|
|
1551
|
|
|
1552 0 Don't draw a label
|
|
|
1553 1 Calculate a label based on primary tag of sequence
|
|
|
1554 "a string" Use "a string" as the label
|
|
|
1555 code ref Invoke the code reference to compute the label
|
|
|
1556
|
|
|
1557 A known bug with this naming scheme is that you can't label a feature
|
|
|
1558 with the string "1". To work around this, use "1 " (note the terminal
|
|
|
1559 space).
|
|
|
1560
|
|
|
1561 B<Descriptions:> The -description argument controls whether or not a
|
|
|
1562 brief description of the feature should be printed next to it. By
|
|
|
1563 default, the description is printed just below the glyph and
|
|
|
1564 left-aligned with it. A value of 0 will suppress the description. A
|
|
|
1565 value of 1 will call the source_tag() method of the feature. A code
|
|
|
1566 reference will be invoked to calculate the description on the fly.
|
|
|
1567 Anything else will be treated as a string and used verbatim.
|
|
|
1568
|
|
|
1569 B<Connectors:> A glyph can contain subglyphs, recursively. The top
|
|
|
1570 level glyph is the track, which contains one or more groups, which
|
|
|
1571 contain features, which contain subfeatures, and so forth. By
|
|
|
1572 default, the "group" glyph draws dotted lines between each of its
|
|
|
1573 subglyphs, the "segment" glyph draws a solid line between each of its
|
|
|
1574 subglyphs, and the "transcript" and "transcript2" glyphs draw
|
|
|
1575 hat-shaped lines between their subglyphs. All other glyphs do not
|
|
|
1576 connect their components. You can override this behavior by providing
|
|
|
1577 a -connector option, to explicitly set the type of connector. Valid
|
|
|
1578 options are:
|
|
|
1579
|
|
|
1580
|
|
|
1581 "hat" an upward-angling conector
|
|
|
1582 "solid" a straight horizontal connector
|
|
|
1583 "quill" a decorated line with small arrows indicating strandedness
|
|
|
1584 (like the UCSC Genome Browser uses)
|
|
|
1585 "dashed" a horizontal dashed line.
|
|
|
1586
|
|
|
1587 The B<-connector_color> option controls the color of the connector, if
|
|
|
1588 any.
|
|
|
1589
|
|
|
1590 B<Collision control:> The -bump argument controls what happens when
|
|
|
1591 glyphs collide. By default, they will simply overlap (value 0). A
|
|
|
1592 -bump value of +1 will cause overlapping glyphs to bump downwards
|
|
|
1593 until there is room for them. A -bump value of -1 will cause
|
|
|
1594 overlapping glyphs to bump upwards. The bump argument can also be a
|
|
|
1595 code reference; see below.
|
|
|
1596
|
|
|
1597 B<Keys:> The -key argument declares that the track is to be shown in a
|
|
|
1598 key appended to the bottom of the image. The key contains a picture
|
|
|
1599 of a glyph and a label describing what the glyph means. The label is
|
|
|
1600 specified in the argument to -key.
|
|
|
1601
|
|
|
1602 B<box_subparts:> Ordinarily, when you invoke the boxes() methods to
|
|
|
1603 retrieve the rectangles surrounding the glyphs (which you need to do
|
|
|
1604 to create clickable imagemaps, for example), the rectangles will
|
|
|
1605 surround the top level features. If you wish for the rectangles to
|
|
|
1606 surround subpieces of the glyph, such as the exons in a transcript,
|
|
|
1607 set box_subparts to a true value.
|
|
|
1608
|
|
|
1609 B<strand_arrow:> If set to true, some glyphs will indicate their
|
|
|
1610 strandedness, usually by drawing an arrow. For this to work, the
|
|
|
1611 Bio::SeqFeature must have a strand of +1 or -1. The glyph will ignore
|
|
|
1612 this directive if the underlying feature has a strand of zero or
|
|
|
1613 undef.
|
|
|
1614
|
|
|
1615 B<sort_order>: By default, features are drawn with a layout based only on the
|
|
|
1616 position of the feature, assuring a maximal "packing" of the glyphs
|
|
|
1617 when bumped. In some cases, however, it makes sense to display the
|
|
|
1618 glyphs sorted by score or some other comparison, e.g. such that more
|
|
|
1619 "important" features are nearer the top of the display, stacked above
|
|
|
1620 less important features. The -sort_order option allows a few
|
|
|
1621 different built-in values for changing the default sort order (which
|
|
|
1622 is by "left" position): "low_score" (or "high_score") will cause
|
|
|
1623 features to be sorted from lowest to highest score (or vice versa).
|
|
|
1624 "left" (or "default") and "right" values will cause features to be
|
|
|
1625 sorted by their position in the sequence. "longer" (or "shorter")
|
|
|
1626 will cause the longest (or shortest) features to be sorted first, and
|
|
|
1627 "strand" will cause the features to be sorted by strand: "+1"
|
|
|
1628 (forward) then "0" (unknown, or NA) then "-1" (reverse).
|
|
|
1629
|
|
|
1630 In all cases, the "left" position will be used to break any ties. To
|
|
|
1631 break ties using another field, options may be strung together using a
|
|
|
1632 "|" character; e.g. "strand|low_score|right" would cause the features
|
|
|
1633 to be sorted first by strand, then score (lowest to highest), then by
|
|
|
1634 "right" position in the sequence. Finally, a subroutine coderef can
|
|
|
1635 be provided, which should expect to receive two feature objects (via
|
|
|
1636 the special sort variables $a and $b), and should return -1, 0 or 1
|
|
|
1637 (see Perl's sort() function for more information); this subroutine
|
|
|
1638 will be used without further modification for sorting. For example,
|
|
|
1639 to sort a set of database search hits by bits (stored in the features'
|
|
|
1640 "score" fields), scaled by the log of the alignment length (with
|
|
|
1641 "left" position breaking any ties):
|
|
|
1642
|
|
|
1643 sort_order = sub { ( $b->score/log($b->length)
|
|
|
1644 <=>
|
|
|
1645 $a->score/log($a->length) )
|
|
|
1646 ||
|
|
|
1647 ( $a->start <=> $b->start )
|
|
|
1648 }
|
|
|
1649
|
|
|
1650 B<bump_limit>: When bumping is chosen, colliding features will
|
|
|
1651 ordinarily move upward or downward without limit. When many features
|
|
|
1652 collide, this can lead to excessively high images. You can limit the
|
|
|
1653 number of levels that features will bump by providing a numeric
|
|
|
1654 B<bump_limit> option.
|
|
|
1655
|
|
|
1656 =head2 Options and Callbacks
|
|
|
1657
|
|
|
1658 Instead of providing a constant value to an option, you may subsitute
|
|
|
1659 a code reference. This code reference will be called every time the
|
|
|
1660 panel needs to configure a glyph. The callback will be called with
|
|
|
1661 three arguments like this:
|
|
|
1662
|
|
|
1663 sub callback {
|
|
|
1664 my ($feature,$option_name,$part_no,$total_parts,$glyph) = @_;
|
|
|
1665 # do something which results in $option_value being set
|
|
|
1666 return $option_value;
|
|
|
1667 }
|
|
|
1668
|
|
|
1669 The five arguments are C<$feature>, a reference to the IO::SeqFeatureI
|
|
|
1670 object, C<$option_name>, the name of the option to configure,
|
|
|
1671 C<$part_no>, an integer index indicating which subpart of the feature
|
|
|
1672 is being drawn, C<$total_parts>, an integer indicating the total
|
|
|
1673 number of subfeatures in the feature, and finally C<$glyph>, the Glyph
|
|
|
1674 object itself. The latter fields are useful in the case of treating
|
|
|
1675 the first or last subfeature differently, such as using a different
|
|
|
1676 color for the terminal exon of a gene. Usually you will only need to
|
|
|
1677 examine the first argument. This example shows a callback examining
|
|
|
1678 the score() attribute of a feature (possibly a BLAST hit) and return
|
|
|
1679 the color "red" for high-scoring features, and "green" for low-scoring
|
|
|
1680 features:
|
|
|
1681
|
|
|
1682 sub callback {
|
|
|
1683 my $feature = shift;
|
|
|
1684 if ($feature->score > 90) {
|
|
|
1685 return 'red';
|
|
|
1686 else {
|
|
|
1687 return 'green';
|
|
|
1688 }
|
|
|
1689 }
|
|
|
1690
|
|
|
1691 The callback should return a string indicating the desired value of
|
|
|
1692 the option. To tell the panel to use the default value for this
|
|
|
1693 option, return the string "*default*".
|
|
|
1694
|
|
|
1695 When you install a callback for a feature that contains subparts, the
|
|
|
1696 callback will be invoked first for the top-level feature, and then for
|
|
|
1697 each of its subparts (recursively). You should make sure to examine
|
|
|
1698 the feature's type to determine whether the option is appropriate.
|
|
|
1699
|
|
|
1700 Some glyphs deliberately disable this recursive feature. The "track",
|
|
|
1701 "group", "transcript", "transcript2" and "segments" glyphs selectively
|
|
|
1702 disable the -bump, -label and -description options. This is to avoid,
|
|
|
1703 for example, a label being attached to each exon in a transcript, or
|
|
|
1704 the various segments of a gapped alignment bumping each other. You
|
|
|
1705 can override this behavior and force your callback to be invoked by
|
|
|
1706 providing add_track() with a true B<-all_callbacks> argument. In this
|
|
|
1707 case, you must be prepared to handle configuring options for the
|
|
|
1708 "group" and "track" glyphs.
|
|
|
1709
|
|
|
1710 In particular, this means that in order to control the -bump option
|
|
|
1711 with a callback, you should specify -all_callbacks=E<gt>1, and turn on
|
|
|
1712 bumping when the callback is in the track or group glyphs.
|
|
|
1713
|
|
|
1714 =head2 ACCESSORS
|
|
|
1715
|
|
|
1716 The following accessor methods provide access to various attributes of
|
|
|
1717 the panel object. Called with no arguments, they each return the
|
|
|
1718 current value of the attribute. Called with a single argument, they
|
|
|
1719 set the attribute and return its previous value.
|
|
|
1720
|
|
|
1721 Note that in most cases you must change attributes prior to invoking
|
|
|
1722 gd(), png() or boxes(). These three methods all invoke an internal
|
|
|
1723 layout() method which places the tracks and the glyphs within them,
|
|
|
1724 and then caches the result.
|
|
|
1725
|
|
|
1726 Accessor Name Description
|
|
|
1727 ------------- -----------
|
|
|
1728
|
|
|
1729 width() Get/set width of panel
|
|
|
1730 spacing() Get/set spacing between tracks
|
|
|
1731 key_spacing() Get/set spacing between keys
|
|
|
1732 length() Get/set length of segment (bp)
|
|
|
1733 flip() Get/set coordinate flipping
|
|
|
1734 pad_top() Get/set top padding
|
|
|
1735 pad_left() Get/set left padding
|
|
|
1736 pad_bottom() Get/set bottom padding
|
|
|
1737 pad_right() Get/set right padding
|
|
|
1738 start() Get the start of the sequence (bp; read only)
|
|
|
1739 end() Get the end of the sequence (bp; read only)
|
|
|
1740 left() Get the left side of the drawing area (pixels; read only)
|
|
|
1741 right() Get the right side of the drawing area (pixels; read only)
|
|
|
1742
|
|
|
1743 =head2 COLOR METHODS
|
|
|
1744
|
|
|
1745 The following methods are used internally, but may be useful for those
|
|
|
1746 implementing new glyph types.
|
|
|
1747
|
|
|
1748 =over 4
|
|
|
1749
|
|
|
1750 =item @names = Bio::Graphics::Panel-E<gt>color_names
|
|
|
1751
|
|
|
1752 Return the symbolic names of the colors recognized by the panel
|
|
|
1753 object. In a scalar context, returns an array reference.
|
|
|
1754
|
|
|
1755 =item ($red,$green,$blue) = Bio::Graphics::Panel-E<gt>color_name_to_rgb($color)
|
|
|
1756
|
|
|
1757 Given a symbolic color name, returns the red, green, blue components
|
|
|
1758 of the color. In a scalar context, returns an array reference to the
|
|
|
1759 rgb triplet. Returns undef for an invalid color name.
|
|
|
1760
|
|
|
1761 =item @rgb = $panel-E<gt>rgb($index)
|
|
|
1762
|
|
|
1763 Given a GD color index (between 0 and 140), returns the RGB triplet
|
|
|
1764 corresponding to this index. This method is only useful within a
|
|
|
1765 glyph's draw() routine, after the panel has allocated a GD::Image and
|
|
|
1766 is populating it.
|
|
|
1767
|
|
|
1768 =item $index = $panel-E<gt>translate_color($color)
|
|
|
1769
|
|
|
1770 Given a color, returns the GD::Image index. The color may be
|
|
|
1771 symbolic, such as "turquoise", or a #RRGGBB triple, as in #F0E0A8.
|
|
|
1772 This method is only useful within a glyph's draw() routine, after the
|
|
|
1773 panel has allocated a GD::Image and is populating it.
|
|
|
1774
|
|
|
1775 =item $panel-E<gt>set_pen($width,$color)
|
|
|
1776
|
|
|
1777 Changes the width and color of the GD drawing pen to the values
|
|
|
1778 indicated. This is called automatically by the GlyphFactory fgcolor()
|
|
|
1779 method. It returns the GD value gdBrushed, which should be used for
|
|
|
1780 drawing.
|
|
|
1781
|
|
|
1782 =back
|
|
|
1783
|
|
|
1784 =head1 BUGS
|
|
|
1785
|
|
|
1786 Please report them.
|
|
|
1787
|
|
|
1788 =head1 SEE ALSO
|
|
|
1789
|
|
|
1790 L<Bio::Graphics::Glyph>,
|
|
|
1791 L<Bio::Graphics::Glyph::arrow>,
|
|
|
1792 L<Bio::Graphics::Glyph::cds>,
|
|
|
1793 L<Bio::Graphics::Glyph::crossbox>,
|
|
|
1794 L<Bio::Graphics::Glyph::diamond>,
|
|
|
1795 L<Bio::Graphics::Glyph::dna>,
|
|
|
1796 L<Bio::Graphics::Glyph::dot>,
|
|
|
1797 L<Bio::Graphics::Glyph::ellipse>,
|
|
|
1798 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
|
1799 L<Bio::Graphics::Glyph::generic>,
|
|
|
1800 L<Bio::Graphics::Glyph::graded_segments>,
|
|
|
1801 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
|
1802 L<Bio::Graphics::Glyph::line>,
|
|
|
1803 L<Bio::Graphics::Glyph::pinsertion>,
|
|
|
1804 L<Bio::Graphics::Glyph::primers>,
|
|
|
1805 L<Bio::Graphics::Glyph::rndrect>,
|
|
|
1806 L<Bio::Graphics::Glyph::segments>,
|
|
|
1807 L<Bio::Graphics::Glyph::redgreen_box>,
|
|
|
1808 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
|
1809 L<Bio::Graphics::Glyph::toomany>,
|
|
|
1810 L<Bio::Graphics::Glyph::transcript>,
|
|
|
1811 L<Bio::Graphics::Glyph::transcript2>,
|
|
|
1812 L<Bio::Graphics::Glyph::translation>,
|
|
|
1813 L<Bio::Graphics::Glyph::triangle>,
|
|
|
1814 L<Bio::Graphics::Glyph::xyplot>,
|
|
|
1815 L<Bio::SeqI>,
|
|
|
1816 L<Bio::SeqFeatureI>,
|
|
|
1817 L<Bio::Das>,
|
|
|
1818 L<GD>
|
|
|
1819
|
|
|
1820 =head1 AUTHOR
|
|
|
1821
|
|
|
1822 Lincoln Stein E<lt>lstein@cshl.orgE<gt>
|
|
|
1823
|
|
|
1824 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
|
1825
|
|
|
1826 This library is free software; you can redistribute it and/or modify
|
|
|
1827 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
|
1828 disclaimers of warranty.
|
|
|
1829
|
|
|
1830 =cut
|
|
|
1831
|
