|
0
|
1 package Bio::Graphics::Glyph::ruler_arrow;
|
|
|
2 # package to use for drawing an arrow as ruler (5' and 3' are marked as label)
|
|
|
3
|
|
|
4 use strict;
|
|
|
5 use vars '@ISA';
|
|
|
6 use Bio::Graphics::Glyph::generic;
|
|
|
7 @ISA = 'Bio::Graphics::Glyph::generic';
|
|
|
8
|
|
|
9 my %UNITS = (K => 1000,
|
|
|
10 M => 1_000_000,
|
|
|
11 G => 1_000_000_000);
|
|
|
12
|
|
|
13 sub pad_bottom {
|
|
|
14 my $self = shift;
|
|
|
15 my $val = $self->SUPER::pad_bottom(@_);
|
|
|
16 $val += $self->font->height if $self->option('tick');
|
|
|
17 $val;
|
|
|
18 }
|
|
|
19
|
|
|
20 # override draw method
|
|
|
21 sub draw {
|
|
|
22 my $self = shift;
|
|
|
23 my $parallel = $self->option('parallel');
|
|
|
24 $parallel = 1 unless defined $parallel;
|
|
|
25 $self->draw_parallel(@_) if $parallel;
|
|
|
26 $self->draw_perpendicular(@_) unless $parallel;
|
|
|
27 $self->draw_label(@_) if ($self->option('label'));
|
|
|
28 }
|
|
|
29
|
|
|
30 sub draw_perpendicular {
|
|
|
31 my $self = shift;
|
|
|
32 my $gd = shift;
|
|
|
33 my ($dx,$dy) = @_;
|
|
|
34 my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
|
|
|
35
|
|
|
36 my $ne = $self->option('northeast');
|
|
|
37 my $sw = $self->option('southwest');
|
|
|
38 $ne = $sw = 1 unless defined($ne) || defined($sw);
|
|
|
39
|
|
|
40 # draw a perpendicular arrow at position indicated by $x1
|
|
|
41 my $fg = $self->set_pen;
|
|
|
42 my $a2 = ($y2-$y1)/4;
|
|
|
43
|
|
|
44 my @positions = $x1 == $x2 ? ($x1) : ($x1,$x2);
|
|
|
45 for my $x (@positions) {
|
|
|
46 if ($ne) {
|
|
|
47 $gd->line($x,$y1,$x,$y2,$fg);
|
|
|
48 $gd->line($x-$a2,$y1+$a2,$x,$y1,$fg);
|
|
|
49 $gd->line($x+$a2,$y1+$a2,$x,$y1,$fg);
|
|
|
50 }
|
|
|
51 if ($sw) {
|
|
|
52 $gd->line($x,$y1,$x,$y2,$fg);
|
|
|
53 $gd->line($x-$a2,$y2-$a2,$x,$y2,$fg);
|
|
|
54 $gd->line($x+$a2,$y2-$a2,$x,$y2,$fg);
|
|
|
55 }
|
|
|
56 }
|
|
|
57
|
|
|
58 # add a label if requested
|
|
|
59 # $self->draw_label($gd,$dx,$dy) if ($self->option('label') && !$self->option('ruler'));
|
|
|
60 # this draws the label aligned to the left
|
|
|
61 }
|
|
|
62
|
|
|
63 sub draw_parallel {
|
|
|
64 my $self = shift;
|
|
|
65 my $gd = shift;
|
|
|
66 my ($dx,$dy) = @_;
|
|
|
67 my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
|
|
|
68
|
|
|
69 my $fg = $self->set_pen;
|
|
|
70 my $a2 = ($self->height)/2;
|
|
|
71 my $center = $y1+$a2;
|
|
|
72
|
|
|
73 $x1 = $self->panel->left if $x1 < $self->panel->left;
|
|
|
74 $x2 = $self->panel->right if $x2 > $self->panel->right;
|
|
|
75
|
|
|
76 my ($sw,$ne,$base_w,$base_e) = $self->arrowheads;
|
|
|
77 $gd->line($x1,$center,$x2,$center,$fg);
|
|
|
78 $self->arrowhead($gd,$x1,$center,$a2,-1) if $sw; # west arrow
|
|
|
79 $self->arrowhead($gd,$x2,$center,$a2,+1) if $ne; # east arrow
|
|
|
80 $gd->line($x2,$center-$a2,$x2,$center+$a2,$fg) if $base_e; #east base
|
|
|
81 $gd->line($x1,$center-$a2,$x1,$center+$a2,$fg) if $base_w; #west base
|
|
|
82
|
|
|
83 # turn on ticks
|
|
|
84 if ($self->option('tick')) {
|
|
|
85 local $^W = 0; # dumb uninitialized variable warning
|
|
|
86 my $font = $self->font;
|
|
|
87 my $width = $font->width;
|
|
|
88 my $font_color = $self->fontcolor;
|
|
|
89 my $height = $self->height;
|
|
|
90
|
|
|
91 my $relative = $self->option('relative_coords');
|
|
|
92 my $start = $relative ? 1 : $self->feature->start;
|
|
|
93 my $stop = $start + $self->feature->length - 1;
|
|
|
94
|
|
|
95 my $offset = $relative ? $self->feature->start-1 : 0;
|
|
|
96 my $reversed = $self->feature->strand < 0;
|
|
|
97
|
|
|
98 my $units = $self->option('units') || '';
|
|
|
99 my $divisor = $UNITS{$units} || 1 if $units;
|
|
|
100
|
|
|
101 my ($major_ticks,$minor_ticks) = $self->panel->ticks($start,$stop,$font,$divisor);
|
|
|
102
|
|
|
103 ## Does the user want to override the internal scale?
|
|
|
104 my $scale = $self->option('scale');
|
|
|
105
|
|
|
106 my $left = $sw ? $x1+$height : $x1;
|
|
|
107 my $right = $ne ? $x2-$height : $x2;
|
|
|
108
|
|
|
109 my $format = ($major_ticks->[1]-$major_ticks->[0])/($divisor||1) < 1 ? "%.1f$units" : "%d$units";
|
|
|
110
|
|
|
111 for my $i (@$major_ticks) {
|
|
|
112 my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
|
|
|
113 : $self->map_pt($i + $offset));
|
|
|
114 next if $tickpos < $left or $tickpos > $right;
|
|
|
115 $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
|
|
|
116 my $label = $scale ? $i / $scale : $i;
|
|
|
117 if ($units) {
|
|
|
118 my $scaled = $label/$divisor;
|
|
|
119 $label = sprintf($format,$scaled);
|
|
|
120 }
|
|
|
121 my $middle = $tickpos - (length($label) * $width)/2;
|
|
|
122 $gd->string($font,$middle,$center+$a2-1,$label,$font_color)
|
|
|
123 unless ($self->option('no_tick_label'));
|
|
|
124 }
|
|
|
125
|
|
|
126 if ($self->option('tick') >= 2) {
|
|
|
127 my $a4 = $self->height/4;
|
|
|
128 for my $i (@$minor_ticks) {
|
|
|
129 my $tickpos = $dx + ($reversed ? $self->map_pt($stop - $i + $offset)
|
|
|
130 : $self->map_pt($i + $offset));
|
|
|
131 next if $tickpos < $left or $tickpos > $right;
|
|
|
132 $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);
|
|
|
133 }
|
|
|
134 }
|
|
|
135 }
|
|
|
136
|
|
|
137 # add a label if requested
|
|
|
138 # $self->draw_label($gd,$dx,$dy) if ($self->option('label');
|
|
|
139 # $self->draw_description($gd,$dx,$dy) if $self->option('description');
|
|
|
140 }
|
|
|
141
|
|
|
142 sub arrowheads {
|
|
|
143 my $self = shift;
|
|
|
144 my ($ne,$sw,$base_e,$base_w);
|
|
|
145 if ($self->option('double')) {
|
|
|
146 $ne = $sw = 1;
|
|
|
147 } else {
|
|
|
148 $ne = $self->option('northeast') || $self->option('east');
|
|
|
149 $sw = $self->option('southwest') || $self->option('west');
|
|
|
150 }
|
|
|
151 # otherwise use strandedness to define the arrow
|
|
|
152 unless (defined($ne) || defined($sw)) {
|
|
|
153 # turn on both if neither specified
|
|
|
154 $ne = 1 if $self->feature->strand > 0;
|
|
|
155 $sw = 1 if $self->feature->strand < 0;
|
|
|
156 }
|
|
|
157 return ($sw,$ne,0,0) unless $self->option('base');
|
|
|
158 return ($sw,$ne,!$sw,!$ne);
|
|
|
159 }
|
|
|
160
|
|
|
161 sub draw_label {
|
|
|
162 my $self = shift;
|
|
|
163 my ($gd,$left,$top) = @_;
|
|
|
164
|
|
|
165 my $label5 = "5'";
|
|
|
166 my $label3 = "3'";
|
|
|
167 my $relative = $self->option('relative_coords');
|
|
|
168 my $start = $relative ? 1 : $self->feature->start;
|
|
|
169 my $stop = $start + $self->feature->length - 1;
|
|
|
170
|
|
|
171 my $offset = $relative ? $self->feature->start-1 : 0;
|
|
|
172 my $reversed = $self->feature->strand < 0;
|
|
|
173
|
|
|
174 my $units = $self->option('units') || '';
|
|
|
175 my $divisor = $UNITS{$units} || 1 if $units;
|
|
|
176
|
|
|
177 my ($major_ticks,$minor_ticks) = $self->panel->ticks($start,$stop,$self->font,$divisor);
|
|
|
178 my $tick_scale = " ($major_ticks bp/";
|
|
|
179 $tick_scale .= ($self->option('tick') >= 2)?"major tick)":"tick)";
|
|
|
180
|
|
|
181 my $top_left_label = $label5;
|
|
|
182 $top_left_label .= $tick_scale if ($self->option('no_tick_label') && $self->option('tick'));
|
|
|
183 #-1 direction mean lower end is 3' (minus strand on top)
|
|
|
184 ($label5, $label3) = ($label3, $label5) if ($self->option('direction') == -1);
|
|
|
185 my $x = $self->left + $left;
|
|
|
186 $x = $self->panel->left + 1 if $x <= $self->panel->left;
|
|
|
187 my $font = $self->option('labelfont') || $self->font;
|
|
|
188 $gd->string($font,
|
|
|
189 $x,
|
|
|
190 $self->top + $top,
|
|
|
191 $top_left_label,
|
|
|
192 $self->fontcolor);
|
|
|
193 my $x1 = $left + $self->panel->right - $font->width*length($label3);
|
|
|
194 $gd->string($font,
|
|
|
195 $x1,
|
|
|
196 $self->top + $top,
|
|
|
197 $label3,
|
|
|
198 $self->fontcolor);
|
|
|
199 if ($self->option('both')) {#minus strand as well
|
|
|
200 $gd->string($font,
|
|
|
201 $x,
|
|
|
202 $self->bottom - $self->pad_bottom + $top,
|
|
|
203 $label3,
|
|
|
204 $self->fontcolor);
|
|
|
205 my $x1 = $left + $self->panel->right - $font->width*length($label5);
|
|
|
206 $gd->string($font,
|
|
|
207 $x1,
|
|
|
208 $self->bottom - $self->pad_bottom + $top,
|
|
|
209 $label5,
|
|
|
210 $self->fontcolor);
|
|
|
211 }
|
|
|
212 }
|
|
|
213
|
|
|
214
|
|
|
215 1;
|
|
|
216
|
|
|
217
|
|
|
218 __END__
|
|
|
219
|
|
|
220 =head1 NAME
|
|
|
221
|
|
|
222 Bio::Graphics::Glyph::arrow - The "ruler_arrow" glyph
|
|
|
223
|
|
|
224 =head1 SYNOPSIS
|
|
|
225
|
|
|
226 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
|
227
|
|
|
228 =head1 DESCRIPTION
|
|
|
229
|
|
|
230 This glyph draws arrows. Label, if requested, will be 5' and 3' at both ends
|
|
|
231 and tick scale is printed if no_tick_label option is set and tick option set.
|
|
|
232 Depending on options, the arrows can be labeled, be oriented vertically
|
|
|
233 or horizontally, or can contain major and minor ticks suitable for use as a scale.
|
|
|
234
|
|
|
235 =head2 OPTIONS
|
|
|
236
|
|
|
237 In addition to the common options, the following glyph-specific
|
|
|
238 options are recognized:
|
|
|
239
|
|
|
240 Option Description Default
|
|
|
241 ------ ----------- -------
|
|
|
242
|
|
|
243 -tick Whether to draw major 0
|
|
|
244 and minor ticks.
|
|
|
245 0 = no ticks
|
|
|
246 1 = major ticks
|
|
|
247 2 = minor ticks
|
|
|
248 -label 5' at start, 3' at end 0
|
|
|
249 above arrow
|
|
|
250 -both 5', 3' above, 0
|
|
|
251 and 3', 5' below arrow
|
|
|
252 -direction 0 = ruler is plus strand 0
|
|
|
253 -1 = ruler is minus strand
|
|
|
254
|
|
|
255 -parallel Whether to draw the arrow true
|
|
|
256 parallel to the sequence
|
|
|
257 or perpendicular to it.
|
|
|
258
|
|
|
259 -northeast Force a north or east true
|
|
|
260 arrowhead(depending
|
|
|
261 on orientation)
|
|
|
262
|
|
|
263 -east synonym of above
|
|
|
264
|
|
|
265 -southwest Force a south or west true
|
|
|
266 arrowhead(depending
|
|
|
267 on orientation)
|
|
|
268
|
|
|
269 -west synonym of above
|
|
|
270
|
|
|
271 -double force-doubleheaded arrow
|
|
|
272
|
|
|
273 -base Draw a vertical base at the false
|
|
|
274 non-arrowhead side
|
|
|
275
|
|
|
276 -scale Reset the labels on the arrow false
|
|
|
277 to reflect an externally
|
|
|
278 established scale.
|
|
|
279
|
|
|
280 Set -parallel to false to display a point-like feature such as a
|
|
|
281 polymorphism, or to indicate an important location. If the feature
|
|
|
282 start == end, then the glyph will draw a single arrow at the
|
|
|
283 designated location:
|
|
|
284
|
|
|
285 ^
|
|
|
286 |
|
|
|
287
|
|
|
288 Otherwise, there will be two arrows at the start and end:
|
|
|
289
|
|
|
290 ^ ^
|
|
|
291 | |
|
|
|
292
|
|
|
293 Scale: Pass in a externally established scale to reset the labels on
|
|
|
294 the arrow. This is particularly useful for manually constructed
|
|
|
295 images where the founding parameters of the panel are not 1-based.
|
|
|
296 For example, a genetic map interval ranging from 0.1 - 0.3 can be
|
|
|
297 constructed by first multiplying every value by 100. Passing
|
|
|
298
|
|
|
299 arrow(-scale=>100);
|
|
|
300
|
|
|
301 will draw tick marks labelled appropriately to your external scale.
|
|
|
302
|
|
|
303 =head1 BUGS
|
|
|
304
|
|
|
305 Please report them.
|
|
|
306
|
|
|
307 =head1 SEE ALSO
|
|
|
308
|
|
|
309
|
|
|
310 L<Bio::Graphics::Panel>,
|
|
|
311 L<Bio::Graphics::Glyph>,
|
|
|
312 L<Bio::Graphics::Glyph::arrow>,
|
|
|
313 L<Bio::Graphics::Glyph::cds>,
|
|
|
314 L<Bio::Graphics::Glyph::crossbox>,
|
|
|
315 L<Bio::Graphics::Glyph::diamond>,
|
|
|
316 L<Bio::Graphics::Glyph::dna>,
|
|
|
317 L<Bio::Graphics::Glyph::dot>,
|
|
|
318 L<Bio::Graphics::Glyph::ellipse>,
|
|
|
319 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
|
320 L<Bio::Graphics::Glyph::generic>,
|
|
|
321 L<Bio::Graphics::Glyph::graded_segments>,
|
|
|
322 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
|
323 L<Bio::Graphics::Glyph::line>,
|
|
|
324 L<Bio::Graphics::Glyph::pinsertion>,
|
|
|
325 L<Bio::Graphics::Glyph::primers>,
|
|
|
326 L<Bio::Graphics::Glyph::rndrect>,
|
|
|
327 L<Bio::Graphics::Glyph::segments>,
|
|
|
328 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
|
329 L<Bio::Graphics::Glyph::toomany>,
|
|
|
330 L<Bio::Graphics::Glyph::transcript>,
|
|
|
331 L<Bio::Graphics::Glyph::transcript2>,
|
|
|
332 L<Bio::Graphics::Glyph::translation>,
|
|
|
333 L<Bio::Graphics::Glyph::triangle>,
|
|
|
334 L<Bio::DB::GFF>,
|
|
|
335 L<Bio::SeqI>,
|
|
|
336 L<Bio::SeqFeatureI>,
|
|
|
337 L<Bio::Das>,
|
|
|
338 L<GD>
|
|
|
339
|
|
|
340 =head1 AUTHOR
|
|
|
341
|
|
|
342 Shengqiang Shu E<lt>sshu@bdgp.lbl.govE<gt>
|
|
|
343 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
|
|
|
344
|
|
|
345 Copyright (c) 2001 BDGP, Cold Spring Harbor Laboratory
|
|
|
346
|
|
|
347 This library is free software; you can redistribute it and/or modify
|
|
|
348 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
|
349 disclaimers of warranty.
|
|
|
350
|
|
|
351 =cut
|
