1package Bio::Graphics::Glyph::arrow;
2# package to use for drawing an arrow
3
4# Non object-oriented utilities used here-and-there in Bio::Graphics modules
5
6=head1 NAME
7
8Bio::Graphics::Glyph::arrow - the "arrow" glyph
9
10=cut
11
12use strict;
13use Bio::Coordinate::Pair;
14use Bio::Location::Simple;
15use base qw(Bio::Graphics::Glyph::generic);
16
17sub my_description {
18    return <<END;
19This glyph draws arrows.  Depending on options, the arrows can be
20labeled, be oriented vertically or horizontally, or can contain major
21and minor ticks suitable for use as a scale.
22END
23}
24sub my_options {
25    {
26	tick => [
27	    [0..2],
28	    0,
29	    'Draw a scale with tickmarks on the arrow.',
30	    'A value of 0 suppresses the scale.',
31	    'A value of 1 draws major ticks only.',
32	    'A value of 2 draws major and minor ticks.',],
33	tickcolor => [
34	    'color',
35	    undef,
36	    'Color to use for the tick marks on the scale. If the value is undef,',
37	    'then the fgcolor will be used.'],
38	tickwidth => [
39	    'integer',
40	    0,
41	    'Line width to use for ticks.',
42	    'If the value is undef, then the linewidth will be used.'],
43	parallel => [
44	    'boolean',
45	    1,
46	    'Whether to draw the arrow parallel to the direction of the sequence',
47	    '(left/right) or perpendicular to it (up/down).'],
48	northeast => [
49	    'boolean',
50	    1,
51	    'Force a north or east arrowhead, depending on the arrow\'s orientation.'],
52	east => [
53	    'boolean',
54	    1,
55	    'Synonym for "northeast".'],
56	southwest=> [
57	    'boolean',
58	    1,
59	    'Force a south or west arrowhead, depending on the arrow\'s orientation.'],
60	west=> [
61	    'boolean',
62	    1,
63	    'Synonym for "southwest".'],
64	double => [
65	    'boolean',
66	    undef,
67	    'Force a double-headed arrow.'],
68	base => [
69	    'boolean',
70	    undef,
71	    'Draw a vertical base at the non-arrowhead side of the glyph line.'],
72	scale => [
73	    'integer',
74	    1,
75	    'Deprecated option; do not use.'],
76	arrowstyle => [
77	    [qw(regular filled)],
78	    'regular',
79	    'Control the arrowhead style.',
80	    '"regular" creates a simple thin arrowhead.',
81	    '"filled" creates a thick filled arrowhead.'],
82	relative_coords => [
83	    'boolean',
84	    undef,
85	    "Start numbering the scale at position 1 rather than at the position",
86	    "of the feature in global (e.g. chromosome-relative) coordinates."],
87	relative_coords_offset => [
88	    'integer',
89	    1,
90	    'When using relative coordinates for the arrowhead tick labels,',
91	    'this option sets the starting position.'],
92	units => [
93	    'string',
94	    undef,
95	    'Add units to the tick labels, such as "bp".'],
96	unit_divider => [
97	    'integer',
98	    1,
99	    'Divide the tick label by the indicated amount prior to displaying them.',
100	    'Useful for displaying the scale in a custom unit, such as cM.']
101    };
102}
103
104my %UNITS = (p => 1e-12,
105	     n => 1e-9,
106	     u => 1e-6,
107	     m => 0.001,
108	     c => 0.01,
109	     k => 1000,
110	     M => 1_000_000,
111	     G => 1_000_000_000);
112
113sub pad_bottom {
114  my $self = shift;
115  my $val = $self->SUPER::pad_bottom(@_);
116  $val += $self->string_height($self->font) if $self->option('tick');
117  $val;
118}
119
120# override draw method
121sub draw_component {
122  my $self = shift;
123  my $parallel = $self->option('parallel');
124  $parallel = 1 unless defined $parallel;
125  $self->draw_parallel(@_) if $parallel;
126  $self->draw_perpendicular(@_) unless $parallel;
127}
128
129sub draw_perpendicular {
130  my $self = shift;
131  my $gd = shift;
132  my ($dx,$dy) = @_;
133  my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
134
135  my $ne = $self->option('northeast');
136  my $sw = $self->option('southwest');
137  $ne = $sw = 1 unless defined($ne) || defined($sw);
138
139  # draw a perpendicular arrow at position indicated by $x1
140  my $fg = $self->set_pen;
141  my $a2 = ($y2-$y1)/4;
142
143  my @positions = $x1 == $x2 ? ($x1) : ($x1,$x2);
144  for my $x (@positions) {
145    if ($ne) {
146      $gd->line($x,$y1,$x,$y2,$fg);
147      $gd->line($x-$a2,$y1+$a2,$x,$y1,$fg);
148      $gd->line($x+$a2,$y1+$a2,$x,$y1,$fg);
149    }
150    if ($sw) {
151      $gd->line($x,$y1,$x,$y2,$fg);
152      $gd->line($x-$a2,$y2-$a2,$x,$y2,$fg);
153      $gd->line($x+$a2,$y2-$a2,$x,$y2,$fg);
154    }
155  }
156
157  # add a label if requested
158  $self->draw_label($gd,$dx,$dy) if $self->option('label');  # this draws the label aligned to the left
159}
160
161sub draw_parallel {
162  my $self = shift;
163  my $gd = shift;
164  my ($dx,$dy) = @_;
165  my ($x1,$y1,$x2,$y2) = $self->bounds(@_);
166
167  my $fg = $self->set_pen;
168  my $a2 = ($self->height)/2;
169  my $center = $y1+$a2;
170
171  my $trunc_left  = $x1 < $self->panel->left;
172  my $trunc_right = $x2 > $self->panel->right;
173  $x1 = $self->panel->left  if $trunc_left;
174  $x2 = $self->panel->right if $trunc_right;
175
176#  warn $self->feature,": x1=$x1, x2=$x2, start=$self->{start},end=$self->{end}, strand=$self->{strand}";
177#  warn join ' ',%$self;
178
179  $trunc_left  = 0 if $self->no_trunc;
180  $trunc_right = 0 if $self->no_trunc;
181
182  my ($sw,$ne,$base_w,$base_e) = $self->arrowheads;
183  $gd->line($x1,$center,$x2,$center,$fg);
184  $self->arrowhead($gd,$x1,$center,$a2,-1) if $sw && !$trunc_left;  # west arrow
185  $self->arrowhead($gd,$x2,$center,$a2,+1) if $ne && !$trunc_right; # east arrow
186  $gd->line($x1,$center-$a2,$x1,$center+$a2,$fg) if $base_w && !$trunc_left;  #west base
187  $gd->line($x2,$center-$a2,$x2,$center+$a2,$fg) if $base_e && !$trunc_right; #east base
188
189  # turn on ticks
190  if ($self->option('tick')) {
191    local $^W = 0;  # dumb uninitialized variable warning
192    my $font       = $self->font;
193    my $width      = $self->string_width('m',$font);
194    my $font_color = $self->fontcolor;
195    my $height     = $self->height;
196
197    my $relative   = $self->option('relative_coords');
198    my $flipped    = $self->{flip};
199    my $end        = $self->panel->end + 1;
200
201    my $tickwidth  = $self->option('tickwidth'); $tickwidth = $self->linewidth unless defined $tickwidth;
202    my $tickcolor  = $self->color($self->option('tickcolor') || $self->option('fgcolor'));
203    my $tickpen    = $self->set_pen($tickwidth, $tickcolor);
204
205    my $relative_coords_offset = $self->option('relative_coords_offset');
206    $relative_coords_offset    = 1 unless defined $relative_coords_offset;
207
208    my $start    = $relative ? $relative_coords_offset : $self->feature->start-1;
209    my $stop     = $start + $self->feature->length - 1;
210
211    my $map = Bio::Coordinate::Pair->new(-in  => Bio::Location::Simple->new( -seq_id => "rel",
212									     -start => $start,
213									     -end => $stop,
214									     -strand => 1,
215									     ),
216					 -out => Bio::Location::Simple->new( -seq_id => "abs",
217									     -start => $self->feature->start,
218									     -end => $self->feature->end,
219									     -strand => $self->feature->strand,
220									     ),
221					 ) if $relative;
222
223    my $unit_label     = $self->option('units')        || '';
224    my $unit_divider   = $self->option('unit_divider') || 1;
225    my $units_in_label = $self->option('units_in_label');
226
227    my $units      = $self->calculate_units($start/$unit_divider,$self->feature->length/$unit_divider);
228    my $divisor    = $UNITS{$units} || 1;
229
230    $divisor *= $unit_divider;
231
232    my $format     = min($self->feature->length,$self->panel->length)/$divisor > 10
233      ? "%d" : "%.6g";
234
235    $format .= "$units%s" unless $units_in_label;
236
237    my $scale  = $self->option('scale') || 1;  ## Does the user want to override the internal scale?
238
239    my $model  = sprintf("$format ",$stop/($divisor*$scale),$unit_label);
240    $model     = "-$model" if $start < 0;
241
242    my $minlen = $width * length($model);# * 1.5;
243
244    my ($major_interval,$minor_interval) = $self->panel->ticks(($stop-$start+1)/$unit_divider,$minlen);
245
246    my $left  = $sw ? $x1+$height : $x1;
247    my $right = $ne ? $x2-$height : $x2;
248
249    # adjust for portions of arrow that are outside panel
250    if ($relative && $self->feature->strand == -1) {
251	$start += $self->feature->end - $self->panel->end if $self->feature->end > $self->panel->end;
252	$stop -= $self->panel->start - $self->feature->start if $self->feature->start < $self->panel->start;
253    } else {
254	$start += $self->panel->start - $self->feature->start
255	    if $self->feature->start < $self->panel->start;
256	$stop  -= $self->feature->end - $self->panel->end
257	    if $self->feature->end   > $self->panel->end;
258    }
259
260    my $first_tick = $major_interval * int($start/$major_interval);
261    my $last_tick  = $major_interval * int(($stop+2)/$major_interval);
262
263    my $label_intervals = $self->label_intervals;
264    my $interval_width  = $major_interval * $self->scale/2;
265    my %drewit;
266
267    for (my $i = $first_tick; $i <= $last_tick; $i += $major_interval) {
268      my $abs = $i;
269      if ($relative) {
270	  $abs = $map->map( Bio::Location::Simple->new(-seq_id => "rel",
271						       -start  => $i,
272						       -end   => $i,
273						       -strand => 1,
274						       )
275			    )->match;
276	  next unless $abs;
277	  $abs = $abs->start;
278      }
279
280      $abs = $end - $abs + 1 if $flipped;
281
282      my $tickpos = int $dx + $self->map_pt($abs);
283      next if $tickpos < $x1 || $tickpos > $x2;
284      $drewit{$tickpos}++;
285
286      $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$tickpen)
287	unless $tickpos < $left or $tickpos > $right;
288
289      my $label = $scale ? $i / $scale : $i;
290      my $scaled = $label/$divisor;
291      $label = sprintf($format,$scaled,$unit_label);
292
293      my $label_len = length($label) * $width;
294
295      my $middle = $tickpos - $label_len/2;
296      $middle   += $interval_width if $label_intervals;
297
298      $gd->string($font,$middle,$center+$a2-1,$label,$font_color)
299        unless ($self->option('no_tick_label') || $middle > $x2);
300    }
301
302    if ($self->option('tick') >= 2) {
303
304      $first_tick = $minor_interval * int($start/$minor_interval);
305      $last_tick  = $minor_interval * int(($stop+2)/$minor_interval);
306
307      my $a4 = $self->height/4;
308      for (my $i = $first_tick; $i <= $last_tick; $i += $minor_interval) {
309	  my $abs = $i;
310	  if ($relative) {
311	      $abs = $map->map( Bio::Location::Simple->new(-seq_id => "rel",
312							   -start  => $i,
313							   -end    => $i,
314							   -strand => 1,
315							   )
316				)->match;
317	      next unless $abs;
318	      $abs = $abs->start;
319	  }
320	  $abs = $end - $abs if $flipped;
321
322	  my $tickpos = int $dx + $self->map_pt($abs);
323	  next if $tickpos < $left-1 or $tickpos > $right+1;
324	  next if $drewit{$tickpos} || $drewit{$tickpos-1} || $drewit{$tickpos+1}; # prevent roundoff errors from appearing
325
326	  $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$tickpen);
327      }
328    }
329  }
330
331  # add a label if requested
332  $self->draw_label($gd,$dx,$dy)       if $self->option('label');
333  $self->draw_description($gd,$dx,$dy) if $self->option('description');
334}
335
336sub label {
337  my $self  = shift;
338  my $label = $self->SUPER::label(@_);
339  return $label unless $self->option('units_in_label');
340  my $unit_divider = $self->option('unit_divider') || 1;
341  my $unit_label   = $self->option('units')        || '';
342  my $start        = $self->feature->start-1;
343  my $units        = $self->calculate_units($start/$unit_divider,$self->feature->length/$unit_divider);
344  return $label . " ($units$unit_label)";
345}
346
347sub label_intervals {
348  return shift->option('label_intervals');
349}
350
351sub arrowheads {
352  my $self = shift;
353  my ($ne,$sw,$base_e,$base_w);
354  if ($self->option('double')) {
355    $ne = $sw = 1;
356  } else {
357    $ne   = $self->option('northeast') || $self->option('east');
358    $sw   = $self->option('southwest') || $self->option('west');
359  }
360  # otherwise use strandedness to define the arrow
361  unless (defined($ne) || defined($sw)) {
362    # turn on both if neither specified
363    $ne = 1 if $self->feature->strand > 0;
364    $sw = 1 if $self->feature->strand < 0;
365    ($ne,$sw) = ($sw,$ne) if $self->{flip};
366  }
367  return ($sw,$ne,0,0) unless $self->option('base');
368  return ($sw,$ne,
369	  (!$sw && $self->feature->start>= $self->panel->start),
370	  (!$ne && $self->feature->end  <= $self->panel->end));
371}
372
373sub no_trunc { 0; }
374
375sub calculate_units {
376  my $self   = shift;
377  my ($start,$length) = @_;
378  return 'G' if $length >= 1e9;
379  return 'M' if $length >= 1e6;
380  return 'k' if $length >= 1e3;
381  return ''  if $length >= 1;
382  return 'c' if $length >= 1e-2;
383  return 'm' if $length >= 1e-3;
384  return 'u' if $length >= 1e-6;
385  return 'n' if $length >= 1e-9;
386  return 'p';
387}
388
389sub min { $_[0]<$_[1] ? $_[0] : $_[1] }
390
3911;
392
393__END__
394
395
396=head1 SYNOPSIS
397
398  See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
399
400=head1 DESCRIPTION
401
402This glyph draws arrows.  Depending on options, the arrows can be
403labeled, be oriented vertically or horizontally, or can contain major
404and minor ticks suitable for use as a scale.
405
406=head2 OPTIONS
407
408The following options are standard among all Glyphs.  See
409L<Bio::Graphics::Glyph> for a full explanation.
410
411  Option      Description                      Default
412  ------      -----------                      -------
413
414  -fgcolor      Foreground color	       black
415
416  -outlinecolor	Synonym for -fgcolor
417
418  -bgcolor      Background color               turquoise
419
420  -fillcolor    Synonym for -bgcolor
421
422  -linewidth    Line width                     1
423
424  -height       Height of glyph		       10
425
426  -font         Glyph font		       gdSmallFont
427
428  -connector    Connector type                 0 (false)
429
430  -connector_color
431                Connector color                black
432
433  -label        Whether to draw a label	       0 (false)
434
435  -description  Whether to draw a description  0 (false)
436
437  -hilite       Highlight color                undef (no color)
438
439In addition to the common options, the following glyph-specific
440options are recognized:
441
442  Option      Description               Default
443  ------      -----------               -------
444
445  -tick       Whether to draw major             0
446              and minor ticks.
447	      0 = no ticks
448	      1 = major ticks
449	      2 = minor ticks
450
451  -tickcolor  Color to use for tick marks       fgcolor
452
453  -tickwidth  Line width to use for ticks       linewidth
454
455  -parallel   Whether to draw the arrow         1 (true)
456	      parallel to the sequence
457	      or perpendicular to it.
458
459  -northeast  Force a north or east             1 (true)
460	      arrowhead(depending
461	      on orientation)
462
463  -east       synonym of above
464
465  -southwest  Force a south or west             1 (true)
466	      arrowhead(depending
467	      on orientation)
468
469  -west       synonym of above
470
471  -double     force-doubleheaded arrow          0 (false)
472
473  -base       Draw a vertical base at the       0 (false)
474              non-arrowhead side
475
476  -scale      Reset the labels on the arrow     0 (false)
477              to reflect an externally
478              established scale.
479
480  -arrowstyle "regular" to create a simple      regular
481              arrowhead.  "filled" to create
482              a thick filled arrowhead
483
484  -relative_coords
485                 use relative coordinates       0 (false)
486                 for scale
487
488  -relative_coords_offset
489                 set the relative offset        1
490                 for scale
491
492  -label_intervals                              0 (false)
493              Put the numeric labels on the
494              intervals between the ticks
495              rather than on the ticks
496              themselves.
497
498  -units      add units to the tick labels      none
499              e.g. bp
500
501  -unit_divider                                 1
502              divide tick labels by the
503              indicated amount prior to
504              displaying (use, for example
505              if you want to display in
506              cR units)
507
508Set -parallel to 0 (false) to display a point-like feature such as a
509polymorphism, or to indicate an important location.  If the feature
510start == end, then the glyph will draw a single arrow at the
511designated location:
512
513       ^
514       |
515
516Otherwise, there will be two arrows at the start and end:
517
518       ^              ^
519       |              |
520
521Scale: Pass in a externally established scale to reset the labels on
522the arrow.  This is particularly useful for manually constructed
523images where the founding parameters of the panel are not 1-based.
524For example, a genetic map interval ranging from 0.1 - 0.3 can be
525constructed by first multiplying every value by 100. Passing
526
527  arrow(-scale=>100);
528
529will draw tick marks labelled appropriately to your external scale.
530
531=head1 BUGS
532
533Please report them.
534
535=head1 SEE ALSO
536
537L<Bio::Graphics::Panel>,
538L<Bio::Graphics::Glyph>,
539L<Bio::Graphics::Glyph::arrow>,
540L<Bio::Graphics::Glyph::cds>,
541L<Bio::Graphics::Glyph::crossbox>,
542L<Bio::Graphics::Glyph::diamond>,
543L<Bio::Graphics::Glyph::dna>,
544L<Bio::Graphics::Glyph::dot>,
545L<Bio::Graphics::Glyph::ellipse>,
546L<Bio::Graphics::Glyph::extending_arrow>,
547L<Bio::Graphics::Glyph::generic>,
548L<Bio::Graphics::Glyph::graded_segments>,
549L<Bio::Graphics::Glyph::heterogeneous_segments>,
550L<Bio::Graphics::Glyph::line>,
551L<Bio::Graphics::Glyph::pinsertion>,
552L<Bio::Graphics::Glyph::primers>,
553L<Bio::Graphics::Glyph::rndrect>,
554L<Bio::Graphics::Glyph::segments>,
555L<Bio::Graphics::Glyph::ruler_arrow>,
556L<Bio::Graphics::Glyph::toomany>,
557L<Bio::Graphics::Glyph::transcript>,
558L<Bio::Graphics::Glyph::transcript2>,
559L<Bio::Graphics::Glyph::translation>,
560L<Bio::Graphics::Glyph::triangle>,
561L<Bio::DB::GFF>,
562L<Bio::SeqI>,
563L<Bio::SeqFeatureI>,
564L<Bio::Das>,
565L<GD>
566
567=head1 AUTHOR
568
569Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
570
571Copyright (c) 2001 Cold Spring Harbor Laboratory
572
573This library is free software; you can redistribute it and/or modify
574it under the same terms as Perl itself.  See DISCLAIMER.txt for
575disclaimers of warranty.
576
577=cut
578