|
0
|
1 package Bio::Graphics::Glyph::primers;
|
|
|
2 # package to use for drawing something that looks like
|
|
|
3 # primer pairs.
|
|
|
4
|
|
|
5 use strict;
|
|
|
6 use vars '@ISA';
|
|
|
7 @ISA = 'Bio::Graphics::Glyph::generic';
|
|
|
8 use Bio::Graphics::Glyph::generic;
|
|
|
9
|
|
|
10 use constant HEIGHT => 4;
|
|
|
11
|
|
|
12 # we do not need the default amount of room
|
|
|
13 #sub calculate_height {
|
|
|
14 # my $self = shift;
|
|
|
15 # return $self->option('label') ? HEIGHT + $self->labelheight + 2 : HEIGHT;
|
|
|
16 #}
|
|
|
17
|
|
|
18 # override draw method
|
|
|
19 sub draw {
|
|
|
20 my $self = shift;
|
|
|
21 my $gd = shift;
|
|
|
22 my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
|
|
|
23
|
|
|
24 my $fg = $self->fgcolor;
|
|
|
25 my $a2 = HEIGHT/2;
|
|
|
26 my $center = $y1 + $a2;
|
|
|
27
|
|
|
28 # just draw us as a solid line -- very simple
|
|
|
29 if ($x2-$x1 < HEIGHT*2) {
|
|
|
30 $gd->line($x1,$center,$x2,$center,$fg);
|
|
|
31 return;
|
|
|
32 }
|
|
|
33
|
|
|
34 # otherwise draw two pairs of arrows
|
|
|
35 # --> <--
|
|
|
36 my $trunc_left = $x1 < $self->panel->left;
|
|
|
37 my $trunc_right = $x2 > $self->panel->right;
|
|
|
38
|
|
|
39 unless ($trunc_left) {
|
|
|
40 $gd->line($x1,$center,$x1 + HEIGHT,$center,$fg);
|
|
|
41 $gd->line($x1 + HEIGHT,$center,$x1 + HEIGHT - $a2,$center-$a2,$fg);
|
|
|
42 $gd->line($x1 + HEIGHT,$center,$x1 + HEIGHT - $a2,$center+$a2,$fg);
|
|
|
43 }
|
|
|
44
|
|
|
45 unless ($trunc_right) {
|
|
|
46 $gd->line($x2,$center,$x2 - HEIGHT,$center,$fg);
|
|
|
47 $gd->line($x2 - HEIGHT,$center,$x2 - HEIGHT + $a2,$center+$a2,$fg);
|
|
|
48 $gd->line($x2 - HEIGHT,$center,$x2 - HEIGHT + $a2,$center-$a2,$fg);
|
|
|
49 }
|
|
|
50
|
|
|
51 # connect the dots if requested
|
|
|
52 if ($self->connect) {
|
|
|
53 my $c = $self->color('connect_color') || $self->bgcolor;
|
|
|
54 $gd->line($x1 + ($trunc_left ? 0 : HEIGHT + 2),$center,
|
|
|
55 $x2 - ($trunc_right ? 0 : HEIGHT + 2),$center,
|
|
|
56 $c);
|
|
|
57 }
|
|
|
58
|
|
|
59 # add a label if requested
|
|
|
60 $self->draw_label($gd,@_) if $self->option('label');
|
|
|
61 $self->draw_description($gd,@_) if $self->option('description');
|
|
|
62
|
|
|
63 }
|
|
|
64
|
|
|
65 sub connect {
|
|
|
66 my $self = shift;
|
|
|
67 return $self->option('connect') if defined $self->option('connect');
|
|
|
68 1; # default
|
|
|
69 }
|
|
|
70
|
|
|
71 1;
|
|
|
72
|
|
|
73 __END__
|
|
|
74
|
|
|
75 =head1 NAME
|
|
|
76
|
|
|
77 Bio::Graphics::Glyph::primers - The "STS primers" glyph
|
|
|
78
|
|
|
79 =head1 SYNOPSIS
|
|
|
80
|
|
|
81 See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
|
|
|
82
|
|
|
83 =head1 DESCRIPTION
|
|
|
84
|
|
|
85 This glyph draws two arrows oriented towards each other and connected
|
|
|
86 by a line of a contrasting color. The length of the arrows is
|
|
|
87 immaterial, but the length of the glyph itself corresponds to the
|
|
|
88 length of the scaled feature.
|
|
|
89
|
|
|
90 =head2 OPTIONS
|
|
|
91
|
|
|
92 In addition to the common options, the following glyph-specific
|
|
|
93 options are recognized:
|
|
|
94
|
|
|
95 Option Description Default
|
|
|
96 ------ ----------- -------
|
|
|
97
|
|
|
98 -connect Whether to connect the true
|
|
|
99 two arrowheads by a line.
|
|
|
100
|
|
|
101 -connect_color The color to use for the bgcolor
|
|
|
102 connecting line.
|
|
|
103
|
|
|
104 =head1 BUGS
|
|
|
105
|
|
|
106 Please report them.
|
|
|
107
|
|
|
108 =head1 SEE ALSO
|
|
|
109
|
|
|
110
|
|
|
111 L<Bio::Graphics::Panel>,
|
|
|
112 L<Bio::Graphics::Glyph>,
|
|
|
113 L<Bio::Graphics::Glyph::arrow>,
|
|
|
114 L<Bio::Graphics::Glyph::cds>,
|
|
|
115 L<Bio::Graphics::Glyph::crossbox>,
|
|
|
116 L<Bio::Graphics::Glyph::diamond>,
|
|
|
117 L<Bio::Graphics::Glyph::dna>,
|
|
|
118 L<Bio::Graphics::Glyph::dot>,
|
|
|
119 L<Bio::Graphics::Glyph::ellipse>,
|
|
|
120 L<Bio::Graphics::Glyph::extending_arrow>,
|
|
|
121 L<Bio::Graphics::Glyph::generic>,
|
|
|
122 L<Bio::Graphics::Glyph::graded_segments>,
|
|
|
123 L<Bio::Graphics::Glyph::heterogeneous_segments>,
|
|
|
124 L<Bio::Graphics::Glyph::line>,
|
|
|
125 L<Bio::Graphics::Glyph::pinsertion>,
|
|
|
126 L<Bio::Graphics::Glyph::primers>,
|
|
|
127 L<Bio::Graphics::Glyph::rndrect>,
|
|
|
128 L<Bio::Graphics::Glyph::segments>,
|
|
|
129 L<Bio::Graphics::Glyph::ruler_arrow>,
|
|
|
130 L<Bio::Graphics::Glyph::toomany>,
|
|
|
131 L<Bio::Graphics::Glyph::transcript>,
|
|
|
132 L<Bio::Graphics::Glyph::transcript2>,
|
|
|
133 L<Bio::Graphics::Glyph::translation>,
|
|
|
134 L<Bio::Graphics::Glyph::triangle>,
|
|
|
135 L<Bio::DB::GFF>,
|
|
|
136 L<Bio::SeqI>,
|
|
|
137 L<Bio::SeqFeatureI>,
|
|
|
138 L<Bio::Das>,
|
|
|
139 L<GD>
|
|
|
140
|
|
|
141 =head1 AUTHOR
|
|
|
142
|
|
|
143 Allen Day E<lt>day@cshl.orgE<gt>.
|
|
|
144
|
|
|
145 Copyright (c) 2001 Cold Spring Harbor Laboratory
|
|
|
146
|
|
|
147 This library is free software; you can redistribute it and/or modify
|
|
|
148 it under the same terms as Perl itself. See DISCLAIMER.txt for
|
|
|
149 disclaimers of warranty.
|
|
|
150
|
|
|
151 =cut
|
