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