| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Bio::Graphics::Panel; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1970
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
44
|
|
|
4
|
1
|
|
|
1
|
|
693
|
use Bio::Graphics::Glyph::Factory; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
28
|
|
|
5
|
1
|
|
|
1
|
|
8
|
use Bio::Graphics::Feature; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
19
|
|
|
6
|
1
|
|
|
1
|
|
541
|
use Bio::Graphics::GDWrapper; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# KEYLABELFONT must be treated as string until image_class is established |
|
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 GRIDMAJORCOLOR => 'lightgrey'; |
|
17
|
|
|
|
|
|
|
use constant MISSING_TRACK_COLOR =>'gray'; |
|
18
|
|
|
|
|
|
|
use constant EXTRA_RIGHT_PADDING => 30; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use base qw(Bio::Root::Root); |
|
21
|
|
|
|
|
|
|
our $GlyphScratch; |
|
22
|
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my %COLORS; # translation table for symbolic color names to RGB triple |
|
24
|
|
|
|
|
|
|
my $IMAGEMAP = 'bgmap00001'; |
|
25
|
|
|
|
|
|
|
read_colors(); |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub api_version { 1.8 } |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Create a new panel of a given width and height, and add lists of features |
|
30
|
|
|
|
|
|
|
# one by one |
|
31
|
|
|
|
|
|
|
sub new { |
|
32
|
|
|
|
|
|
|
my $class = shift; |
|
33
|
|
|
|
|
|
|
$class = ref($class) || $class; |
|
34
|
|
|
|
|
|
|
my %options = @_; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$class->read_colors() unless %COLORS; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $length = $options{-length} || 0; |
|
39
|
|
|
|
|
|
|
my $offset = $options{-offset} || 0; |
|
40
|
|
|
|
|
|
|
my $spacing = $options{-spacing} || 5; |
|
41
|
|
|
|
|
|
|
my $bgcolor = $options{-bgcolor} || 'white'; |
|
42
|
|
|
|
|
|
|
my $keyfont = $options{-key_font} || KEYLABELFONT; |
|
43
|
|
|
|
|
|
|
my $keycolor = $options{-key_color} || KEYCOLOR; |
|
44
|
|
|
|
|
|
|
my $keyspacing = $options{-key_spacing} || KEYSPACING; |
|
45
|
|
|
|
|
|
|
my $keystyle = $options{-key_style} || KEYSTYLE; |
|
46
|
|
|
|
|
|
|
my $keyalign = $options{-key_align} || KEYALIGN; |
|
47
|
|
|
|
|
|
|
my $suppress_key = $options{-suppress_key} || 0; |
|
48
|
|
|
|
|
|
|
my $allcallbacks = $options{-all_callbacks} || 0; |
|
49
|
|
|
|
|
|
|
my $gridcolor = $options{-gridcolor} || GRIDCOLOR; |
|
50
|
|
|
|
|
|
|
my $gridmajorcolor = $options{-gridmajorcolor} || GRIDMAJORCOLOR; |
|
51
|
|
|
|
|
|
|
my $grid = $options{-grid} || 0; |
|
52
|
|
|
|
|
|
|
my $extend_grid = $options{-extend_grid}|| 0; |
|
53
|
|
|
|
|
|
|
my $flip = $options{-flip} || 0; |
|
54
|
|
|
|
|
|
|
my $empty_track_style = $options{-empty_tracks} || 'key'; |
|
55
|
|
|
|
|
|
|
my $autopad = defined $options{-auto_pad} ? $options{-auto_pad} : 1; |
|
56
|
|
|
|
|
|
|
my $truecolor = $options{-truecolor} || 0; |
|
57
|
|
|
|
|
|
|
my $truetype = $options{-truetype} || 0; |
|
58
|
|
|
|
|
|
|
my $image_class = ($options{-image_class} && $options{-image_class} =~ /SVG/) |
|
59
|
|
|
|
|
|
|
? 'GD::SVG' |
|
60
|
|
|
|
|
|
|
: $options{-image_class} || 'GD'; # Allow users to specify GD::SVG using SVG |
|
61
|
|
|
|
|
|
|
my $linkrule = $options{-link}; |
|
62
|
|
|
|
|
|
|
my $titlerule = $options{-title}; |
|
63
|
|
|
|
|
|
|
my $targetrule = $options{-target}; |
|
64
|
|
|
|
|
|
|
my $background = $options{-background}; |
|
65
|
|
|
|
|
|
|
my $postgrid = $options{-postgrid}; |
|
66
|
|
|
|
|
|
|
$options{-stop}||= $options{-end}; # damn damn damn |
|
67
|
|
|
|
|
|
|
my $add_categories= $options{-add_category_labels}; |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
if (my $seg = $options{-segment}) { |
|
70
|
|
|
|
|
|
|
$offset = eval {$seg->start-1} || 0; |
|
71
|
|
|
|
|
|
|
$length = $seg->length; |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$offset ||= $options{-start}-1 if defined $options{-start}; |
|
75
|
|
|
|
|
|
|
$length ||= $options{-stop}-$options{-start}+1 |
|
76
|
|
|
|
|
|
|
if defined $options{-start} && defined $options{-stop}; |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# bring in the image generator class, since we will need it soon anyway |
|
79
|
|
|
|
|
|
|
eval "require $image_class; 1" or $class->throw($@); |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
return bless { |
|
82
|
|
|
|
|
|
|
tracks => [], |
|
83
|
|
|
|
|
|
|
width => $options{-width} || 600, |
|
84
|
|
|
|
|
|
|
pad_top => $options{-pad_top}||0, |
|
85
|
|
|
|
|
|
|
pad_bottom => $options{-pad_bottom}||0, |
|
86
|
|
|
|
|
|
|
pad_left => $options{-pad_left}||0, |
|
87
|
|
|
|
|
|
|
pad_right => $options{-pad_right}||0, |
|
88
|
|
|
|
|
|
|
global_alpha => $options{-alpha} || 0, |
|
89
|
|
|
|
|
|
|
length => $length, |
|
90
|
|
|
|
|
|
|
offset => $offset, |
|
91
|
|
|
|
|
|
|
gridcolor => $gridcolor, |
|
92
|
|
|
|
|
|
|
gridmajorcolor => $gridmajorcolor, |
|
93
|
|
|
|
|
|
|
grid => $grid, |
|
94
|
|
|
|
|
|
|
extend_grid => $extend_grid, |
|
95
|
|
|
|
|
|
|
bgcolor => $bgcolor, |
|
96
|
|
|
|
|
|
|
height => 0, # AUTO |
|
97
|
|
|
|
|
|
|
spacing => $spacing, |
|
98
|
|
|
|
|
|
|
key_font => $keyfont, |
|
99
|
|
|
|
|
|
|
key_color => $keycolor, |
|
100
|
|
|
|
|
|
|
key_spacing => $keyspacing, |
|
101
|
|
|
|
|
|
|
key_style => $keystyle, |
|
102
|
|
|
|
|
|
|
key_align => $keyalign, |
|
103
|
|
|
|
|
|
|
suppress_key => $suppress_key, |
|
104
|
|
|
|
|
|
|
background => $background, |
|
105
|
|
|
|
|
|
|
postgrid => $postgrid, |
|
106
|
|
|
|
|
|
|
autopad => $autopad, |
|
107
|
|
|
|
|
|
|
all_callbacks => $allcallbacks, |
|
108
|
|
|
|
|
|
|
truecolor => $truecolor, |
|
109
|
|
|
|
|
|
|
truetype => $truetype, |
|
110
|
|
|
|
|
|
|
flip => $flip, |
|
111
|
|
|
|
|
|
|
linkrule => $linkrule, |
|
112
|
|
|
|
|
|
|
titlerule => $titlerule, |
|
113
|
|
|
|
|
|
|
targetrule => $targetrule, |
|
114
|
|
|
|
|
|
|
empty_track_style => $empty_track_style, |
|
115
|
|
|
|
|
|
|
image_class => $image_class, |
|
116
|
|
|
|
|
|
|
image_package => $image_class . '::Image', # Accessors |
|
117
|
|
|
|
|
|
|
polygon_package => $image_class . '::Polygon', |
|
118
|
|
|
|
|
|
|
add_category_labels => $add_categories, |
|
119
|
|
|
|
|
|
|
key_boxes => [], |
|
120
|
|
|
|
|
|
|
},$class; |
|
121
|
|
|
|
|
|
|
} |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub rotate { |
|
124
|
|
|
|
|
|
|
my $self = shift; |
|
125
|
|
|
|
|
|
|
my $d = $self->{rotate}; |
|
126
|
|
|
|
|
|
|
$self->{rotate} = shift if @_; |
|
127
|
|
|
|
|
|
|
$d; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub pad_left { |
|
131
|
|
|
|
|
|
|
my $self = shift; |
|
132
|
|
|
|
|
|
|
my $g = $self->{pad_left}; |
|
133
|
|
|
|
|
|
|
$self->{pad_left} = shift if @_; |
|
134
|
|
|
|
|
|
|
$g; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
sub pad_right { |
|
137
|
|
|
|
|
|
|
my $self = shift; |
|
138
|
|
|
|
|
|
|
my $g = $self->{pad_right}; |
|
139
|
|
|
|
|
|
|
$self->{pad_right} = shift if @_; |
|
140
|
|
|
|
|
|
|
$g; |
|
141
|
|
|
|
|
|
|
} |
|
142
|
|
|
|
|
|
|
sub pad_top { |
|
143
|
|
|
|
|
|
|
my $self = shift; |
|
144
|
|
|
|
|
|
|
my $g = $self->{pad_top}; |
|
145
|
|
|
|
|
|
|
$self->{pad_top} = shift if @_; |
|
146
|
|
|
|
|
|
|
$g; |
|
147
|
|
|
|
|
|
|
} |
|
148
|
|
|
|
|
|
|
sub pad_bottom { |
|
149
|
|
|
|
|
|
|
my $self = shift; |
|
150
|
|
|
|
|
|
|
my $g = $self->{pad_bottom}; |
|
151
|
|
|
|
|
|
|
$self->{pad_bottom} = shift if @_; |
|
152
|
|
|
|
|
|
|
$g; |
|
153
|
|
|
|
|
|
|
} |
|
154
|
|
|
|
|
|
|
sub extend_grid { |
|
155
|
|
|
|
|
|
|
my $self = shift; |
|
156
|
|
|
|
|
|
|
my $g = $self->{extend_grid}; |
|
157
|
|
|
|
|
|
|
$self->{extend_grid} = shift if @_; |
|
158
|
|
|
|
|
|
|
$g; |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
sub flip { |
|
161
|
|
|
|
|
|
|
my $self = shift; |
|
162
|
|
|
|
|
|
|
my $g = $self->{flip}; |
|
163
|
|
|
|
|
|
|
$self->{flip} = shift if @_; |
|
164
|
|
|
|
|
|
|
$g; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
sub truetype { |
|
167
|
|
|
|
|
|
|
my $self = shift; |
|
168
|
|
|
|
|
|
|
my $g = $self->{truetype}; |
|
169
|
|
|
|
|
|
|
$self->{truetype} = shift if @_; |
|
170
|
|
|
|
|
|
|
$g; |
|
171
|
|
|
|
|
|
|
} |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# values of empty_track_style are: |
|
174
|
|
|
|
|
|
|
# "suppress" -- suppress empty tracks entirely (default) |
|
175
|
|
|
|
|
|
|
# "key" -- show just the key in "between" mode |
|
176
|
|
|
|
|
|
|
# "line" -- draw a thin grey line |
|
177
|
|
|
|
|
|
|
# "dashed" -- draw a dashed line |
|
178
|
|
|
|
|
|
|
sub empty_track_style { |
|
179
|
|
|
|
|
|
|
my $self = shift; |
|
180
|
|
|
|
|
|
|
my $g = $self->{empty_track_style}; |
|
181
|
|
|
|
|
|
|
$self->{empty_track_style} = shift if @_; |
|
182
|
|
|
|
|
|
|
$g; |
|
183
|
|
|
|
|
|
|
} |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub key_style { |
|
186
|
|
|
|
|
|
|
my $self = shift; |
|
187
|
|
|
|
|
|
|
my $g = $self->{key_style}; |
|
188
|
|
|
|
|
|
|
$self->{key_style} = shift if @_; |
|
189
|
|
|
|
|
|
|
$g; |
|
190
|
|
|
|
|
|
|
} |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub auto_pad { |
|
193
|
|
|
|
|
|
|
my $self = shift; |
|
194
|
|
|
|
|
|
|
my $g = $self->{autopad}; |
|
195
|
|
|
|
|
|
|
$self->{autopad} = shift if @_; |
|
196
|
|
|
|
|
|
|
$g; |
|
197
|
|
|
|
|
|
|
} |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# public routine for mapping from a base pair |
|
200
|
|
|
|
|
|
|
# location to pixel coordinates |
|
201
|
|
|
|
|
|
|
sub location2pixel { |
|
202
|
|
|
|
|
|
|
my $self = shift; |
|
203
|
|
|
|
|
|
|
my $end = $self->end + 1; |
|
204
|
|
|
|
|
|
|
my @coords = $self->{flip} ? map { $end-$_ } @_ : @_; |
|
205
|
|
|
|
|
|
|
$self->map_pt(@coords); |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# numerous direct calls into array used here for performance considerations |
|
209
|
|
|
|
|
|
|
sub map_pt { |
|
210
|
|
|
|
|
|
|
my $self = shift; |
|
211
|
|
|
|
|
|
|
my $offset = $self->{offset}; |
|
212
|
|
|
|
|
|
|
my $scale = $self->{scale} || $self->scale; |
|
213
|
|
|
|
|
|
|
my $pl = $self->{pad_left}; |
|
214
|
|
|
|
|
|
|
my $pr = $self->{width}; |
|
215
|
|
|
|
|
|
|
my $flip = $self->{flip}; |
|
216
|
|
|
|
|
|
|
my $length = $self->{length}; |
|
217
|
|
|
|
|
|
|
my @result; |
|
218
|
|
|
|
|
|
|
foreach (@_) { |
|
219
|
|
|
|
|
|
|
my $val = $flip |
|
220
|
|
|
|
|
|
|
? $pr - ($length - ($_- 1)) * $scale |
|
221
|
|
|
|
|
|
|
: ($_-$offset-1) * $scale; |
|
222
|
|
|
|
|
|
|
$val = int($val + 0.5 * ($val<=>0)); |
|
223
|
|
|
|
|
|
|
$val = -1 if $val < 0; |
|
224
|
|
|
|
|
|
|
$val = $pr+1 if $val > $pr; |
|
225
|
|
|
|
|
|
|
push @result,$val; |
|
226
|
|
|
|
|
|
|
} |
|
227
|
|
|
|
|
|
|
@result; |
|
228
|
|
|
|
|
|
|
} |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub map_no_trunc { |
|
231
|
|
|
|
|
|
|
my $self = shift; |
|
232
|
|
|
|
|
|
|
my $offset = $self->{offset}; |
|
233
|
|
|
|
|
|
|
my $scale = $self->scale; |
|
234
|
|
|
|
|
|
|
my $pl = $self->{pad_left}; |
|
235
|
|
|
|
|
|
|
my $pr = $pl + $self->{width}; # - $self->{pad_right}; |
|
236
|
|
|
|
|
|
|
my $flip = $self->{flip}; |
|
237
|
|
|
|
|
|
|
my $length = $self->{length}; |
|
238
|
|
|
|
|
|
|
my $end = $offset+$length; |
|
239
|
|
|
|
|
|
|
my @result; |
|
240
|
|
|
|
|
|
|
foreach (@_) { |
|
241
|
|
|
|
|
|
|
my $val = $flip ? int (0.5 + $pl + ($end - ($_- 1)) * $scale) : int (0.5 + $pl + ($_-$offset-1) * $scale); |
|
242
|
|
|
|
|
|
|
push @result,$val; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
@result; |
|
245
|
|
|
|
|
|
|
} |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub scale { |
|
248
|
|
|
|
|
|
|
my $self = shift; |
|
249
|
|
|
|
|
|
|
$self->{scale} ||= $self->width/($self->length); |
|
250
|
|
|
|
|
|
|
} |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub start { shift->{offset}+1} |
|
253
|
|
|
|
|
|
|
sub end { $_[0]->start + $_[0]->{length}-1} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub offset { shift->{offset} } |
|
256
|
|
|
|
|
|
|
sub width { |
|
257
|
|
|
|
|
|
|
my $self = shift; |
|
258
|
|
|
|
|
|
|
my $d = $self->{width}; |
|
259
|
|
|
|
|
|
|
$self->{width} = shift if @_; |
|
260
|
|
|
|
|
|
|
$d; |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub left { |
|
264
|
|
|
|
|
|
|
my $self = shift; |
|
265
|
|
|
|
|
|
|
$self->pad_left; |
|
266
|
|
|
|
|
|
|
} |
|
267
|
|
|
|
|
|
|
sub right { |
|
268
|
|
|
|
|
|
|
my $self = shift; |
|
269
|
|
|
|
|
|
|
$self->pad_left + $self->width; # - $self->pad_right; |
|
270
|
|
|
|
|
|
|
} |
|
271
|
|
|
|
|
|
|
sub top { |
|
272
|
|
|
|
|
|
|
shift->pad_top; |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
sub bottom { |
|
275
|
|
|
|
|
|
|
my $self = shift; |
|
276
|
|
|
|
|
|
|
$self->height - $self->pad_bottom; |
|
277
|
|
|
|
|
|
|
} |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub spacing { |
|
280
|
|
|
|
|
|
|
my $self = shift; |
|
281
|
|
|
|
|
|
|
my $d = $self->{spacing}; |
|
282
|
|
|
|
|
|
|
$self->{spacing} = shift if @_; |
|
283
|
|
|
|
|
|
|
$d; |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub key_spacing { |
|
287
|
|
|
|
|
|
|
my $self = shift; |
|
288
|
|
|
|
|
|
|
my $d = $self->{key_spacing}; |
|
289
|
|
|
|
|
|
|
$self->{key_spacing} = shift if @_; |
|
290
|
|
|
|
|
|
|
$d; |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub length { |
|
294
|
|
|
|
|
|
|
my $self = shift; |
|
295
|
|
|
|
|
|
|
my $d = $self->{length}; |
|
296
|
|
|
|
|
|
|
if (@_) { |
|
297
|
|
|
|
|
|
|
my $l = shift; |
|
298
|
|
|
|
|
|
|
$l = $l->length if ref($l) && $l->can('length'); |
|
299
|
|
|
|
|
|
|
$self->{length} = $l; |
|
300
|
|
|
|
|
|
|
} |
|
301
|
|
|
|
|
|
|
$d; |
|
302
|
|
|
|
|
|
|
} |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub gridcolor {shift->{gridcolor}} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub gridmajorcolor {shift->{gridmajorcolor}} |
|
307
|
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub all_callbacks { shift->{all_callbacks} } |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub add_track { |
|
311
|
|
|
|
|
|
|
my $self = shift; |
|
312
|
|
|
|
|
|
|
$self->_do_add_track(scalar(@{$self->{tracks}}),@_); |
|
313
|
|
|
|
|
|
|
} |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub unshift_track { |
|
316
|
|
|
|
|
|
|
my $self = shift; |
|
317
|
|
|
|
|
|
|
$self->_do_add_track(0,@_); |
|
318
|
|
|
|
|
|
|
} |
|
319
|
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub insert_track { |
|
321
|
|
|
|
|
|
|
my $self = shift; |
|
322
|
|
|
|
|
|
|
my $position = shift; |
|
323
|
|
|
|
|
|
|
$self->_do_add_track($position,@_); |
|
324
|
|
|
|
|
|
|
} |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# create a feature and factory pair |
|
328
|
|
|
|
|
|
|
# see Factory.pm for the format of the options |
|
329
|
|
|
|
|
|
|
# The thing returned is actually a generic Glyph |
|
330
|
|
|
|
|
|
|
sub _do_add_track { |
|
331
|
|
|
|
|
|
|
my $self = shift; |
|
332
|
|
|
|
|
|
|
my $position = shift; |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# due to indecision, we accept features |
|
335
|
|
|
|
|
|
|
# and/or glyph types in the first two arguments |
|
336
|
|
|
|
|
|
|
my ($features,$glyph_name) = ([],undef); |
|
337
|
|
|
|
|
|
|
while ( @_ && $_[0] !~ /^-/) { |
|
338
|
|
|
|
|
|
|
my $arg = shift; |
|
339
|
|
|
|
|
|
|
$features = $arg and next if ref($arg); |
|
340
|
|
|
|
|
|
|
$glyph_name = $arg and next unless ref($arg); |
|
341
|
|
|
|
|
|
|
} |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
my %args = @_; |
|
344
|
|
|
|
|
|
|
my ($map,$ss,%options); |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
foreach (keys %args) { |
|
347
|
|
|
|
|
|
|
(my $canonical = lc $_) =~ s/^-//; |
|
348
|
|
|
|
|
|
|
if ($canonical eq 'glyph') { |
|
349
|
|
|
|
|
|
|
$map = $args{$_}; |
|
350
|
|
|
|
|
|
|
delete $args{$_}; |
|
351
|
|
|
|
|
|
|
} elsif ($canonical eq 'stylesheet') { |
|
352
|
|
|
|
|
|
|
$ss = $args{$_}; |
|
353
|
|
|
|
|
|
|
delete $args{$_}; |
|
354
|
|
|
|
|
|
|
} else { |
|
355
|
|
|
|
|
|
|
$options{$canonical} = $args{$_}; |
|
356
|
|
|
|
|
|
|
} |
|
357
|
|
|
|
|
|
|
} |
|
358
|
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
$glyph_name = $map if defined $map; |
|
360
|
|
|
|
|
|
|
$glyph_name ||= 'generic'; |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
local $^W = 0; # uninitialized variable warnings under 5.00503 |
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
my $panel_map = |
|
365
|
|
|
|
|
|
|
ref($map) eq 'CODE' ? sub { |
|
366
|
|
|
|
|
|
|
my $feature = shift; |
|
367
|
|
|
|
|
|
|
return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' }; |
|
368
|
|
|
|
|
|
|
return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' }; |
|
369
|
|
|
|
|
|
|
return 'scale' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'scale' }; |
|
370
|
|
|
|
|
|
|
return $map->($feature,'glyph',$self); |
|
371
|
|
|
|
|
|
|
} |
|
372
|
|
|
|
|
|
|
: ref($map) eq 'HASH' ? sub { |
|
373
|
|
|
|
|
|
|
my $feature = shift; |
|
374
|
|
|
|
|
|
|
return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' }; |
|
375
|
|
|
|
|
|
|
return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' }; |
|
376
|
|
|
|
|
|
|
return 'scale' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'scale' }; |
|
377
|
|
|
|
|
|
|
return eval {$map->{$feature->primary_tag}} || 'generic'; |
|
378
|
|
|
|
|
|
|
} |
|
379
|
|
|
|
|
|
|
: sub { |
|
380
|
|
|
|
|
|
|
my $feature = shift; |
|
381
|
|
|
|
|
|
|
return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'track' }; |
|
382
|
|
|
|
|
|
|
return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'group' }; |
|
383
|
|
|
|
|
|
|
return 'scale' if eval { defined $feature->primary_tag && $feature->primary_tag eq 'scale' }; |
|
384
|
|
|
|
|
|
|
return $glyph_name; |
|
385
|
|
|
|
|
|
|
}; |
|
386
|
|
|
|
|
|
|
$self->_add_track($position,$features,-map=>$panel_map,-stylesheet=>$ss,-options=>\%options); |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub _add_track { |
|
390
|
|
|
|
|
|
|
my $self = shift; |
|
391
|
|
|
|
|
|
|
my ($position,$features,@options) = @_; |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# build the list of features into a Bio::Graphics::Feature object |
|
394
|
|
|
|
|
|
|
$features = [$features] unless ref $features eq 'ARRAY'; |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# optional middle-level glyph is the group |
|
397
|
|
|
|
|
|
|
foreach my $f (grep {ref $_ eq 'ARRAY'} @$features) { |
|
398
|
|
|
|
|
|
|
next unless ref $f eq 'ARRAY'; |
|
399
|
|
|
|
|
|
|
$f = Bio::Graphics::Feature->new( |
|
400
|
|
|
|
|
|
|
-segments=>$f, |
|
401
|
|
|
|
|
|
|
-type => 'group' |
|
402
|
|
|
|
|
|
|
); |
|
403
|
|
|
|
|
|
|
} |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# top-level glyph is the track |
|
406
|
|
|
|
|
|
|
my $feature = Bio::Graphics::Feature->new( |
|
407
|
|
|
|
|
|
|
-segments=>$features, |
|
408
|
|
|
|
|
|
|
-start => $self->offset+1, |
|
409
|
|
|
|
|
|
|
-stop => $self->offset+$self->length, |
|
410
|
|
|
|
|
|
|
-type => 'track' |
|
411
|
|
|
|
|
|
|
); |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my $factory = Bio::Graphics::Glyph::Factory->new($self,@options); |
|
414
|
|
|
|
|
|
|
my $track = $factory->make_glyph(-1,$feature); |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
splice(@{$self->{tracks}},$position,0,$track); |
|
417
|
|
|
|
|
|
|
return $track; |
|
418
|
|
|
|
|
|
|
} |
|
419
|
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub _expand_padding { |
|
421
|
|
|
|
|
|
|
my $self = shift; |
|
422
|
|
|
|
|
|
|
my $track = shift; |
|
423
|
|
|
|
|
|
|
my $extra_padding = $self->extra_right_padding; |
|
424
|
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
my $keystyle = $self->key_style; |
|
426
|
|
|
|
|
|
|
my $empty_track_style = $self->empty_track_style; |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
return unless $keystyle eq 'left' or $keystyle eq 'right'; |
|
429
|
|
|
|
|
|
|
return unless $self->auto_pad; |
|
430
|
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
$self->setup_fonts(); |
|
432
|
|
|
|
|
|
|
my $width = $self->{key_font}->width; |
|
433
|
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $key = $self->track2key($track); |
|
435
|
|
|
|
|
|
|
return unless defined $key; |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
my $has_parts = $track->parts; |
|
438
|
|
|
|
|
|
|
next if !$has_parts && $empty_track_style eq 'suppress'; |
|
439
|
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
my $width_needed = $self->{key_font}->width * CORE::length($key)+3; |
|
441
|
|
|
|
|
|
|
if ($keystyle eq 'left') { |
|
442
|
|
|
|
|
|
|
my $width_i_have = $self->pad_left; |
|
443
|
|
|
|
|
|
|
$self->pad_left($width_needed) if $width_needed > $width_i_have; |
|
444
|
|
|
|
|
|
|
} elsif ($keystyle eq 'right') { |
|
445
|
|
|
|
|
|
|
$width_needed += $extra_padding; |
|
446
|
|
|
|
|
|
|
my $width_i_have = $self->pad_right; |
|
447
|
|
|
|
|
|
|
$self->pad_right($width_needed) if $width_needed > $width_i_have; |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
} |
|
450
|
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub extra_right_padding { EXTRA_RIGHT_PADDING } |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub height { |
|
454
|
|
|
|
|
|
|
my $self = shift; |
|
455
|
|
|
|
|
|
|
$self->setup_fonts; |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
458
|
|
|
|
|
|
|
$self->_expand_padding($track); |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
my $spacing = $self->spacing; |
|
462
|
|
|
|
|
|
|
my $key_height = $self->format_key; |
|
463
|
|
|
|
|
|
|
my $empty_track_style = $self->empty_track_style; |
|
464
|
|
|
|
|
|
|
my $key_style = $self->key_style; |
|
465
|
|
|
|
|
|
|
my $bottom_key = $key_style eq 'bottom'; |
|
466
|
|
|
|
|
|
|
my $between_key = $key_style eq 'between'; |
|
467
|
|
|
|
|
|
|
my $side_key = $key_style =~ /left|right/; |
|
468
|
|
|
|
|
|
|
my $draw_empty = $empty_track_style =~ /^(line|dashed)$/; |
|
469
|
|
|
|
|
|
|
my $keyheight = $self->{key_font}->height; |
|
470
|
|
|
|
|
|
|
my $height = 0; |
|
471
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
472
|
|
|
|
|
|
|
my $draw_between = $between_key && $track->option('key'); |
|
473
|
|
|
|
|
|
|
my $has_parts = $track->parts; |
|
474
|
|
|
|
|
|
|
next if !$has_parts && ($empty_track_style eq 'suppress' |
|
475
|
|
|
|
|
|
|
or $empty_track_style eq 'key' && $bottom_key); |
|
476
|
|
|
|
|
|
|
$height += $keyheight if $draw_between; |
|
477
|
|
|
|
|
|
|
$height += $self->spacing; |
|
478
|
|
|
|
|
|
|
my $layout_height = $track->layout_height; |
|
479
|
|
|
|
|
|
|
$height += ($side_key && $keyheight > $layout_height) ? $keyheight : $layout_height; |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# get rid of spacing under last track |
|
483
|
|
|
|
|
|
|
$height -= $self->spacing unless $bottom_key; |
|
484
|
|
|
|
|
|
|
return $height + $key_height + $self->pad_top + $self->pad_bottom + 2; |
|
485
|
|
|
|
|
|
|
} |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub setup_fonts { |
|
488
|
|
|
|
|
|
|
my $self = shift; |
|
489
|
|
|
|
|
|
|
return if ref $self->{key_font}; |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
my $image_class = $self->image_class; |
|
492
|
|
|
|
|
|
|
my $keyfont = $self->{key_font}; |
|
493
|
|
|
|
|
|
|
my $font_obj = $image_class->$keyfont; |
|
494
|
|
|
|
|
|
|
$self->{key_font} = $font_obj; |
|
495
|
|
|
|
|
|
|
} |
|
496
|
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub gd { |
|
498
|
|
|
|
|
|
|
my $self = shift; |
|
499
|
|
|
|
|
|
|
my $existing_gd = shift; |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
local $^W = 0; # can't track down the uninitialized variable warning |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
return $self->{gd} if $self->{gd}; |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
$self->setup_fonts; |
|
506
|
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
unless ($existing_gd) { |
|
508
|
|
|
|
|
|
|
my $image_class = $self->image_class; |
|
509
|
|
|
|
|
|
|
eval "require $image_class; 1" or $self->throw($@); |
|
510
|
|
|
|
|
|
|
} |
|
511
|
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
my $height = $self->height; |
|
513
|
|
|
|
|
|
|
my $width = $self->width + $self->pad_left + $self->pad_right; |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
my $pkg = $self->image_package; |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
$height = 12 if $height < 1; # so GD doesn't crash |
|
518
|
|
|
|
|
|
|
$width = 1 if $width < 1; # ditto |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
my $gd = $existing_gd || $pkg->new($width,$height, |
|
521
|
|
|
|
|
|
|
($self->{truecolor} && $pkg->can('isTrueColor') ? 1 : ()) |
|
522
|
|
|
|
|
|
|
); |
|
523
|
|
|
|
|
|
|
$gd->{debug} = 0 if $gd->isa('GD::SVG::Image'); # hack |
|
524
|
|
|
|
|
|
|
$self->{gd} = $gd; |
|
525
|
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
if ($self->{truecolor} |
|
527
|
|
|
|
|
|
|
&& $pkg->can('saveAlpha')) { |
|
528
|
|
|
|
|
|
|
$gd->saveAlpha(1); |
|
529
|
|
|
|
|
|
|
} |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
my %translation_table; |
|
532
|
|
|
|
|
|
|
my $global_alpha = $self->{global_alpha} || 0; |
|
533
|
|
|
|
|
|
|
for my $name (keys %COLORS) { |
|
534
|
|
|
|
|
|
|
my $idx = $gd->colorAllocate(@{$COLORS{$name}}); |
|
535
|
|
|
|
|
|
|
$translation_table{$name} = $idx; |
|
536
|
|
|
|
|
|
|
} |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
$self->{translations} = \%translation_table; |
|
539
|
|
|
|
|
|
|
$self->{gd} = $gd->isa('GD::SVG::Image') ? $gd |
|
540
|
|
|
|
|
|
|
: $self->truetype ? Bio::Graphics::GDWrapper->new($gd,$self->truetype) |
|
541
|
|
|
|
|
|
|
: $gd; |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
eval {$gd->alphaBlending(0)}; |
|
544
|
|
|
|
|
|
|
if ($self->bgcolor) { |
|
545
|
|
|
|
|
|
|
$gd->fill(0,0,$self->bgcolor); |
|
546
|
|
|
|
|
|
|
} elsif (eval {$gd->isTrueColor}) { |
|
547
|
|
|
|
|
|
|
$gd->fill(0,0,$translation_table{'white'}); |
|
548
|
|
|
|
|
|
|
} |
|
549
|
|
|
|
|
|
|
eval {$gd->alphaBlending(1)}; |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
my $pl = $self->pad_left; |
|
552
|
|
|
|
|
|
|
my $pt = $self->pad_top; |
|
553
|
|
|
|
|
|
|
my $offset = $pt; |
|
554
|
|
|
|
|
|
|
my $keyheight = $self->{key_font}->height; |
|
555
|
|
|
|
|
|
|
my $bottom_key = $self->{key_style} eq 'bottom'; |
|
556
|
|
|
|
|
|
|
my $between_key = $self->{key_style} eq 'between'; |
|
557
|
|
|
|
|
|
|
my $left_key = $self->{key_style} eq 'left'; |
|
558
|
|
|
|
|
|
|
my $right_key = $self->{key_style} eq 'right'; |
|
559
|
|
|
|
|
|
|
my $empty_track_style = $self->empty_track_style; |
|
560
|
|
|
|
|
|
|
my $spacing = $self->spacing; |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
# we draw in two steps, once for background of tracks, and once for |
|
563
|
|
|
|
|
|
|
# the contents. This allows the grid to sit on top of the track background. |
|
564
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
565
|
|
|
|
|
|
|
my $draw_between = $between_key && $track->option('key'); |
|
566
|
|
|
|
|
|
|
next if !$track->parts && ($empty_track_style eq 'suppress' |
|
567
|
|
|
|
|
|
|
or $empty_track_style eq 'key' && $bottom_key); |
|
568
|
|
|
|
|
|
|
$gd->filledRectangle($pl, |
|
569
|
|
|
|
|
|
|
$offset, |
|
570
|
|
|
|
|
|
|
$width-$self->pad_right, |
|
571
|
|
|
|
|
|
|
$offset+$track->layout_height |
|
572
|
|
|
|
|
|
|
+ ($between_key ? $self->{key_font}->height : 0), |
|
573
|
|
|
|
|
|
|
$track->tkcolor) |
|
574
|
|
|
|
|
|
|
if defined $track->tkcolor; |
|
575
|
|
|
|
|
|
|
$offset += $keyheight if $draw_between; |
|
576
|
|
|
|
|
|
|
$offset += $track->layout_height + $spacing; |
|
577
|
|
|
|
|
|
|
} |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
$self->startGroup($gd); |
|
580
|
|
|
|
|
|
|
$self->draw_background($gd,$self->{background}) if $self->{background}; |
|
581
|
|
|
|
|
|
|
$self->draw_grid($gd) if $self->{grid}; |
|
582
|
|
|
|
|
|
|
$self->draw_background($gd,$self->{postgrid}) if $self->{postgrid}; |
|
583
|
|
|
|
|
|
|
$self->endGroup($gd); |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
$offset = $pt; |
|
586
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
587
|
|
|
|
|
|
|
$self->startGroup($gd); |
|
588
|
|
|
|
|
|
|
my $draw_between = $between_key && $track->option('key'); |
|
589
|
|
|
|
|
|
|
my $has_parts = $track->parts; |
|
590
|
|
|
|
|
|
|
my $side_key_height = 0; |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
next if !$has_parts && ($empty_track_style eq 'suppress' |
|
593
|
|
|
|
|
|
|
or $empty_track_style eq 'key' && $bottom_key); |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
if ($draw_between) { |
|
596
|
|
|
|
|
|
|
$offset += $self->draw_between_key($gd,$track,$offset); |
|
597
|
|
|
|
|
|
|
} |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
$self->draw_empty($gd,$offset,$empty_track_style) |
|
600
|
|
|
|
|
|
|
if !$has_parts && $empty_track_style=~/^(line|dashed)$/; |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
$track->draw($gd,$pl,$offset,0,1); |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
if ($self->{key_style} =~ /^(left|right)$/) { |
|
605
|
|
|
|
|
|
|
$side_key_height = $self->draw_side_key($gd,$track,$offset,$self->{key_style}); |
|
606
|
|
|
|
|
|
|
} |
|
607
|
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
$self->track_position($track,$offset); |
|
609
|
|
|
|
|
|
|
my $layout_height = $track->layout_height; |
|
610
|
|
|
|
|
|
|
$offset += ($side_key_height > $layout_height ? $side_key_height : $layout_height)+$spacing; |
|
611
|
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
$self->endGroup($gd); |
|
613
|
|
|
|
|
|
|
} |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
$self->startGroup($gd); |
|
617
|
|
|
|
|
|
|
$self->draw_bottom_key($gd,$pl,$offset) if $self->{key_style} eq 'bottom'; |
|
618
|
|
|
|
|
|
|
$self->endGroup($gd); |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
return $self->{gd} = $self->rotate ? $gd->copyRotate90 : $gd; |
|
621
|
|
|
|
|
|
|
} |
|
622
|
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
sub gdfont { |
|
624
|
|
|
|
|
|
|
my $self = shift; |
|
625
|
|
|
|
|
|
|
my $font = shift; |
|
626
|
|
|
|
|
|
|
my $img_class = $self->image_class; |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
if (!UNIVERSAL::isa($font,$img_class . '::Font') && $font =~ /^(gd|sanserif)/) { |
|
629
|
|
|
|
|
|
|
my $ref = $self->{gdfonts} ||= { |
|
630
|
|
|
|
|
|
|
gdTinyFont => $img_class->gdTinyFont(), |
|
631
|
|
|
|
|
|
|
gdSmallFont => $img_class->gdSmallFont(), |
|
632
|
|
|
|
|
|
|
gdMediumBoldFont => $img_class->gdMediumBoldFont(), |
|
633
|
|
|
|
|
|
|
gdLargeFont => $img_class->gdLargeFont(), |
|
634
|
|
|
|
|
|
|
gdGiantFont => $img_class->gdGiantFont(), |
|
635
|
|
|
|
|
|
|
sanserif => $img_class->gdSmallFont(), |
|
636
|
|
|
|
|
|
|
}; |
|
637
|
|
|
|
|
|
|
return $ref->{$font} || $ref->{gdSmallFont}; |
|
638
|
|
|
|
|
|
|
} else { |
|
639
|
|
|
|
|
|
|
return $font; |
|
640
|
|
|
|
|
|
|
} |
|
641
|
|
|
|
|
|
|
} |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub string_width { |
|
644
|
|
|
|
|
|
|
my $self = shift; |
|
645
|
|
|
|
|
|
|
my ($font,$string) = @_; |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
my $class = $self->image_class; |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
return $font->width*CORE::length($string) |
|
650
|
|
|
|
|
|
|
unless $self->truetype && $class ne 'GD::SVG'; |
|
651
|
|
|
|
|
|
|
return Bio::Graphics::GDWrapper->string_width($font,$string); |
|
652
|
|
|
|
|
|
|
} |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
sub string_height { |
|
655
|
|
|
|
|
|
|
my $self = shift; |
|
656
|
|
|
|
|
|
|
my ($font,$string) = @_; |
|
657
|
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
my $class = $self->image_class; |
|
659
|
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
return $font->height |
|
661
|
|
|
|
|
|
|
unless $self->truetype |
|
662
|
|
|
|
|
|
|
&& eval{$class eq 'GD' || $class->isa('GD::Image')}; |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
return Bio::Graphics::GDWrapper->string_height($font,$string); |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
sub startGroup { |
|
668
|
|
|
|
|
|
|
my $self = shift; |
|
669
|
|
|
|
|
|
|
my $gd = shift; |
|
670
|
|
|
|
|
|
|
$gd->startGroup if $gd->can('startGroup'); |
|
671
|
|
|
|
|
|
|
} |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
sub endGroup { |
|
674
|
|
|
|
|
|
|
my $self = shift; |
|
675
|
|
|
|
|
|
|
my $gd = shift; |
|
676
|
|
|
|
|
|
|
$gd->endGroup if $gd->can('endGroup'); |
|
677
|
|
|
|
|
|
|
} |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
# Package accessors |
|
681
|
|
|
|
|
|
|
# GD (and GD::SVG)'s new() resides in GD::Image |
|
682
|
|
|
|
|
|
|
sub image_class { return shift->{image_class}; } |
|
683
|
|
|
|
|
|
|
sub image_package { return shift->{image_package}; } |
|
684
|
|
|
|
|
|
|
sub polygon_package { return shift->{polygon_package}; } |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
sub boxes { |
|
687
|
|
|
|
|
|
|
my $self = shift; |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
if (my $boxes = $self->{boxes}){ # cached result |
|
690
|
|
|
|
|
|
|
return wantarray ? @$boxes : $boxes; |
|
691
|
|
|
|
|
|
|
} |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
my @boxes; |
|
694
|
|
|
|
|
|
|
my $offset = 0; |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
$self->setup_fonts; |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
my $pl = $self->pad_left; |
|
699
|
|
|
|
|
|
|
my $pt = $self->pad_top; |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
my $between_key = $self->{key_style} eq 'between'; |
|
702
|
|
|
|
|
|
|
my $bottom_key = $self->{key_style} eq 'bottom'; |
|
703
|
|
|
|
|
|
|
my $empty_track_style = $self->empty_track_style; |
|
704
|
|
|
|
|
|
|
my $keyheight = $self->{key_font}->height; |
|
705
|
|
|
|
|
|
|
my $spacing = $self->spacing; |
|
706
|
|
|
|
|
|
|
my $rotate = $self->rotate; |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
709
|
|
|
|
|
|
|
my $draw_between = $between_key && $track->option('key'); |
|
710
|
|
|
|
|
|
|
next if !$track->parts && ($empty_track_style eq 'suppress' |
|
711
|
|
|
|
|
|
|
or $empty_track_style eq 'key' && $bottom_key); |
|
712
|
|
|
|
|
|
|
$offset += $keyheight if $draw_between; |
|
713
|
|
|
|
|
|
|
my $height = $track->layout_height; |
|
714
|
|
|
|
|
|
|
my $boxes = $track->boxes($pl,$offset+$pt); |
|
715
|
|
|
|
|
|
|
$self->track_position($track,$offset); |
|
716
|
|
|
|
|
|
|
push @boxes,@$boxes; |
|
717
|
|
|
|
|
|
|
$offset += $track->layout_height + $self->spacing; |
|
718
|
|
|
|
|
|
|
} |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
if ($rotate) { |
|
721
|
|
|
|
|
|
|
my $x_offset = $self->height-1; |
|
722
|
|
|
|
|
|
|
@boxes = map { |
|
723
|
|
|
|
|
|
|
@{$_}[1,2,3,4] = @{$_}[4,1,2,3]; |
|
724
|
|
|
|
|
|
|
($_->[1],$_->[3]) = map {$x_offset - $_} @{$_}[1,3]; |
|
725
|
|
|
|
|
|
|
$_; |
|
726
|
|
|
|
|
|
|
} @boxes; |
|
727
|
|
|
|
|
|
|
} |
|
728
|
|
|
|
|
|
|
$self->{boxes} = \@boxes; |
|
729
|
|
|
|
|
|
|
return wantarray ? @boxes : \@boxes; |
|
730
|
|
|
|
|
|
|
} |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub track_position { |
|
733
|
|
|
|
|
|
|
my $self = shift; |
|
734
|
|
|
|
|
|
|
my $track = shift; |
|
735
|
|
|
|
|
|
|
my $d = $self->{_track_position}{$track}; |
|
736
|
|
|
|
|
|
|
$self->{_track_position}{$track} = shift if @_; |
|
737
|
|
|
|
|
|
|
$d; |
|
738
|
|
|
|
|
|
|
} |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
# draw the keys -- between |
|
741
|
|
|
|
|
|
|
sub draw_between_key { |
|
742
|
|
|
|
|
|
|
my $self = shift; |
|
743
|
|
|
|
|
|
|
my ($gd,$track,$offset) = @_; |
|
744
|
|
|
|
|
|
|
my $key = $self->track2key($track) or return 0; |
|
745
|
|
|
|
|
|
|
my $x = $self->{key_align} eq 'center' ? $self->width - (CORE::length($key) * $self->{key_font}->width)/2 |
|
746
|
|
|
|
|
|
|
: $self->{key_align} eq 'right' ? $self->width - CORE::length($key) |
|
747
|
|
|
|
|
|
|
: $self->pad_left; |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# Key color hard-coded. Should be configurable for the control freaks. |
|
750
|
|
|
|
|
|
|
my $color = $self->translate_color('black'); |
|
751
|
|
|
|
|
|
|
$gd->string($self->{key_font},$x,$offset,$key,$color) unless $self->{suppress_key}; |
|
752
|
|
|
|
|
|
|
$self->add_key_box($track,$key,$x,$offset); |
|
753
|
|
|
|
|
|
|
return $self->{key_font}->height; |
|
754
|
|
|
|
|
|
|
} |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
# draw the keys -- left or right side |
|
757
|
|
|
|
|
|
|
sub draw_side_key { |
|
758
|
|
|
|
|
|
|
my $self = shift; |
|
759
|
|
|
|
|
|
|
my ($gd,$track,$offset,$side) = @_; |
|
760
|
|
|
|
|
|
|
my $key = $self->track2key($track) or return; |
|
761
|
|
|
|
|
|
|
my $pos = $side eq 'left' ? $self->pad_left - $self->{key_font}->width * CORE::length($key)-3 |
|
762
|
|
|
|
|
|
|
: $self->pad_left + $self->width + EXTRA_RIGHT_PADDING; |
|
763
|
|
|
|
|
|
|
my $color = $self->translate_color('black'); |
|
764
|
|
|
|
|
|
|
unless ($self->{suppress_key}) { |
|
765
|
|
|
|
|
|
|
$gd->filledRectangle($pos,$offset, |
|
766
|
|
|
|
|
|
|
$pos+$self->{key_font}->width*CORE::length($key),$offset,#-$self->{key_font}->height)/2, |
|
767
|
|
|
|
|
|
|
$self->bgcolor); |
|
768
|
|
|
|
|
|
|
$gd->string($self->{key_font},$pos,$offset,$key,$color); |
|
769
|
|
|
|
|
|
|
} |
|
770
|
|
|
|
|
|
|
$self->add_key_box($track,$key,$pos,$offset); |
|
771
|
|
|
|
|
|
|
return $self->{key_font}->height; |
|
772
|
|
|
|
|
|
|
} |
|
773
|
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
# draw the keys -- bottom |
|
775
|
|
|
|
|
|
|
sub draw_bottom_key { |
|
776
|
|
|
|
|
|
|
my $self = shift; |
|
777
|
|
|
|
|
|
|
my ($gd,$left,$top) = @_; |
|
778
|
|
|
|
|
|
|
my $key_glyphs = $self->{key_glyphs} or return; |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
my $color = $self->translate_color($self->{key_color}); |
|
781
|
|
|
|
|
|
|
$gd->filledRectangle($left,$top,$self->width - $self->pad_right,$self->height-$self->pad_bottom,$color); |
|
782
|
|
|
|
|
|
|
my $text_color = $self->translate_color('black'); |
|
783
|
|
|
|
|
|
|
$gd->string($self->{key_font},$left,KEYPADTOP+$top,"KEY:",$text_color) unless $self->{suppress_key}; |
|
784
|
|
|
|
|
|
|
$top += $self->{key_font}->height + KEYPADTOP; |
|
785
|
|
|
|
|
|
|
$_->draw($gd,$left,$top) foreach @$key_glyphs; |
|
786
|
|
|
|
|
|
|
} |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# Format the key section, and return its height |
|
789
|
|
|
|
|
|
|
sub format_key { |
|
790
|
|
|
|
|
|
|
my $self = shift; |
|
791
|
|
|
|
|
|
|
return 0 unless $self->key_style eq 'bottom'; |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
return $self->{key_height} if defined $self->{key_height}; |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
my $suppress = $self->{empty_track_style} eq 'suppress'; |
|
796
|
|
|
|
|
|
|
my $between = $self->{key_style} eq 'between'; |
|
797
|
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
if ($between) { |
|
799
|
|
|
|
|
|
|
my @key_tracks = $suppress |
|
800
|
|
|
|
|
|
|
? grep {$_->option('key') && $_->parts} @{$self->{tracks}} |
|
801
|
|
|
|
|
|
|
: grep {$_->option('key')} @{$self->{tracks}}; |
|
802
|
|
|
|
|
|
|
return $self->{key_height} = @key_tracks * $self->{key_font}->height; |
|
803
|
|
|
|
|
|
|
} |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
elsif ($self->{key_style} eq 'bottom') { |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
my ($height,$width) = (0,0); |
|
808
|
|
|
|
|
|
|
my %tracks; |
|
809
|
|
|
|
|
|
|
my @glyphs; |
|
810
|
|
|
|
|
|
|
local $self->{flip} = 0; # don't want to worry about flipped keys! |
|
811
|
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
# determine how many glyphs become part of the key |
|
813
|
|
|
|
|
|
|
# and their max size |
|
814
|
|
|
|
|
|
|
for my $track (@{$self->{tracks}}) { |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
next unless $track->option('key'); |
|
817
|
|
|
|
|
|
|
next if $suppress && !$track->parts; |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
my $glyph; |
|
820
|
|
|
|
|
|
|
if (my @parts = $track->parts) { |
|
821
|
|
|
|
|
|
|
$glyph = $parts[0]->keyglyph; |
|
822
|
|
|
|
|
|
|
} else { |
|
823
|
|
|
|
|
|
|
my $t = Bio::Graphics::Feature->new(-segments=> |
|
824
|
|
|
|
|
|
|
[Bio::Graphics::Feature->new(-start => $self->offset, |
|
825
|
|
|
|
|
|
|
-stop => $self->offset+$self->length)]); |
|
826
|
|
|
|
|
|
|
my $g = $track->factory->make_glyph(0,$t); |
|
827
|
|
|
|
|
|
|
$glyph = $g->keyglyph; |
|
828
|
|
|
|
|
|
|
} |
|
829
|
|
|
|
|
|
|
next unless $glyph; |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
$tracks{$track} = $glyph; |
|
833
|
|
|
|
|
|
|
my ($h,$w) = ($glyph->layout_height, |
|
834
|
|
|
|
|
|
|
$glyph->layout_width); |
|
835
|
|
|
|
|
|
|
$height = $h if $h > $height; |
|
836
|
|
|
|
|
|
|
$width = $w if $w > $width; |
|
837
|
|
|
|
|
|
|
push @glyphs,$glyph; |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
} |
|
840
|
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
$width += $self->key_spacing; |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
# no key glyphs, no key |
|
844
|
|
|
|
|
|
|
return $self->{key_height} = 0 unless @glyphs; |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# now height and width hold the largest glyph, and $glyph_count |
|
847
|
|
|
|
|
|
|
# contains the number of glyphs. We will format them into a |
|
848
|
|
|
|
|
|
|
# box that is roughly 3 height/4 width (golden mean) |
|
849
|
|
|
|
|
|
|
my $rows = 0; |
|
850
|
|
|
|
|
|
|
my $cols = 0; |
|
851
|
|
|
|
|
|
|
my $maxwidth = $self->width - $self->pad_left - $self->pad_right; |
|
852
|
|
|
|
|
|
|
while (++$rows) { |
|
853
|
|
|
|
|
|
|
$cols = @glyphs / $rows; |
|
854
|
|
|
|
|
|
|
$cols = int ($cols+1) if $cols =~ /\./; # round upward for fractions |
|
855
|
|
|
|
|
|
|
my $total_width = $cols * $width; |
|
856
|
|
|
|
|
|
|
my $total_height = $rows * $width; |
|
857
|
|
|
|
|
|
|
last if $total_width < $maxwidth; |
|
858
|
|
|
|
|
|
|
} |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
# move glyphs into row-major format |
|
861
|
|
|
|
|
|
|
my $spacing = $self->key_spacing; |
|
862
|
|
|
|
|
|
|
my $i = 0; |
|
863
|
|
|
|
|
|
|
for (my $c = 0; $c < $cols; $c++) { |
|
864
|
|
|
|
|
|
|
for (my $r = 0; $r < $rows; $r++) { |
|
865
|
|
|
|
|
|
|
my $x = $c * ($width + $spacing); |
|
866
|
|
|
|
|
|
|
my $y = $r * ($height + $spacing); |
|
867
|
|
|
|
|
|
|
next unless defined $glyphs[$i]; |
|
868
|
|
|
|
|
|
|
$glyphs[$i]->move($x,$y); |
|
869
|
|
|
|
|
|
|
$i++; |
|
870
|
|
|
|
|
|
|
} |
|
871
|
|
|
|
|
|
|
} |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
$self->{key_glyphs} = \@glyphs; # remember our key glyphs |
|
874
|
|
|
|
|
|
|
# remember our key height |
|
875
|
|
|
|
|
|
|
return $self->{key_height} = |
|
876
|
|
|
|
|
|
|
($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP; |
|
877
|
|
|
|
|
|
|
} |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
else { # no known key style, neither "between" nor "bottom" |
|
880
|
|
|
|
|
|
|
return $self->{key_height} = 0; |
|
881
|
|
|
|
|
|
|
} |
|
882
|
|
|
|
|
|
|
} |
|
883
|
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub add_key_box { |
|
885
|
|
|
|
|
|
|
my $self = shift; |
|
886
|
|
|
|
|
|
|
my ($track,$label,$x,$y, $is_legend) = @_; |
|
887
|
|
|
|
|
|
|
my $value = [$label,$x,$y,$x+$self->{key_font}->width*CORE::length($label),$y+$self->{key_font}->height,$track]; |
|
888
|
|
|
|
|
|
|
push @{$self->{key_boxes}},$value; |
|
889
|
|
|
|
|
|
|
} |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub key_boxes { |
|
892
|
|
|
|
|
|
|
my $ref = shift->{key_boxes}; |
|
893
|
|
|
|
|
|
|
return wantarray ? @$ref : $ref; |
|
894
|
|
|
|
|
|
|
} |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
sub add_category_labels { |
|
897
|
|
|
|
|
|
|
my $self = shift; |
|
898
|
|
|
|
|
|
|
my $d = $self->{add_category_labels}; |
|
899
|
|
|
|
|
|
|
$self->{add_category_labels} = shift if @_; |
|
900
|
|
|
|
|
|
|
$d; |
|
901
|
|
|
|
|
|
|
} |
|
902
|
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub track2key { |
|
904
|
|
|
|
|
|
|
my $self = shift; |
|
905
|
|
|
|
|
|
|
my $track = shift; |
|
906
|
|
|
|
|
|
|
return $track->make_key_name(); |
|
907
|
|
|
|
|
|
|
} |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
sub draw_empty { |
|
910
|
|
|
|
|
|
|
my $self = shift; |
|
911
|
|
|
|
|
|
|
my ($gd,$offset,$style) = @_; |
|
912
|
|
|
|
|
|
|
$offset += $self->spacing/2; |
|
913
|
|
|
|
|
|
|
my $left = $self->pad_left; |
|
914
|
|
|
|
|
|
|
my $right = $self->width-$self->pad_right; |
|
915
|
|
|
|
|
|
|
my $color = $self->translate_color(MISSING_TRACK_COLOR); |
|
916
|
|
|
|
|
|
|
my $ic = $self->image_class; |
|
917
|
|
|
|
|
|
|
if ($style eq 'dashed') { |
|
918
|
|
|
|
|
|
|
$gd->setStyle($color,$color,$ic->gdTransparent(),$ic->gdTransparent()); |
|
919
|
|
|
|
|
|
|
$gd->line($left,$offset,$right,$offset,$ic->gdStyled()); |
|
920
|
|
|
|
|
|
|
} else { |
|
921
|
|
|
|
|
|
|
$gd->line($left,$offset,$right,$offset,$color); |
|
922
|
|
|
|
|
|
|
} |
|
923
|
|
|
|
|
|
|
$offset; |
|
924
|
|
|
|
|
|
|
} |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
# draw a grid |
|
927
|
|
|
|
|
|
|
sub draw_grid { |
|
928
|
|
|
|
|
|
|
my $self = shift; |
|
929
|
|
|
|
|
|
|
my $gd = shift; |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
my $gridcolor = $self->translate_color($self->{gridcolor}); |
|
932
|
|
|
|
|
|
|
my $gridmajorcolor = $self->translate_color($self->{gridmajorcolor}); |
|
933
|
|
|
|
|
|
|
my @positions; |
|
934
|
|
|
|
|
|
|
my ($major,$minor); |
|
935
|
|
|
|
|
|
|
if (ref $self->{grid} eq 'ARRAY') { |
|
936
|
|
|
|
|
|
|
@positions = @{$self->{grid}}; |
|
937
|
|
|
|
|
|
|
} else { |
|
938
|
|
|
|
|
|
|
($major,$minor) = $self->ticks; |
|
939
|
|
|
|
|
|
|
my $first_tick = $minor * int($self->start/$minor); |
|
940
|
|
|
|
|
|
|
for (my $i = $first_tick; $i <= $self->end+1; $i += $minor) { |
|
941
|
|
|
|
|
|
|
push @positions,$i; |
|
942
|
|
|
|
|
|
|
} |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
my $pl = $self->pad_left; |
|
945
|
|
|
|
|
|
|
my $pt = $self->extend_grid ? 0 : $self->pad_top; |
|
946
|
|
|
|
|
|
|
my $pr = $self->right; |
|
947
|
|
|
|
|
|
|
my $pb = $self->extend_grid ? $self->height : $self->height - $self->pad_bottom; |
|
948
|
|
|
|
|
|
|
my $offset = $self->{offset}+$self->{length}+1; |
|
949
|
|
|
|
|
|
|
for my $tick (@positions) { |
|
950
|
|
|
|
|
|
|
my ($pos) = $self->map_pt($self->{flip} ? $offset - $tick |
|
951
|
|
|
|
|
|
|
: $tick); |
|
952
|
|
|
|
|
|
|
my $color = (defined $major && $tick % $major == 0) ? $gridmajorcolor : $gridcolor; |
|
953
|
|
|
|
|
|
|
$gd->line($pl+$pos,$pt,$pl+$pos,$pb,$color); |
|
954
|
|
|
|
|
|
|
} |
|
955
|
|
|
|
|
|
|
} |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
# draw an image (or invoke a drawing routine) |
|
958
|
|
|
|
|
|
|
sub draw_background { |
|
959
|
|
|
|
|
|
|
my $self = shift; |
|
960
|
|
|
|
|
|
|
my ($gd,$image_or_routine) = @_; |
|
961
|
|
|
|
|
|
|
if (ref $image_or_routine eq 'CODE') { |
|
962
|
|
|
|
|
|
|
return $image_or_routine->($gd,$self); |
|
963
|
|
|
|
|
|
|
} |
|
964
|
|
|
|
|
|
|
if (-f $image_or_routine) { # a file to draw |
|
965
|
|
|
|
|
|
|
my $method = $image_or_routine =~ /\.png$/i ? 'newFromPng' |
|
966
|
|
|
|
|
|
|
: $image_or_routine =~ /\.jpe?g$/i ? 'newFromJpeg' |
|
967
|
|
|
|
|
|
|
: $image_or_routine =~ /\.gd$/i ? 'newFromGd' |
|
968
|
|
|
|
|
|
|
: $image_or_routine =~ /\.gif$/i ? 'newFromGif' |
|
969
|
|
|
|
|
|
|
: $image_or_routine =~ /\.xbm$/i ? 'newFromXbm' |
|
970
|
|
|
|
|
|
|
: ''; |
|
971
|
|
|
|
|
|
|
return unless $method; |
|
972
|
|
|
|
|
|
|
my $image = eval {$self->image_package->$method($image_or_routine)}; |
|
973
|
|
|
|
|
|
|
unless ($image) { |
|
974
|
|
|
|
|
|
|
warn $@; |
|
975
|
|
|
|
|
|
|
return; |
|
976
|
|
|
|
|
|
|
} |
|
977
|
|
|
|
|
|
|
my ($src_width,$src_height) = $image->getBounds; |
|
978
|
|
|
|
|
|
|
my ($dst_width,$dst_height) = $gd->getBounds; |
|
979
|
|
|
|
|
|
|
# tile the thing on |
|
980
|
|
|
|
|
|
|
for (my $x = 0; $x < $dst_width; $x += $src_width) { |
|
981
|
|
|
|
|
|
|
for (my $y = 0; $y < $dst_height; $y += $src_height) { |
|
982
|
|
|
|
|
|
|
$gd->copy($image,$x,$y,0,0,$src_width,$src_height); |
|
983
|
|
|
|
|
|
|
} |
|
984
|
|
|
|
|
|
|
} |
|
985
|
|
|
|
|
|
|
} |
|
986
|
|
|
|
|
|
|
} |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
# calculate major and minor ticks, given a start position |
|
989
|
|
|
|
|
|
|
sub ticks { |
|
990
|
|
|
|
|
|
|
my $self = shift; |
|
991
|
|
|
|
|
|
|
my ($length,$minwidth) = @_; |
|
992
|
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
my $img = $self->image_class; |
|
994
|
|
|
|
|
|
|
$length = $self->{length} unless defined $length; |
|
995
|
|
|
|
|
|
|
$minwidth = $img->gdSmallFont->width*7 unless defined $minwidth; |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
my ($major,$minor); |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
# figure out tick mark scale |
|
1000
|
|
|
|
|
|
|
# we want no more than 1 major tick mark every 40 pixels |
|
1001
|
|
|
|
|
|
|
# and enough room for the labels |
|
1002
|
|
|
|
|
|
|
my $scale = $self->scale; |
|
1003
|
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
my $interval = 10; |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
while (1) { |
|
1007
|
|
|
|
|
|
|
my $pixels = $interval * $scale; |
|
1008
|
|
|
|
|
|
|
last if $pixels >= $minwidth; |
|
1009
|
|
|
|
|
|
|
$interval *= 10; |
|
1010
|
|
|
|
|
|
|
} |
|
1011
|
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
# to make sure a major tick shows up somewhere in the first half |
|
1013
|
|
|
|
|
|
|
# |
|
1014
|
|
|
|
|
|
|
# $interval *= .5 if ($interval > 0.5*$length); |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
return ($interval,$interval/10); |
|
1017
|
|
|
|
|
|
|
} |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
# reverse of translate(); given index, return rgb triplet |
|
1020
|
|
|
|
|
|
|
sub rgb { |
|
1021
|
|
|
|
|
|
|
my $self = shift; |
|
1022
|
|
|
|
|
|
|
my $idx = shift; |
|
1023
|
|
|
|
|
|
|
my $gd = $self->{gd} or return; |
|
1024
|
|
|
|
|
|
|
return $gd->rgb($idx); |
|
1025
|
|
|
|
|
|
|
} |
|
1026
|
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
sub transparent_color { |
|
1028
|
|
|
|
|
|
|
my $self = shift; |
|
1029
|
|
|
|
|
|
|
my ($opacity,@colors) = @_; |
|
1030
|
|
|
|
|
|
|
return $self->_translate_color($opacity,@colors); |
|
1031
|
|
|
|
|
|
|
} |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
sub translate_color { |
|
1034
|
|
|
|
|
|
|
my $self = shift; |
|
1035
|
|
|
|
|
|
|
my @colors = @_; |
|
1036
|
|
|
|
|
|
|
return $self->_translate_color(1.0,@colors); |
|
1037
|
|
|
|
|
|
|
} |
|
1038
|
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
sub _translate_color { |
|
1040
|
|
|
|
|
|
|
my $self = shift; |
|
1041
|
|
|
|
|
|
|
my ($opacity,@colors) = @_; |
|
1042
|
|
|
|
|
|
|
$opacity = '1.0' if $opacity == 1; |
|
1043
|
|
|
|
|
|
|
my $default_alpha = $self->adjust_alpha($opacity); |
|
1044
|
|
|
|
|
|
|
$default_alpha ||= 0; |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
my $ckey = "@{colors}_${default_alpha}"; |
|
1047
|
|
|
|
|
|
|
return $self->{closestcache}{$ckey} if exists $self->{closestcache}{$ckey}; |
|
1048
|
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
my $index; |
|
1050
|
|
|
|
|
|
|
my $gd = $self->gd or return 1; |
|
1051
|
|
|
|
|
|
|
my $table = $self->{translations} or return 1; |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
if (@colors == 3) { |
|
1054
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(@colors,$default_alpha); |
|
1055
|
|
|
|
|
|
|
} |
|
1056
|
|
|
|
|
|
|
elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) { |
|
1057
|
|
|
|
|
|
|
my ($r,$g,$b,$alpha) = (hex($1),hex($2),hex($3),hex($4)); |
|
1058
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha($r,$g,$b,$alpha); |
|
1059
|
|
|
|
|
|
|
} |
|
1060
|
|
|
|
|
|
|
elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) { |
|
1061
|
|
|
|
|
|
|
my ($r,$g,$b) = (hex($1),hex($2),hex($3)); |
|
1062
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha($r,$g,$b,$default_alpha); |
|
1063
|
|
|
|
|
|
|
} |
|
1064
|
|
|
|
|
|
|
elsif ($colors[0] =~ /^(\d+),(\d+),(\d+),([\d.]+)$/i || |
|
1065
|
|
|
|
|
|
|
$colors[0] =~ /^rgba\((\d+),(\d+),(\d+),([\d.]+)\)$/) { |
|
1066
|
|
|
|
|
|
|
my $alpha = $self->adjust_alpha($4); |
|
1067
|
|
|
|
|
|
|
my (@rgb) = map {/(\d+)%/ ? int(255 * $1 / 100) : $_} ($1,$2,$3); |
|
1068
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(@rgb,$4); |
|
1069
|
|
|
|
|
|
|
} |
|
1070
|
|
|
|
|
|
|
elsif ($colors[0] =~ /^(\d+),(\d+),(\d+)$/i || |
|
1071
|
|
|
|
|
|
|
$colors[0] =~ /^rgb\((\d+),(\d+),(\d+)\)$/i |
|
1072
|
|
|
|
|
|
|
) { |
|
1073
|
|
|
|
|
|
|
my (@rgb) = map {/(\d+)%/ ? int(255 * $1 / 100) : $_} ($1,$2,$3); |
|
1074
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(@rgb,$default_alpha); |
|
1075
|
|
|
|
|
|
|
} |
|
1076
|
|
|
|
|
|
|
elsif ($colors[0] eq 'transparent') { |
|
1077
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(255,255,255,127); |
|
1078
|
|
|
|
|
|
|
} |
|
1079
|
|
|
|
|
|
|
elsif ($colors[0] =~ /^(\w+):([\d.]+)/) { # color:alpha |
|
1080
|
|
|
|
|
|
|
my @rgb = $self->color_name_to_rgb($1); |
|
1081
|
|
|
|
|
|
|
@rgb = (0,0,0) unless @rgb; |
|
1082
|
|
|
|
|
|
|
my $alpha = $self->adjust_alpha($2); |
|
1083
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(@rgb,$alpha); |
|
1084
|
|
|
|
|
|
|
} |
|
1085
|
|
|
|
|
|
|
elsif ($default_alpha < 127) { |
|
1086
|
|
|
|
|
|
|
my @rgb = $self->color_name_to_rgb($colors[0]); |
|
1087
|
|
|
|
|
|
|
@rgb = (0,0,0) unless @rgb; |
|
1088
|
|
|
|
|
|
|
$index = $gd->colorAllocateAlpha(@rgb,$default_alpha); |
|
1089
|
|
|
|
|
|
|
} |
|
1090
|
|
|
|
|
|
|
else { |
|
1091
|
|
|
|
|
|
|
$index = defined $table->{$colors[0]} ? $table->{$colors[0]} : 1; |
|
1092
|
|
|
|
|
|
|
} |
|
1093
|
|
|
|
|
|
|
return $self->{closestcache}{$ckey} = $index; |
|
1094
|
|
|
|
|
|
|
} |
|
1095
|
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
# change CSS opacity values (0-1.0) into GD opacity values (127-0) |
|
1097
|
|
|
|
|
|
|
sub adjust_alpha { |
|
1098
|
|
|
|
|
|
|
my $self = shift; |
|
1099
|
|
|
|
|
|
|
my $value = shift; |
|
1100
|
|
|
|
|
|
|
my $alpha = $value =~ /\./ # floating point |
|
1101
|
|
|
|
|
|
|
? int(127-($value*127)+0.5) |
|
1102
|
|
|
|
|
|
|
: $value; |
|
1103
|
|
|
|
|
|
|
$alpha = 0 if $alpha < 0; |
|
1104
|
|
|
|
|
|
|
$alpha = 127 if $alpha > 127; |
|
1105
|
|
|
|
|
|
|
return $alpha; |
|
1106
|
|
|
|
|
|
|
} |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
# workaround for bad GD |
|
1109
|
|
|
|
|
|
|
sub colorClosest { |
|
1110
|
|
|
|
|
|
|
my ($self,$gd,@c) = @_; |
|
1111
|
|
|
|
|
|
|
return $gd->colorResolve(@c) if $GD::VERSION < 2.04; |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
my $index = $gd->colorResolve(@c); |
|
1114
|
|
|
|
|
|
|
return $index if $index >= 0; |
|
1115
|
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
my $value; |
|
1117
|
|
|
|
|
|
|
for (keys %COLORS) { |
|
1118
|
|
|
|
|
|
|
my ($r,$g,$b) = @{$COLORS{$_}}; |
|
1119
|
|
|
|
|
|
|
my $dist = ($r-$c[0])**2 + ($g-$c[1])**2 + ($b-$c[2])**2; |
|
1120
|
|
|
|
|
|
|
($value,$index) = ($dist,$_) if !defined($value) || $dist < $value; |
|
1121
|
|
|
|
|
|
|
} |
|
1122
|
|
|
|
|
|
|
return $self->{translations}{$index}; |
|
1123
|
|
|
|
|
|
|
} |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
sub bgcolor { |
|
1126
|
|
|
|
|
|
|
my $self = shift; |
|
1127
|
|
|
|
|
|
|
return unless $self->{bgcolor}; |
|
1128
|
|
|
|
|
|
|
return $self->translate_color($self->{bgcolor}); |
|
1129
|
|
|
|
|
|
|
} |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
sub set_pen { |
|
1132
|
|
|
|
|
|
|
my $self = shift; |
|
1133
|
|
|
|
|
|
|
my ($linewidth,$color) = @_; |
|
1134
|
|
|
|
|
|
|
return $self->{pens}{$linewidth,$color} if $self->{pens}{$linewidth,$color}; |
|
1135
|
|
|
|
|
|
|
my $gd = $self->{gd}; |
|
1136
|
|
|
|
|
|
|
my $pkg = $self->image_package; |
|
1137
|
|
|
|
|
|
|
my $pen = $self->{pens}{$linewidth} = $pkg->new($linewidth,$linewidth); |
|
1138
|
|
|
|
|
|
|
my @rgb = $self->rgb($color); |
|
1139
|
|
|
|
|
|
|
my $bg = $pen->colorAllocate(255,255,255); |
|
1140
|
|
|
|
|
|
|
my $fg = $pen->colorAllocate(@rgb); |
|
1141
|
|
|
|
|
|
|
$pen->fill(0,0,$fg); |
|
1142
|
|
|
|
|
|
|
$gd->setBrush($pen); |
|
1143
|
|
|
|
|
|
|
return $self->image_class->gdBrushed(); |
|
1144
|
|
|
|
|
|
|
} |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
sub png { |
|
1147
|
|
|
|
|
|
|
my $gd = shift->gd; |
|
1148
|
|
|
|
|
|
|
$gd->png; |
|
1149
|
|
|
|
|
|
|
} |
|
1150
|
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
sub svg { |
|
1152
|
|
|
|
|
|
|
my $gd = shift->gd; |
|
1153
|
|
|
|
|
|
|
$gd->svg; |
|
1154
|
|
|
|
|
|
|
} |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
# WARNING: THIS STUFF IS COPIED FROM Bio::Graphics::Browser.pm AND |
|
1158
|
|
|
|
|
|
|
# Bio::Graphics::FeatureFile AND MUST BE REFACTORED |
|
1159
|
|
|
|
|
|
|
# write a png image to disk and generate an image map in a convenient |
|
1160
|
|
|
|
|
|
|
# CGIish way. |
|
1161
|
|
|
|
|
|
|
sub image_and_map { |
|
1162
|
|
|
|
|
|
|
my $self = shift; |
|
1163
|
|
|
|
|
|
|
my %args = @_; |
|
1164
|
|
|
|
|
|
|
my $link_rule = $args{-link} || $self->{linkrule}; |
|
1165
|
|
|
|
|
|
|
my $title_rule = $args{-title} || $self->{titlerule}; |
|
1166
|
|
|
|
|
|
|
my $target_rule = $args{-target} || $self->{targetrule}; |
|
1167
|
|
|
|
|
|
|
my $tmpurl = $args{-url} || '/tmp'; |
|
1168
|
|
|
|
|
|
|
my $docroot = $args{-root} || $ENV{DOCUMENT_ROOT} || ''; |
|
1169
|
|
|
|
|
|
|
my $mapname = $args{-mapname} || $IMAGEMAP++; |
|
1170
|
|
|
|
|
|
|
$docroot .= '/' if $docroot && $docroot !~ m!/$!; |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
# get rid of any netstat part please |
|
1173
|
|
|
|
|
|
|
(my $tmpurlbase = $tmpurl) =~ s!^\w+://[^/]+!!; |
|
1174
|
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
my $tmpdir = "${docroot}${tmpurlbase}"; |
|
1176
|
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
my $url = $self->create_web_image($tmpurl,$tmpdir); |
|
1178
|
|
|
|
|
|
|
my $map = $self->create_web_map($mapname,$link_rule,$title_rule,$target_rule); |
|
1179
|
|
|
|
|
|
|
return ($url,$map,$mapname); |
|
1180
|
|
|
|
|
|
|
} |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
sub create_web_image { |
|
1183
|
|
|
|
|
|
|
my $self = shift; |
|
1184
|
|
|
|
|
|
|
my ($tmpurl,$tmpdir) = @_; |
|
1185
|
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# create directory if it isn't there already |
|
1187
|
|
|
|
|
|
|
# we need to untaint tmpdir before calling mkpath() |
|
1188
|
|
|
|
|
|
|
return unless $tmpdir =~ /^(.+)$/; |
|
1189
|
|
|
|
|
|
|
my $path = $1; |
|
1190
|
|
|
|
|
|
|
unless (-d $path) { |
|
1191
|
|
|
|
|
|
|
require File::Path unless defined &File::Path::mkpath; |
|
1192
|
|
|
|
|
|
|
File::Path::mkpath($path,0,0777) or $self->throw("Couldn't create temporary image directory $path: $!"); |
|
1193
|
|
|
|
|
|
|
} |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
unless (defined &Digest::MD5::md5_hex) { |
|
1196
|
|
|
|
|
|
|
eval "require Digest::MD5; 1" |
|
1197
|
|
|
|
|
|
|
or $self->throw("Sorry, but the image_and_map() method requires the Digest::MD5 module."); |
|
1198
|
|
|
|
|
|
|
} |
|
1199
|
|
|
|
|
|
|
my $data = $self->png; |
|
1200
|
|
|
|
|
|
|
my $signature = Digest::MD5::md5_hex($data); |
|
1201
|
|
|
|
|
|
|
my $extension = 'png'; |
|
1202
|
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
# untaint signature for use in open |
|
1204
|
|
|
|
|
|
|
$signature =~ /^([0-9A-Fa-f]+)$/g or return; |
|
1205
|
|
|
|
|
|
|
$signature = $1; |
|
1206
|
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
my $url = sprintf("%s/%s.%s",$tmpurl,$signature,$extension); |
|
1208
|
|
|
|
|
|
|
my $imagefile = sprintf("%s/%s.%s",$tmpdir,$signature,$extension); |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
open (my $F,">", $imagefile) || $self->throw("Can't open image file $imagefile for writing: $!\n"); |
|
1211
|
|
|
|
|
|
|
binmode($F); |
|
1212
|
|
|
|
|
|
|
print $F $data; |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
return $url; |
|
1215
|
|
|
|
|
|
|
} |
|
1216
|
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
sub create_web_map { |
|
1218
|
|
|
|
|
|
|
my $self = shift; |
|
1219
|
|
|
|
|
|
|
my ($name,$linkrule,$titlerule,$targetrule) = @_; |
|
1220
|
|
|
|
|
|
|
$name ||= 'map'; |
|
1221
|
|
|
|
|
|
|
my $boxes = $self->boxes; |
|
1222
|
|
|
|
|
|
|
my (%track2link,%track2title,%track2target); |
|
1223
|
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
eval "require CGI" unless CGI->can('escapeHTML'); |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
my $map = qq(<map name="$name" id="$name">\n); |
|
1227
|
|
|
|
|
|
|
foreach (@$boxes){ |
|
1228
|
|
|
|
|
|
|
my ($feature,$left,$top,$right,$bottom,$track) = @$_; |
|
1229
|
|
|
|
|
|
|
next unless $feature->can('primary_tag'); |
|
1230
|
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
my $lr = $track2link{$track} ||= (defined $track->option('link') ? $track->option('link') : $linkrule); |
|
1232
|
|
|
|
|
|
|
next unless $lr; |
|
1233
|
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
my $tr = exists $track2title{$track} |
|
1235
|
|
|
|
|
|
|
? $track2title{$track} |
|
1236
|
|
|
|
|
|
|
: $track2title{$track} ||= (defined $track->option('title') ? $track->option('title') : $titlerule); |
|
1237
|
|
|
|
|
|
|
my $tgr = exists $track2target{$track} |
|
1238
|
|
|
|
|
|
|
? $track2target{$track} |
|
1239
|
|
|
|
|
|
|
: $track2target{$track} ||= (defined $track->option('target')? $track->option('target') : $targetrule); |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
my $href = $self->make_link($lr,$feature); |
|
1242
|
|
|
|
|
|
|
my $title = CGI::escapeHTML($self->make_link($tr,$feature,1)); |
|
1243
|
|
|
|
|
|
|
my $target = CGI::escapeHTML($self->make_link($tgr,$feature,1)); |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
my $a = $title ? qq(title="$title") : ''; |
|
1247
|
|
|
|
|
|
|
my $t = $target ? qq(target="$target") : ''; |
|
1248
|
|
|
|
|
|
|
$map .= qq(<area shape="rect" coords="$left,$top,$right,$bottom" href="$href" $a $t/>\n) if $href; |
|
1249
|
|
|
|
|
|
|
} |
|
1250
|
|
|
|
|
|
|
$map .= "</map>\n"; |
|
1251
|
|
|
|
|
|
|
$map; |
|
1252
|
|
|
|
|
|
|
} |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
sub make_link { |
|
1255
|
|
|
|
|
|
|
my $self = shift; |
|
1256
|
|
|
|
|
|
|
my ($linkrule,$feature,$escapeHTML) = @_; |
|
1257
|
|
|
|
|
|
|
eval "require Bio::Graphics::FeatureFile;1" |
|
1258
|
|
|
|
|
|
|
unless Bio::Graphics::FeatureFile->can('link_pattern'); |
|
1259
|
|
|
|
|
|
|
return Bio::Graphics::FeatureFile->link_pattern($linkrule,$feature,$self,$escapeHTML); |
|
1260
|
|
|
|
|
|
|
} |
|
1261
|
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
sub make_title { |
|
1263
|
|
|
|
|
|
|
my $self = shift; |
|
1264
|
|
|
|
|
|
|
my $feature = shift; |
|
1265
|
|
|
|
|
|
|
eval "require Bio::Graphics::FeatureFile;1" |
|
1266
|
|
|
|
|
|
|
unless Bio::Graphics::FeatureFile->can('make_title'); |
|
1267
|
|
|
|
|
|
|
return Bio::Graphics::FeatureFile->make_title($feature); |
|
1268
|
|
|
|
|
|
|
} |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
sub read_colors { |
|
1271
|
|
|
|
|
|
|
my $class = shift; |
|
1272
|
|
|
|
|
|
|
local ($/) = "\n"; |
|
1273
|
|
|
|
|
|
|
local $_; |
|
1274
|
|
|
|
|
|
|
while (<DATA>) { |
|
1275
|
|
|
|
|
|
|
chomp; |
|
1276
|
|
|
|
|
|
|
last if /^__END__/; |
|
1277
|
|
|
|
|
|
|
my ($name,$r,$g,$b) = split /\s+/; |
|
1278
|
|
|
|
|
|
|
@{$COLORS{$name}} = (hex $r,hex $g, hex $b); |
|
1279
|
|
|
|
|
|
|
} |
|
1280
|
|
|
|
|
|
|
} |
|
1281
|
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub color_name_to_rgb { |
|
1283
|
|
|
|
|
|
|
my $class = shift; |
|
1284
|
|
|
|
|
|
|
my $color_name = shift; |
|
1285
|
|
|
|
|
|
|
$class->read_colors() unless %COLORS; |
|
1286
|
|
|
|
|
|
|
return unless $COLORS{$color_name}; |
|
1287
|
|
|
|
|
|
|
return wantarray ? @{$COLORS{$color_name}} |
|
1288
|
|
|
|
|
|
|
: $COLORS{$color_name}; |
|
1289
|
|
|
|
|
|
|
} |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
sub color_names { |
|
1292
|
|
|
|
|
|
|
my $class = shift; |
|
1293
|
|
|
|
|
|
|
$class->read_colors unless %COLORS; |
|
1294
|
|
|
|
|
|
|
return wantarray ? keys %COLORS : [keys %COLORS]; |
|
1295
|
|
|
|
|
|
|
} |
|
1296
|
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
sub glyph_scratch { |
|
1298
|
|
|
|
|
|
|
my $self = shift; |
|
1299
|
|
|
|
|
|
|
my $d = $GlyphScratch; |
|
1300
|
|
|
|
|
|
|
$GlyphScratch = shift if @_; |
|
1301
|
|
|
|
|
|
|
$d; |
|
1302
|
|
|
|
|
|
|
} |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
sub finished { |
|
1305
|
|
|
|
|
|
|
my $self = shift; |
|
1306
|
|
|
|
|
|
|
for my $track (@{$self->{tracks} || []}) { |
|
1307
|
|
|
|
|
|
|
$track->finished(); |
|
1308
|
|
|
|
|
|
|
} |
|
1309
|
|
|
|
|
|
|
delete $self->{tracks}; |
|
1310
|
|
|
|
|
|
|
} |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
1; |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
__DATA__ |
|
1315
|
|
|
|
|
|
|
white FF FF FF |
|
1316
|
|
|
|
|
|
|
black 00 00 00 |
|
1317
|
|
|
|
|
|
|
aliceblue F0 F8 FF |
|
1318
|
|
|
|
|
|
|
antiquewhite FA EB D7 |
|
1319
|
|
|
|
|
|
|
aqua 00 FF FF |
|
1320
|
|
|
|
|
|
|
aquamarine 7F FF D4 |
|
1321
|
|
|
|
|
|
|
azure F0 FF FF |
|
1322
|
|
|
|
|
|
|
beige F5 F5 DC |
|
1323
|
|
|
|
|
|
|
bisque FF E4 C4 |
|
1324
|
|
|
|
|
|
|
blanchedalmond FF EB CD |
|
1325
|
|
|
|
|
|
|
blue 00 00 FF |
|
1326
|
|
|
|
|
|
|
blueviolet 8A 2B E2 |
|
1327
|
|
|
|
|
|
|
brown A5 2A 2A |
|
1328
|
|
|
|
|
|
|
burlywood DE B8 87 |
|
1329
|
|
|
|
|
|
|
cadetblue 5F 9E A0 |
|
1330
|
|
|
|
|
|
|
chartreuse 7F FF 00 |
|
1331
|
|
|
|
|
|
|
chocolate D2 69 1E |
|
1332
|
|
|
|
|
|
|
coral FF 7F 50 |
|
1333
|
|
|
|
|
|
|
cornflowerblue 64 95 ED |
|
1334
|
|
|
|
|
|
|
cornsilk FF F8 DC |
|
1335
|
|
|
|
|
|
|
crimson DC 14 3C |
|
1336
|
|
|
|
|
|
|
cyan 00 FF FF |
|
1337
|
|
|
|
|
|
|
darkblue 00 00 8B |
|
1338
|
|
|
|
|
|
|
darkcyan 00 8B 8B |
|
1339
|
|
|
|
|
|
|
darkgoldenrod B8 86 0B |
|
1340
|
|
|
|
|
|
|
darkgray A9 A9 A9 |
|
1341
|
|
|
|
|
|
|
darkgreen 00 64 00 |
|
1342
|
|
|
|
|
|
|
darkkhaki BD B7 6B |
|
1343
|
|
|
|
|
|
|
darkmagenta 8B 00 8B |
|
1344
|
|
|
|
|
|
|
darkolivegreen 55 6B 2F |
|
1345
|
|
|
|
|
|
|
darkorange FF 8C 00 |
|
1346
|
|
|
|
|
|
|
darkorchid 99 32 CC |
|
1347
|
|
|
|
|
|
|
darkred 8B 00 00 |
|
1348
|
|
|
|
|
|
|
darksalmon E9 96 7A |
|
1349
|
|
|
|
|
|
|
darkseagreen 8F BC 8F |
|
1350
|
|
|
|
|
|
|
darkslateblue 48 3D 8B |
|
1351
|
|
|
|
|
|
|
darkslategray 2F 4F 4F |
|
1352
|
|
|
|
|
|
|
darkturquoise 00 CE D1 |
|
1353
|
|
|
|
|
|
|
darkviolet 94 00 D3 |
|
1354
|
|
|
|
|
|
|
deeppink FF 14 100 |
|
1355
|
|
|
|
|
|
|
deepskyblue 00 BF FF |
|
1356
|
|
|
|
|
|
|
dimgray 69 69 69 |
|
1357
|
|
|
|
|
|
|
dodgerblue 1E 90 FF |
|
1358
|
|
|
|
|
|
|
firebrick B2 22 22 |
|
1359
|
|
|
|
|
|
|
floralwhite FF FA F0 |
|
1360
|
|
|
|
|
|
|
forestgreen 22 8B 22 |
|
1361
|
|
|
|
|
|
|
fuchsia FF 00 FF |
|
1362
|
|
|
|
|
|
|
gainsboro DC DC DC |
|
1363
|
|
|
|
|
|
|
ghostwhite F8 F8 FF |
|
1364
|
|
|
|
|
|
|
gold FF D7 00 |
|
1365
|
|
|
|
|
|
|
goldenrod DA A5 20 |
|
1366
|
|
|
|
|
|
|
gray 80 80 80 |
|
1367
|
|
|
|
|
|
|
grey 80 80 80 |
|
1368
|
|
|
|
|
|
|
green 00 80 00 |
|
1369
|
|
|
|
|
|
|
greenyellow AD FF 2F |
|
1370
|
|
|
|
|
|
|
honeydew F0 FF F0 |
|
1371
|
|
|
|
|
|
|
hotpink FF 69 B4 |
|
1372
|
|
|
|
|
|
|
indianred CD 5C 5C |
|
1373
|
|
|
|
|
|
|
indigo 4B 00 82 |
|
1374
|
|
|
|
|
|
|
ivory FF FF F0 |
|
1375
|
|
|
|
|
|
|
khaki F0 E6 8C |
|
1376
|
|
|
|
|
|
|
lavender E6 E6 FA |
|
1377
|
|
|
|
|
|
|
lavenderblush FF F0 F5 |
|
1378
|
|
|
|
|
|
|
lawngreen 7C FC 00 |
|
1379
|
|
|
|
|
|
|
lemonchiffon FF FA CD |
|
1380
|
|
|
|
|
|
|
lightblue AD D8 E6 |
|
1381
|
|
|
|
|
|
|
lightcoral F0 80 80 |
|
1382
|
|
|
|
|
|
|
lightcyan E0 FF FF |
|
1383
|
|
|
|
|
|
|
lightgoldenrodyellow FA FA D2 |
|
1384
|
|
|
|
|
|
|
lightgreen 90 EE 90 |
|
1385
|
|
|
|
|
|
|
lightgrey D3 D3 D3 |
|
1386
|
|
|
|
|
|
|
lightpink FF B6 C1 |
|
1387
|
|
|
|
|
|
|
lightsalmon FF A0 7A |
|
1388
|
|
|
|
|
|
|
lightseagreen 20 B2 AA |
|
1389
|
|
|
|
|
|
|
lightskyblue 87 CE FA |
|
1390
|
|
|
|
|
|
|
lightslategray 77 88 99 |
|
1391
|
|
|
|
|
|
|
lightsteelblue B0 C4 DE |
|
1392
|
|
|
|
|
|
|
lightyellow FF FF E0 |
|
1393
|
|
|
|
|
|
|
lime 00 FF 00 |
|
1394
|
|
|
|
|
|
|
limegreen 32 CD 32 |
|
1395
|
|
|
|
|
|
|
linen FA F0 E6 |
|
1396
|
|
|
|
|
|
|
magenta FF 00 FF |
|
1397
|
|
|
|
|
|
|
maroon 80 00 00 |
|
1398
|
|
|
|
|
|
|
mediumaquamarine 66 CD AA |
|
1399
|
|
|
|
|
|
|
mediumblue 00 00 CD |
|
1400
|
|
|
|
|
|
|
mediumorchid BA 55 D3 |
|
1401
|
|
|
|
|
|
|
mediumpurple 100 70 DB |
|
1402
|
|
|
|
|
|
|
mediumseagreen 3C B3 71 |
|
1403
|
|
|
|
|
|
|
mediumslateblue 7B 68 EE |
|
1404
|
|
|
|
|
|
|
mediumspringgreen 00 FA 9A |
|
1405
|
|
|
|
|
|
|
mediumturquoise 48 D1 CC |
|
1406
|
|
|
|
|
|
|
mediumvioletred C7 15 85 |
|
1407
|
|
|
|
|
|
|
midnightblue 19 19 70 |
|
1408
|
|
|
|
|
|
|
mintcream F5 FF FA |
|
1409
|
|
|
|
|
|
|
mistyrose FF E4 E1 |
|
1410
|
|
|
|
|
|
|
moccasin FF E4 B5 |
|
1411
|
|
|
|
|
|
|
navajowhite FF DE AD |
|
1412
|
|
|
|
|
|
|
navy 00 00 80 |
|
1413
|
|
|
|
|
|
|
oldlace FD F5 E6 |
|
1414
|
|
|
|
|
|
|
olive 80 80 00 |
|
1415
|
|
|
|
|
|
|
olivedrab 6B 8E 23 |
|
1416
|
|
|
|
|
|
|
orange FF A5 00 |
|
1417
|
|
|
|
|
|
|
orangered FF 45 00 |
|
1418
|
|
|
|
|
|
|
orchid DA 70 D6 |
|
1419
|
|
|
|
|
|
|
palegoldenrod EE E8 AA |
|
1420
|
|
|
|
|
|
|
palegreen 98 FB 98 |
|
1421
|
|
|
|
|
|
|
paleturquoise AF EE EE |
|
1422
|
|
|
|
|
|
|
palevioletred DB 70 100 |
|
1423
|
|
|
|
|
|
|
papayawhip FF EF D5 |
|
1424
|
|
|
|
|
|
|
peachpuff FF DA B9 |
|
1425
|
|
|
|
|
|
|
peru CD 85 3F |
|
1426
|
|
|
|
|
|
|
pink FF C0 CB |
|
1427
|
|
|
|
|
|
|
plum DD A0 DD |
|
1428
|
|
|
|
|
|
|
powderblue B0 E0 E6 |
|
1429
|
|
|
|
|
|
|
purple 80 00 80 |
|
1430
|
|
|
|
|
|
|
red FF 00 00 |
|
1431
|
|
|
|
|
|
|
rosybrown BC 8F 8F |
|
1432
|
|
|
|
|
|
|
royalblue 41 69 E1 |
|
1433
|
|
|
|
|
|
|
saddlebrown 8B 45 13 |
|
1434
|
|
|
|
|
|
|
salmon FA 80 72 |
|
1435
|
|
|
|
|
|
|
sandybrown F4 A4 60 |
|
1436
|
|
|
|
|
|
|
seagreen 2E 8B 57 |
|
1437
|
|
|
|
|
|
|
seashell FF F5 EE |
|
1438
|
|
|
|
|
|
|
sienna A0 52 2D |
|
1439
|
|
|
|
|
|
|
silver C0 C0 C0 |
|
1440
|
|
|
|
|
|
|
skyblue 87 CE EB |
|
1441
|
|
|
|
|
|
|
slateblue 6A 5A CD |
|
1442
|
|
|
|
|
|
|
slategray 70 80 90 |
|
1443
|
|
|
|
|
|
|
snow FF FA FA |
|
1444
|
|
|
|
|
|
|
springgreen 00 FF 7F |
|
1445
|
|
|
|
|
|
|
steelblue 46 82 B4 |
|
1446
|
|
|
|
|
|
|
tan D2 B4 8C |
|
1447
|
|
|
|
|
|
|
teal 00 80 80 |
|
1448
|
|
|
|
|
|
|
thistle D8 BF D8 |
|
1449
|
|
|
|
|
|
|
tomato FF 63 47 |
|
1450
|
|
|
|
|
|
|
turquoise 40 E0 D0 |
|
1451
|
|
|
|
|
|
|
violet EE 82 EE |
|
1452
|
|
|
|
|
|
|
wheat F5 DE B3 |
|
1453
|
|
|
|
|
|
|
whitesmoke F5 F5 F5 |
|
1454
|
|
|
|
|
|
|
yellow FF FF 00 |
|
1455
|
|
|
|
|
|
|
yellowgreen 9A CD 32 |
|
1456
|
|
|
|
|
|
|
gradient1 00 ff 00 |
|
1457
|
|
|
|
|
|
|
gradient2 0a ff 00 |
|
1458
|
|
|
|
|
|
|
gradient3 14 ff 00 |
|
1459
|
|
|
|
|
|
|
gradient4 1e ff 00 |
|
1460
|
|
|
|
|
|
|
gradient5 28 ff 00 |
|
1461
|
|
|
|
|
|
|
gradient6 32 ff 00 |
|
1462
|
|
|
|
|
|
|
gradient7 3d ff 00 |
|
1463
|
|
|
|
|
|
|
gradient8 47 ff 00 |
|
1464
|
|
|
|
|
|
|
gradient9 51 ff 00 |
|
1465
|
|
|
|
|
|
|
gradient10 5b ff 00 |
|
1466
|
|
|
|
|
|
|
gradient11 65 ff 00 |
|
1467
|
|
|
|
|
|
|
gradient12 70 ff 00 |
|
1468
|
|
|
|
|
|
|
gradient13 7a ff 00 |
|
1469
|
|
|
|
|
|
|
gradient14 84 ff 00 |
|
1470
|
|
|
|
|
|
|
gradient15 8e ff 00 |
|
1471
|
|
|
|
|
|
|
gradient16 99 ff 00 |
|
1472
|
|
|
|
|
|
|
gradient17 a3 ff 00 |
|
1473
|
|
|
|
|
|
|
gradient18 ad ff 00 |
|
1474
|
|
|
|
|
|
|
gradient19 b7 ff 00 |
|
1475
|
|
|
|
|
|
|
gradient20 c1 ff 00 |
|
1476
|
|
|
|
|
|
|
gradient21 cc ff 00 |
|
1477
|
|
|
|
|
|
|
gradient22 d6 ff 00 |
|
1478
|
|
|
|
|
|
|
gradient23 e0 ff 00 |
|
1479
|
|
|
|
|
|
|
gradient24 ea ff 00 |
|
1480
|
|
|
|
|
|
|
gradient25 f4 ff 00 |
|
1481
|
|
|
|
|
|
|
gradient26 ff ff 00 |
|
1482
|
|
|
|
|
|
|
gradient27 ff f4 00 |
|
1483
|
|
|
|
|
|
|
gradient28 ff ea 00 |
|
1484
|
|
|
|
|
|
|
gradient29 ff e0 00 |
|
1485
|
|
|
|
|
|
|
gradient30 ff d6 00 |
|
1486
|
|
|
|
|
|
|
gradient31 ff cc 00 |
|
1487
|
|
|
|
|
|
|
gradient32 ff c1 00 |
|
1488
|
|
|
|
|
|
|
gradient33 ff b7 00 |
|
1489
|
|
|
|
|
|
|
gradient34 ff ad 00 |
|
1490
|
|
|
|
|
|
|
gradient35 ff a3 00 |
|
1491
|
|
|
|
|
|
|
gradient36 ff 99 00 |
|
1492
|
|
|
|
|
|
|
gradient37 ff 8e 00 |
|
1493
|
|
|
|
|
|
|
gradient38 ff 84 00 |
|
1494
|
|
|
|
|
|
|
gradient39 ff 7a 00 |
|
1495
|
|
|
|
|
|
|
gradient40 ff 70 00 |
|
1496
|
|
|
|
|
|
|
gradient41 ff 65 00 |
|
1497
|
|
|
|
|
|
|
gradient42 ff 5b 00 |
|
1498
|
|
|
|
|
|
|
gradient43 ff 51 00 |
|
1499
|
|
|
|
|
|
|
gradient44 ff 47 00 |
|
1500
|
|
|
|
|
|
|
gradient45 ff 3d 00 |
|
1501
|
|
|
|
|
|
|
gradient46 ff 32 00 |
|
1502
|
|
|
|
|
|
|
gradient47 ff 28 00 |
|
1503
|
|
|
|
|
|
|
gradient48 ff 1e 00 |
|
1504
|
|
|
|
|
|
|
gradient49 ff 14 00 |
|
1505
|
|
|
|
|
|
|
gradient50 ff 0a 00 |
|
1506
|
|
|
|
|
|
|
__END__ |
|
1507
|
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
=head1 NAME |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
Bio::Graphics::Panel - Generate GD images of Bio::Seq objects |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1513
|
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
# This script parses a GenBank or EMBL file named on the command |
|
1515
|
|
|
|
|
|
|
# line and produces a PNG rendering of it. Call it like this: |
|
1516
|
|
|
|
|
|
|
# render.pl my_file.embl | display - |
|
1517
|
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
use strict; |
|
1519
|
|
|
|
|
|
|
use Bio::Graphics; |
|
1520
|
|
|
|
|
|
|
use Bio::SeqIO; |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
my $file = shift or die "provide a sequence file as the argument"; |
|
1523
|
|
|
|
|
|
|
my $io = Bio::SeqIO->new(-file=>$file) or die "could not create Bio::SeqIO"; |
|
1524
|
|
|
|
|
|
|
my $seq = $io->next_seq or die "could not find a sequence in the file"; |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
my @features = $seq->all_SeqFeatures; |
|
1527
|
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
# sort features by their primary tags |
|
1529
|
|
|
|
|
|
|
my %sorted_features; |
|
1530
|
|
|
|
|
|
|
for my $f (@features) { |
|
1531
|
|
|
|
|
|
|
my $tag = $f->primary_tag; |
|
1532
|
|
|
|
|
|
|
push @{$sorted_features{$tag}},$f; |
|
1533
|
|
|
|
|
|
|
} |
|
1534
|
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
my $panel = Bio::Graphics::Panel->new( |
|
1536
|
|
|
|
|
|
|
-length => $seq->length, |
|
1537
|
|
|
|
|
|
|
-key_style => 'between', |
|
1538
|
|
|
|
|
|
|
-width => 800, |
|
1539
|
|
|
|
|
|
|
-pad_left => 10, |
|
1540
|
|
|
|
|
|
|
-pad_right => 10, |
|
1541
|
|
|
|
|
|
|
); |
|
1542
|
|
|
|
|
|
|
$panel->add_track( arrow => Bio::SeqFeature::Generic->new(-start=>1, |
|
1543
|
|
|
|
|
|
|
-end=>$seq->length), |
|
1544
|
|
|
|
|
|
|
-bump => 0, |
|
1545
|
|
|
|
|
|
|
-double=>1, |
|
1546
|
|
|
|
|
|
|
-tick => 2); |
|
1547
|
|
|
|
|
|
|
$panel->add_track(generic => Bio::SeqFeature::Generic->new(-start=>1, |
|
1548
|
|
|
|
|
|
|
-end=>$seq->length), |
|
1549
|
|
|
|
|
|
|
-glyph => 'generic', |
|
1550
|
|
|
|
|
|
|
-bgcolor => 'blue', |
|
1551
|
|
|
|
|
|
|
-label => 1, |
|
1552
|
|
|
|
|
|
|
); |
|
1553
|
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
# general case |
|
1555
|
|
|
|
|
|
|
my @colors = qw(cyan orange blue purple green chartreuse magenta yellow aqua); |
|
1556
|
|
|
|
|
|
|
my $idx = 0; |
|
1557
|
|
|
|
|
|
|
for my $tag (sort keys %sorted_features) { |
|
1558
|
|
|
|
|
|
|
my $features = $sorted_features{$tag}; |
|
1559
|
|
|
|
|
|
|
$panel->add_track($features, |
|
1560
|
|
|
|
|
|
|
-glyph => 'generic', |
|
1561
|
|
|
|
|
|
|
-bgcolor => $colors[$idx++ % @colors], |
|
1562
|
|
|
|
|
|
|
-fgcolor => 'black', |
|
1563
|
|
|
|
|
|
|
-font2color => 'red', |
|
1564
|
|
|
|
|
|
|
-key => "${tag}s", |
|
1565
|
|
|
|
|
|
|
-bump => +1, |
|
1566
|
|
|
|
|
|
|
-height => 8, |
|
1567
|
|
|
|
|
|
|
-label => 1, |
|
1568
|
|
|
|
|
|
|
-description => 1, |
|
1569
|
|
|
|
|
|
|
); |
|
1570
|
|
|
|
|
|
|
} |
|
1571
|
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
print $panel->png; |
|
1573
|
|
|
|
|
|
|
$panel->finished; |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
exit 0; |
|
1576
|
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1578
|
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
The Bio::Graphics::Panel class provides drawing and formatting |
|
1580
|
|
|
|
|
|
|
services for any object that implements the Bio::SeqFeatureI |
|
1581
|
|
|
|
|
|
|
interface, including Ace::Sequence::Feature and Das::Segment::Feature |
|
1582
|
|
|
|
|
|
|
objects. It can be used to draw sequence annotations, physical |
|
1583
|
|
|
|
|
|
|
(contig) maps, or any other type of map in which a set of discrete |
|
1584
|
|
|
|
|
|
|
ranges need to be laid out on the number line. |
|
1585
|
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
The module supports a drawing style in which each type of feature |
|
1587
|
|
|
|
|
|
|
occupies a discrete "track" that spans the width of the display. Each |
|
1588
|
|
|
|
|
|
|
track will have its own distinctive "glyph", a configurable graphical |
|
1589
|
|
|
|
|
|
|
representation of the feature. |
|
1590
|
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
The module also supports a more flexible style in which several |
|
1592
|
|
|
|
|
|
|
different feature types and their associated glyphs can occupy the |
|
1593
|
|
|
|
|
|
|
same track. The choice of glyph is under run-time control. |
|
1594
|
|
|
|
|
|
|
|
|
1595
|
|
|
|
|
|
|
Semantic zooming (for instance, changing the type of glyph depending |
|
1596
|
|
|
|
|
|
|
on the density of features) is supported by a callback system for |
|
1597
|
|
|
|
|
|
|
configuration variables. The module has built-in support for Bio::Das |
|
1598
|
|
|
|
|
|
|
stylesheets, and stylesheet-driven configuration can be intermixed |
|
1599
|
|
|
|
|
|
|
with semantic zooming, if desired. |
|
1600
|
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
You can add a key to the generated image using either of two key |
|
1602
|
|
|
|
|
|
|
styles. One style places the key captions at the top of each track. |
|
1603
|
|
|
|
|
|
|
The other style generates a graphical key at the bottom of the image. |
|
1604
|
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
Note that this module depends on GD. The optional SVG output depends |
|
1606
|
|
|
|
|
|
|
on GD::SVG and SVG. |
|
1607
|
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
The installed script glyph_help.pl provides quick help on glyphs and |
|
1609
|
|
|
|
|
|
|
their options. |
|
1610
|
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
=head1 METHODS |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
This section describes the class and object methods for |
|
1614
|
|
|
|
|
|
|
Bio::Graphics::Panel. |
|
1615
|
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
Typically you will begin by creating a new Bio::Graphics::Panel |
|
1617
|
|
|
|
|
|
|
object, passing it the desired width of the image to generate and an |
|
1618
|
|
|
|
|
|
|
origin and length describing the coordinate range to display. The |
|
1619
|
|
|
|
|
|
|
Bio::Graphics::Panel-E<gt>new() method has many configuration variables |
|
1620
|
|
|
|
|
|
|
that allow you to control the appearance of the image. |
|
1621
|
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
You will then call add_track() one or more times to add sets of |
|
1623
|
|
|
|
|
|
|
related features to the picture. add_track() places a new horizontal |
|
1624
|
|
|
|
|
|
|
track on the image, and is likewise highly configurable. When you |
|
1625
|
|
|
|
|
|
|
have added all the features you desire, you may call png() to convert |
|
1626
|
|
|
|
|
|
|
the image into a PNG-format image, or boxes() to return coordinate |
|
1627
|
|
|
|
|
|
|
information that can be used to create an imagemap. |
|
1628
|
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
=head2 CONSTRUCTORS |
|
1630
|
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
new() is the constructor for Bio::Graphics::Panel: |
|
1632
|
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=over 4 |
|
1634
|
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
=item $panel = Bio::Graphics::Panel-E<gt>new(@options) |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
The new() method creates a new panel object. The options are |
|
1638
|
|
|
|
|
|
|
a set of tag/value pairs as follows: |
|
1639
|
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
Option Value Default |
|
1641
|
|
|
|
|
|
|
------ ----- ------- |
|
1642
|
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
-offset Base pair to place at extreme left none |
|
1644
|
|
|
|
|
|
|
of image, in zero-based coordinates |
|
1645
|
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
-length Length of sequence segment, in bp none |
|
1647
|
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
-start Start of range, in 1-based none |
|
1649
|
|
|
|
|
|
|
coordinates. |
|
1650
|
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
-stop Stop of range, in 1-based none |
|
1652
|
|
|
|
|
|
|
coordinates. |
|
1653
|
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
-end Same as -stop. |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
-segment A Bio::SeqI or Das::Segment none |
|
1657
|
|
|
|
|
|
|
object, used to derive sequence |
|
1658
|
|
|
|
|
|
|
range if not otherwise specified. |
|
1659
|
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
-width Desired width of image, in pixels 600 |
|
1661
|
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
-spacing Spacing between tracks, in pixels 5 |
|
1663
|
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
-pad_top Additional whitespace between top 0 |
|
1665
|
|
|
|
|
|
|
of image and contents, in pixels |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
-pad_bottom Additional whitespace between top 0 |
|
1668
|
|
|
|
|
|
|
of image and bottom, in pixels |
|
1669
|
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
-pad_left Additional whitespace between left 0 |
|
1671
|
|
|
|
|
|
|
of image and contents, in pixels |
|
1672
|
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
-pad_right Additional whitespace between right 0 |
|
1674
|
|
|
|
|
|
|
of image and bottom, in pixels |
|
1675
|
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
-bgcolor Background color for the panel as a white |
|
1677
|
|
|
|
|
|
|
whole |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
-key_color Background color for the key printed wheat |
|
1680
|
|
|
|
|
|
|
at bottom of panel (if any) |
|
1681
|
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
-key_spacing Spacing between key glyphs in the 10 |
|
1683
|
|
|
|
|
|
|
key printed at bottom of panel |
|
1684
|
|
|
|
|
|
|
(if any) |
|
1685
|
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
-key_font Font to use in printed key gdMediumBoldFont |
|
1687
|
|
|
|
|
|
|
captions. |
|
1688
|
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
-key_style Whether to print key at bottom of none |
|
1690
|
|
|
|
|
|
|
panel ("bottom"), between each |
|
1691
|
|
|
|
|
|
|
track ("between"), to the left of |
|
1692
|
|
|
|
|
|
|
each track ("left"), to the right |
|
1693
|
|
|
|
|
|
|
of each track ("right") or |
|
1694
|
|
|
|
|
|
|
not at all ("none"). |
|
1695
|
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
-add_category_labels false |
|
1697
|
|
|
|
|
|
|
Whether to add the "category" to |
|
1698
|
|
|
|
|
|
|
the track key. The category is |
|
1699
|
|
|
|
|
|
|
an optional argument that can |
|
1700
|
|
|
|
|
|
|
be attached to each track. If |
|
1701
|
|
|
|
|
|
|
a category is present, and this |
|
1702
|
|
|
|
|
|
|
option is true, then the category |
|
1703
|
|
|
|
|
|
|
will be added to the track label |
|
1704
|
|
|
|
|
|
|
in parentheses. For example, if |
|
1705
|
|
|
|
|
|
|
-key is "Protein matches" and |
|
1706
|
|
|
|
|
|
|
-category is "vertebrate", then |
|
1707
|
|
|
|
|
|
|
the track will be labeled |
|
1708
|
|
|
|
|
|
|
"Protein matches (vertebrate)". |
|
1709
|
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
-auto_pad If "left" or "right" keys are in use true |
|
1711
|
|
|
|
|
|
|
then setting auto_pad to a true value |
|
1712
|
|
|
|
|
|
|
will allow the panel to adjust its |
|
1713
|
|
|
|
|
|
|
width in order to accomodate the |
|
1714
|
|
|
|
|
|
|
length of the longest key. |
|
1715
|
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
-empty_tracks What to do when a track is empty. suppress |
|
1717
|
|
|
|
|
|
|
Options are to suppress the track |
|
1718
|
|
|
|
|
|
|
completely ("suppress"), to show just |
|
1719
|
|
|
|
|
|
|
the key in "between" mode ("key"), |
|
1720
|
|
|
|
|
|
|
to draw a thin grey line ("line"), |
|
1721
|
|
|
|
|
|
|
or to draw a dashed line ("dashed"). |
|
1722
|
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
-flip flip the drawing coordinates left false |
|
1724
|
|
|
|
|
|
|
to right, so that lower coordinates |
|
1725
|
|
|
|
|
|
|
are to the right. This can be |
|
1726
|
|
|
|
|
|
|
useful for drawing (-) strand |
|
1727
|
|
|
|
|
|
|
features. |
|
1728
|
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
-all_callbacks Whether to invoke callbacks on false |
|
1730
|
|
|
|
|
|
|
the automatic "track" and "group" |
|
1731
|
|
|
|
|
|
|
glyphs. |
|
1732
|
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
-grid Whether to draw a vertical grid in false |
|
1734
|
|
|
|
|
|
|
the background. Pass a scalar true |
|
1735
|
|
|
|
|
|
|
value to have a grid drawn at |
|
1736
|
|
|
|
|
|
|
regular intervals (corresponding |
|
1737
|
|
|
|
|
|
|
to the minor ticks of the arrow |
|
1738
|
|
|
|
|
|
|
glyph). Pass an array reference |
|
1739
|
|
|
|
|
|
|
to draw the grid at the specified |
|
1740
|
|
|
|
|
|
|
positions. |
|
1741
|
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
-gridcolor Color of the grid lightcyan |
|
1743
|
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
-gridmajorcolor Color of grid major intervals cyan |
|
1745
|
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
-extend_grid If true, extend the grid into the pad false |
|
1747
|
|
|
|
|
|
|
top and pad_bottom regions |
|
1748
|
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
-background An image or callback to use for the none |
|
1750
|
|
|
|
|
|
|
background of the image. Will be |
|
1751
|
|
|
|
|
|
|
invoked I<before> drawing the grid. |
|
1752
|
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
-postgrid An image or callback to use for the none |
|
1754
|
|
|
|
|
|
|
background of the image. Will be |
|
1755
|
|
|
|
|
|
|
invoked I<after> drawing the grid. |
|
1756
|
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
-truecolor Create a truecolor (24-bit) image. false |
|
1758
|
|
|
|
|
|
|
Useful when working with the |
|
1759
|
|
|
|
|
|
|
"image" glyph. |
|
1760
|
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
-truetype Render text using scaleable vector false |
|
1762
|
|
|
|
|
|
|
fonts rather than bitmap fonts. |
|
1763
|
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
-image_class To create output in scalable vector |
|
1765
|
|
|
|
|
|
|
graphics (SVG), optionally pass the image |
|
1766
|
|
|
|
|
|
|
class parameter 'GD::SVG'. Defaults to |
|
1767
|
|
|
|
|
|
|
using vanilla GD. See the corresponding |
|
1768
|
|
|
|
|
|
|
image_class() method below for details. |
|
1769
|
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
-link, -title, -target |
|
1771
|
|
|
|
|
|
|
These options are used when creating imagemaps |
|
1772
|
|
|
|
|
|
|
for display on the web. See L</"Creating Imagemaps">. |
|
1773
|
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
Typically you will pass new() an object that implements the |
|
1776
|
|
|
|
|
|
|
Bio::RangeI interface, providing a length() method, from which the |
|
1777
|
|
|
|
|
|
|
panel will derive its scale. |
|
1778
|
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
$panel = Bio::Graphics::Panel->new(-segment => $sequence, |
|
1780
|
|
|
|
|
|
|
-width => 800); |
|
1781
|
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
new() will return undef in case of an error. |
|
1783
|
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
Note that if you use the "left" or "right" key styles, you are |
|
1785
|
|
|
|
|
|
|
responsible for allocating sufficient -pad_left or -pad_right room for |
|
1786
|
|
|
|
|
|
|
the labels to appear. The necessary width is the number of characters |
|
1787
|
|
|
|
|
|
|
in the longest key times the font width (gdMediumBoldFont by default) |
|
1788
|
|
|
|
|
|
|
plus 3 pixels of internal padding. The simplest way to calculate this |
|
1789
|
|
|
|
|
|
|
is to iterate over the possible track labels, find the largest one, |
|
1790
|
|
|
|
|
|
|
and then to compute its width using the formula: |
|
1791
|
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
$width = gdMediumBoldFont->width * length($longest_key) +3; |
|
1793
|
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
In order to obtain scalable vector graphics (SVG) output, you should |
|
1795
|
|
|
|
|
|
|
pass new() the -image_class=E<gt>'GD::SVG' parameter. This will cause |
|
1796
|
|
|
|
|
|
|
Bio::Graphics::Panel to load the optional GD::SVG module. See the gd() |
|
1797
|
|
|
|
|
|
|
and svg() methods below for additional information. |
|
1798
|
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
You can tile an image onto the panel either before or after it draws |
|
1800
|
|
|
|
|
|
|
the grid. Simply provide the filename of the image in the -background |
|
1801
|
|
|
|
|
|
|
or -postgrid options. The image file must be of type PNG, JPEG, XBM or |
|
1802
|
|
|
|
|
|
|
GIF and have a filename ending in .png, .jpg, .jpeg, .xbm or .gif. |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
You can also pass a code ref for the -background or -postgrid option, |
|
1805
|
|
|
|
|
|
|
in which case the subroutine will be invoked at the appropriate time |
|
1806
|
|
|
|
|
|
|
with the GD::Image object and the Panel object as its two arguments. |
|
1807
|
|
|
|
|
|
|
You can then use the panel methods to map base pair coordinates into |
|
1808
|
|
|
|
|
|
|
pixel coordinates and do some custom drawing. For example, this code |
|
1809
|
|
|
|
|
|
|
fragment will draw a gray rectangle between bases 500 and 600 to |
|
1810
|
|
|
|
|
|
|
indicate a "gap" in the sequence: |
|
1811
|
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
my $panel = Bio::Graphics::Panel->new(-segment=>$segment, |
|
1813
|
|
|
|
|
|
|
-grid=>1, |
|
1814
|
|
|
|
|
|
|
-width=>600, |
|
1815
|
|
|
|
|
|
|
-postgrid=> \&draw_gap); |
|
1816
|
|
|
|
|
|
|
sub gap_it { |
|
1817
|
|
|
|
|
|
|
my $gd = shift; |
|
1818
|
|
|
|
|
|
|
my $panel = shift; |
|
1819
|
|
|
|
|
|
|
my ($gap_start,$gap_end) = $panel->location2pixel(500,600); |
|
1820
|
|
|
|
|
|
|
my $top = $panel->top; |
|
1821
|
|
|
|
|
|
|
my $bottom = $panel->bottom; |
|
1822
|
|
|
|
|
|
|
my $gray = $panel->translate_color('gray'); |
|
1823
|
|
|
|
|
|
|
$gd->filledRectangle($gap_start,$top,$gap_end,$bottom,$gray); |
|
1824
|
|
|
|
|
|
|
} |
|
1825
|
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
The B<-truetype> argument will activate rendering of labels using |
|
1827
|
|
|
|
|
|
|
antialiased vector fonts. If it is a value of "1", then labels will be |
|
1828
|
|
|
|
|
|
|
rendered using the default font (Verdana). Pass a font name to use |
|
1829
|
|
|
|
|
|
|
this font as the default: |
|
1830
|
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
-truetype => 'Times New Roman', |
|
1832
|
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
Note that you can change the font on a track-by-track basis simply by |
|
1834
|
|
|
|
|
|
|
using a truetype font name as add_track()'s -font argument. |
|
1835
|
|
|
|
|
|
|
|
|
1836
|
|
|
|
|
|
|
=back |
|
1837
|
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
=head2 OBJECT METHODS |
|
1839
|
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
=over 4 |
|
1841
|
|
|
|
|
|
|
|
|
1842
|
|
|
|
|
|
|
=item $track = $panel-E<gt>add_track($glyph,$features,@options) |
|
1843
|
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
The add_track() method adds a new track to the image. |
|
1845
|
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
Tracks are horizontal bands which span the entire width of the panel. |
|
1847
|
|
|
|
|
|
|
Each track contains a number of graphical elements called "glyphs", |
|
1848
|
|
|
|
|
|
|
corresponding to a sequence feature. |
|
1849
|
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
There are a large number of glyph types. By default, each track will |
|
1851
|
|
|
|
|
|
|
be homogeneous on a single glyph type, but you can mix several glyph |
|
1852
|
|
|
|
|
|
|
types on the same track by providing a code reference to the -glyph |
|
1853
|
|
|
|
|
|
|
argument. Other options passed to add_track() control the color and |
|
1854
|
|
|
|
|
|
|
size of the glyphs, whether they are allowed to overlap, and other |
|
1855
|
|
|
|
|
|
|
formatting attributes. The height of a track is determined from its |
|
1856
|
|
|
|
|
|
|
contents and cannot be directly influenced. |
|
1857
|
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
The first two arguments are the glyph name and an array reference |
|
1859
|
|
|
|
|
|
|
containing the list of features to display. The order of the |
|
1860
|
|
|
|
|
|
|
arguments is irrelevant, allowing either of these idioms: |
|
1861
|
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
$panel->add_track(arrow => \@features); |
|
1863
|
|
|
|
|
|
|
$panel->add_track(\@features => 'arrow'); |
|
1864
|
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
The glyph name indicates how each feature is to be rendered. A |
|
1866
|
|
|
|
|
|
|
variety of glyphs are available, and the number is growing. You may |
|
1867
|
|
|
|
|
|
|
omit the glyph name entirely by providing a B<-glyph> argument among |
|
1868
|
|
|
|
|
|
|
@options, as described below. |
|
1869
|
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
Currently, the following glyphs are available: |
|
1871
|
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
Name Description |
|
1873
|
|
|
|
|
|
|
---- ----------- |
|
1874
|
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
anchored_arrow |
|
1876
|
|
|
|
|
|
|
a span with vertical bases |---------|. If one or |
|
1877
|
|
|
|
|
|
|
the other end of the feature is off-screen, the base |
|
1878
|
|
|
|
|
|
|
will be replaced by an arrow. |
|
1879
|
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
arrow An arrow; can be unidirectional or bidirectional. |
|
1881
|
|
|
|
|
|
|
It is also capable of displaying a scale with |
|
1882
|
|
|
|
|
|
|
major and minor tickmarks, and can be oriented |
|
1883
|
|
|
|
|
|
|
horizontally or vertically. |
|
1884
|
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
box A filled rectangle, nondirectional. Subfeatures are ignored. |
|
1886
|
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
cds Draws CDS features, using the phase information to |
|
1888
|
|
|
|
|
|
|
show the reading frame usage. At high magnifications |
|
1889
|
|
|
|
|
|
|
draws the protein translation. |
|
1890
|
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
crossbox A box with a big "X" inside it. |
|
1892
|
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
diamond A diamond, useful for point features like SNPs. |
|
1894
|
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
dna At high magnification draws the DNA sequence. At |
|
1896
|
|
|
|
|
|
|
low magnifications draws the GC content. |
|
1897
|
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
dot A circle, useful for point features like SNPs, stop |
|
1899
|
|
|
|
|
|
|
codons, or promoter elements. |
|
1900
|
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
ellipse An oval. |
|
1902
|
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
extending_arrow |
|
1904
|
|
|
|
|
|
|
Similar to arrow, but a dotted line indicates when the |
|
1905
|
|
|
|
|
|
|
feature extends beyond the end of the canvas. |
|
1906
|
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
generic A filled rectangle, nondirectional. Subfeatures are shown |
|
1908
|
|
|
|
|
|
|
as rectangles that are not connected together. |
|
1909
|
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
graded_segments |
|
1911
|
|
|
|
|
|
|
Similar to segments, but the intensity of the color |
|
1912
|
|
|
|
|
|
|
is proportional to the score of the feature. This |
|
1913
|
|
|
|
|
|
|
is used for showing the intensity of blast hits or |
|
1914
|
|
|
|
|
|
|
other alignment features. |
|
1915
|
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
group A group of related features connected by a dashed line. |
|
1917
|
|
|
|
|
|
|
This is used internally by Panel. |
|
1918
|
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
image A pixmap image that will be layered on top of the graphic. |
|
1920
|
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
heterogeneous_segments |
|
1922
|
|
|
|
|
|
|
Like segments, but you can use the source field of the feature |
|
1923
|
|
|
|
|
|
|
to change the color of each segment. |
|
1924
|
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
line A simple line. |
|
1926
|
|
|
|
|
|
|
|
|
1927
|
|
|
|
|
|
|
pinsertion A triangle designed to look like an insertion location |
|
1928
|
|
|
|
|
|
|
(e.g. a transposon insertion). |
|
1929
|
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
processed_transcript multi-purpose representation of a spliced mRNA, including |
|
1931
|
|
|
|
|
|
|
positions of UTRs |
|
1932
|
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
primers Two inward pointing arrows connected by a line. |
|
1934
|
|
|
|
|
|
|
Used for STSs. |
|
1935
|
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
redgreen_box A box that changes from green->yellow->red as the score |
|
1937
|
|
|
|
|
|
|
of the feature increases from 0.0 to 1.0. Useful for |
|
1938
|
|
|
|
|
|
|
representing microarray results. |
|
1939
|
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
rndrect A round-cornered rectangle. |
|
1941
|
|
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
segments A set of filled rectangles connected by solid lines. |
|
1943
|
|
|
|
|
|
|
Used for interrupted features, such as gapped |
|
1944
|
|
|
|
|
|
|
alignments. |
|
1945
|
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
ruler_arrow An arrow with major and minor tick marks and interval |
|
1947
|
|
|
|
|
|
|
labels. |
|
1948
|
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
toomany Tries to show many features as a cloud. Not very successful. |
|
1950
|
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
track A group of related features not connected by a line. |
|
1952
|
|
|
|
|
|
|
This is used internally by Panel. |
|
1953
|
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
transcript Similar to segments, but the connecting line is |
|
1955
|
|
|
|
|
|
|
a "hat" shape, and the direction of transcription |
|
1956
|
|
|
|
|
|
|
is indicated by a small arrow. |
|
1957
|
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
transcript2 Similar to transcript, but the direction of |
|
1959
|
|
|
|
|
|
|
transcription is indicated by a terminal exon |
|
1960
|
|
|
|
|
|
|
in the shape of an arrow. |
|
1961
|
|
|
|
|
|
|
|
|
1962
|
|
|
|
|
|
|
translation 1, 2 and 3-frame translations. At low magnifications, |
|
1963
|
|
|
|
|
|
|
can be configured to show start and stop codon locations. |
|
1964
|
|
|
|
|
|
|
At high magnifications, shows the multi-frame protein |
|
1965
|
|
|
|
|
|
|
translation. |
|
1966
|
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
triangle A triangle whose width and orientation can be altered. |
|
1968
|
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
xyplot Histograms and other graphs plotted against the genome. |
|
1970
|
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
stackedplot A column plot showing multiple data series across multiple categories. |
|
1972
|
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
ternary_plot Ternary (triangle) plots. |
|
1974
|
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
whiskerplot Box and whisker plot for statistical data |
|
1976
|
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
If the glyph name is omitted from add_track(), the "generic" glyph |
|
1978
|
|
|
|
|
|
|
will be used by default. To get more information about a glyph, run |
|
1979
|
|
|
|
|
|
|
perldoc on "Bio::Graphics::Glyph::glyphname", replacing "glyphname" |
|
1980
|
|
|
|
|
|
|
with the name of the glyph you are interested in. |
|
1981
|
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
The "box" glyph is optimized for single features with no |
|
1983
|
|
|
|
|
|
|
subfeatures. If you are drawing such a feature, using "box" will be |
|
1984
|
|
|
|
|
|
|
noticeably faster than "generic." |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
The @options array is a list of name/value pairs that control the |
|
1987
|
|
|
|
|
|
|
attributes of the track. Some options are interpretered directly by |
|
1988
|
|
|
|
|
|
|
the track. Others are passed down to the individual glyphs (see |
|
1989
|
|
|
|
|
|
|
L<"GLYPH OPTIONS">). The following options are track-specific: |
|
1990
|
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
Option Description Default |
|
1992
|
|
|
|
|
|
|
------ ----------- ------- |
|
1993
|
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
-tkcolor Track color white |
|
1995
|
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
-glyph Glyph class to use. "generic" |
|
1997
|
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
-color_series Dynamically choose false |
|
1999
|
|
|
|
|
|
|
bgcolor. |
|
2000
|
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
-stylesheet Bio::Das::Stylesheet to none |
|
2002
|
|
|
|
|
|
|
use to generate glyph |
|
2003
|
|
|
|
|
|
|
classes and options. |
|
2004
|
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
B<-tkcolor> controls the background color of the track as a whole. |
|
2006
|
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
B<-glyph> controls the glyph type. If present, it supersedes the |
|
2008
|
|
|
|
|
|
|
glyph name given in the first or second argument to add_track(). The |
|
2009
|
|
|
|
|
|
|
value of B<-glyph> may be a constant string, a hash reference, or a |
|
2010
|
|
|
|
|
|
|
code reference. In the case of a constant string, that string will be |
|
2011
|
|
|
|
|
|
|
used as the class name for all generated glyphs. If a hash reference |
|
2012
|
|
|
|
|
|
|
is passed, then the feature's primary_tag() will be used as the key to |
|
2013
|
|
|
|
|
|
|
the hash, and the value, if any, used to generate the glyph type. If |
|
2014
|
|
|
|
|
|
|
a code reference is passed, then this callback will be passed |
|
2015
|
|
|
|
|
|
|
arguments consisting of the feature and the panel object. The |
|
2016
|
|
|
|
|
|
|
callback is expected to examine the feature and return a glyph name as |
|
2017
|
|
|
|
|
|
|
its single result. |
|
2018
|
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
Example: |
|
2020
|
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
$panel->add_track(\@exons, |
|
2022
|
|
|
|
|
|
|
-glyph => sub { my ($feature,$panel) = @_; |
|
2023
|
|
|
|
|
|
|
$feature->source_tag eq 'curated' |
|
2024
|
|
|
|
|
|
|
? 'ellipse' : 'box'; } |
|
2025
|
|
|
|
|
|
|
); |
|
2026
|
|
|
|
|
|
|
|
|
2027
|
|
|
|
|
|
|
The B<-stylesheet> argument is used to pass a Bio::Das stylesheet |
|
2028
|
|
|
|
|
|
|
object to the panel. This stylesheet will be called to determine both |
|
2029
|
|
|
|
|
|
|
the glyph and the glyph options. If both a stylesheet and direct |
|
2030
|
|
|
|
|
|
|
options are provided, the latter take precedence. |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
The B<-color_series> argument causes the track to ignore the -bgcolor |
|
2033
|
|
|
|
|
|
|
setting and instead to assign glyphs a series of contrasting |
|
2034
|
|
|
|
|
|
|
colors. This is usually used in combination with -bump=>'overlap' in |
|
2035
|
|
|
|
|
|
|
order to create overlapping features. A true value activates the color |
|
2036
|
|
|
|
|
|
|
series. You may adjust the default color series using the |
|
2037
|
|
|
|
|
|
|
B<-color_cycle> option, which is either a reference to an array of |
|
2038
|
|
|
|
|
|
|
Bio::Graphics color values, or a space-delimited string of color |
|
2039
|
|
|
|
|
|
|
names/value. |
|
2040
|
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
If successful, add_track() returns an Bio::Graphics::Glyph object. |
|
2042
|
|
|
|
|
|
|
You can use this object to add additional features or to control the |
|
2043
|
|
|
|
|
|
|
appearance of the track with greater detail, or just ignore it. |
|
2044
|
|
|
|
|
|
|
Tracks are added in order from the top of the image to the bottom. To |
|
2045
|
|
|
|
|
|
|
add tracks to the top of the image, use unshift_track(). |
|
2046
|
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
B<Adding groups of features:> It is not uncommon to add a group of |
|
2048
|
|
|
|
|
|
|
features which are logically connected, such as the 5' and 3' ends of |
|
2049
|
|
|
|
|
|
|
EST reads. To group features into sets that remain on the same |
|
2050
|
|
|
|
|
|
|
horizontal position and bump together, pass the sets as an anonymous |
|
2051
|
|
|
|
|
|
|
array. For example: |
|
2052
|
|
|
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
$panel->add_track(segments => [[$abc_5,$abc_3], |
|
2054
|
|
|
|
|
|
|
[$xxx_5,$xxx_3], |
|
2055
|
|
|
|
|
|
|
[$yyy_5,$yyy_3]] |
|
2056
|
|
|
|
|
|
|
); |
|
2057
|
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
Typical usage is: |
|
2059
|
|
|
|
|
|
|
|
|
2060
|
|
|
|
|
|
|
$panel->add_track( transcript => \@genes, |
|
2061
|
|
|
|
|
|
|
-fillcolor => 'green', |
|
2062
|
|
|
|
|
|
|
-fgcolor => 'black', |
|
2063
|
|
|
|
|
|
|
-bump => +1, |
|
2064
|
|
|
|
|
|
|
-height => 10, |
|
2065
|
|
|
|
|
|
|
-label => 1); |
|
2066
|
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
The track object is simply a specialized type of glyph. See |
|
2068
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph> for a description of the methods that it |
|
2069
|
|
|
|
|
|
|
supports. |
|
2070
|
|
|
|
|
|
|
|
|
2071
|
|
|
|
|
|
|
=item $track = unshift_track($glyph,$features,@options) |
|
2072
|
|
|
|
|
|
|
|
|
2073
|
|
|
|
|
|
|
unshift_track() works like add_track(), except that the new track is |
|
2074
|
|
|
|
|
|
|
added to the top of the image rather than the bottom. |
|
2075
|
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
=item $track = $panel-E<gt>insert_track($position,$glyph,$features,@options) |
|
2077
|
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
This works like add_track(), but the track is inserted into the |
|
2079
|
|
|
|
|
|
|
indicated position. The track will be inserted B<before> the |
|
2080
|
|
|
|
|
|
|
indicated position; thus specify a track of 0 to insert the new track |
|
2081
|
|
|
|
|
|
|
at the beginning. |
|
2082
|
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
=item $gd = $panel-E<gt>gd([$gd]) |
|
2084
|
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
The gd() method lays out the image and returns a GD::Image object |
|
2086
|
|
|
|
|
|
|
containing it. You may then call the GD::Image object's png() or |
|
2087
|
|
|
|
|
|
|
jpeg() methods to get the image data. |
|
2088
|
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
Optionally, you may pass gd() a preexisting GD::Image object that you |
|
2090
|
|
|
|
|
|
|
wish to draw on top of. If you do so, you should call the width() and |
|
2091
|
|
|
|
|
|
|
height() methods first to ensure that the image has sufficient |
|
2092
|
|
|
|
|
|
|
dimensions. |
|
2093
|
|
|
|
|
|
|
|
|
2094
|
|
|
|
|
|
|
If you passed new() the -image_class=E<gt>'GD::SVG' parameter, the gd() method |
|
2095
|
|
|
|
|
|
|
returns a GD::SVG::Image object. This object overrides GD::Image |
|
2096
|
|
|
|
|
|
|
methods in order to generate SVG output. It behaves exactly as |
|
2097
|
|
|
|
|
|
|
described for GD::Image objects with one exception: it implements and |
|
2098
|
|
|
|
|
|
|
svg() method instead of the png() or jpeg() methods. Currently there |
|
2099
|
|
|
|
|
|
|
is no direct access to underlying SVG calls but this is subject to |
|
2100
|
|
|
|
|
|
|
change in the future. |
|
2101
|
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
=item $png = $panel-E<gt>png |
|
2103
|
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
The png() method returns the image as a PNG-format drawing, without |
|
2105
|
|
|
|
|
|
|
the intermediate step of returning a GD::Image object. |
|
2106
|
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
=item $svg = $panel-E<gt>svg |
|
2108
|
|
|
|
|
|
|
|
|
2109
|
|
|
|
|
|
|
The svg() method returns the image in an XML-ified SVG format. |
|
2110
|
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
=item $panel-E<gt>finished |
|
2112
|
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
Bio::Graphics creates memory cycles. When you are finished with the |
|
2114
|
|
|
|
|
|
|
panel, you should call its finished() method. Otherwise you will have |
|
2115
|
|
|
|
|
|
|
memory leaks. This is only an issue if you're going to create several |
|
2116
|
|
|
|
|
|
|
panels in a single program. |
|
2117
|
|
|
|
|
|
|
|
|
2118
|
|
|
|
|
|
|
=item $image_class = $panel-E<gt>image_class |
|
2119
|
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
The image_class() method returns the current drawing package being |
|
2121
|
|
|
|
|
|
|
used, currently one of GD or GD::SVG. This is primarily used |
|
2122
|
|
|
|
|
|
|
internally to ensure that calls to GD's exported methods are called in |
|
2123
|
|
|
|
|
|
|
an object-oriented manner to avoid compile time undefined string |
|
2124
|
|
|
|
|
|
|
errors. This is usually not needed for external use. |
|
2125
|
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
=item $image_package = $panel-E<gt>image_package |
|
2127
|
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
This accessor method, like image_class() above is provided as a |
|
2129
|
|
|
|
|
|
|
convenience. It returns the current image package in use, currently |
|
2130
|
|
|
|
|
|
|
one of GD::Image or GD::SVG::Image. This is not normally used |
|
2131
|
|
|
|
|
|
|
externally. |
|
2132
|
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
=item $polygon_package = $panel-E<gt>polygon_package |
|
2134
|
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
This accessor method, like image_package() above is provided as a |
|
2136
|
|
|
|
|
|
|
convenience. It returns the current polygon package in use, currently |
|
2137
|
|
|
|
|
|
|
one of GD::Polygon or GD::SVG::Polygon. This is not normally used |
|
2138
|
|
|
|
|
|
|
externally except in the design of glyphs. |
|
2139
|
|
|
|
|
|
|
|
|
2140
|
|
|
|
|
|
|
=item $boxes = $panel-E<gt>boxes |
|
2141
|
|
|
|
|
|
|
|
|
2142
|
|
|
|
|
|
|
=item @boxes = $panel-E<gt>boxes |
|
2143
|
|
|
|
|
|
|
|
|
2144
|
|
|
|
|
|
|
The boxes() method returns a list of arrayrefs containing the |
|
2145
|
|
|
|
|
|
|
coordinates of each glyph. The method is useful for constructing an |
|
2146
|
|
|
|
|
|
|
image map. In a scalar context, boxes() returns an arrayref. In an |
|
2147
|
|
|
|
|
|
|
list context, the method returns the list directly. |
|
2148
|
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
Each member of the list is an arrayref of the following format: |
|
2150
|
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
[ $feature, $x1, $y1, $x2, $y2, $track ] |
|
2152
|
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
The first element is the feature object; either an |
|
2154
|
|
|
|
|
|
|
Ace::Sequence::Feature, a Das::Segment::Feature, or another Bioperl |
|
2155
|
|
|
|
|
|
|
Bio::SeqFeatureI object. The coordinates are the topleft and |
|
2156
|
|
|
|
|
|
|
bottomright corners of the glyph, including any space allocated for |
|
2157
|
|
|
|
|
|
|
labels. The track is the Bio::Graphics::Glyph object corresponding to |
|
2158
|
|
|
|
|
|
|
the track that the feature is rendered inside. |
|
2159
|
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
=item $boxes = $panel-E<gt>key_boxes |
|
2161
|
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
=item @boxes = $panel-E<gt>key_boxes |
|
2163
|
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
Returns the positions of the track keys as an arrayref or a list, |
|
2165
|
|
|
|
|
|
|
depending on context. Each value in the list is an arrayref of format: |
|
2166
|
|
|
|
|
|
|
|
|
2167
|
|
|
|
|
|
|
[ $key_text, $x1, $y1, $x2, $y2, $track ] |
|
2168
|
|
|
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
=item $position = $panel-E<gt>track_position($track) |
|
2170
|
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
After calling gd() or boxes(), you can learn the resulting Y |
|
2172
|
|
|
|
|
|
|
coordinate of a track by calling track_position() with the value |
|
2173
|
|
|
|
|
|
|
returned by add_track() or unshift_track(). This will return undef if |
|
2174
|
|
|
|
|
|
|
called before gd() or boxes() or with an invalid track. |
|
2175
|
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
=item $rotate = $panel-E<gt>rotate([$new_value]) |
|
2177
|
|
|
|
|
|
|
|
|
2178
|
|
|
|
|
|
|
Gets or sets the "rotate" flag. If rotate is set to true (default |
|
2179
|
|
|
|
|
|
|
false), then calls to gd(), png(), gif(), boxes(), and image_and_map() |
|
2180
|
|
|
|
|
|
|
will all return an image and/or imagemap that has been rotated to the |
|
2181
|
|
|
|
|
|
|
right by 90 degrees. This is mostly useful for drawing karyotypes with |
|
2182
|
|
|
|
|
|
|
the ideogram glyph, in order to rotate the chromosomes into the usual |
|
2183
|
|
|
|
|
|
|
vertical position. |
|
2184
|
|
|
|
|
|
|
|
|
2185
|
|
|
|
|
|
|
=item @pixel_coords = $panel-E<gt>location2pixel(@feature_coords) |
|
2186
|
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
Public routine to map feature coordinates (in base pairs) into pixel |
|
2188
|
|
|
|
|
|
|
coordinates relative to the left-hand edge of the picture. If you |
|
2189
|
|
|
|
|
|
|
define a -background callback, the callback may wish to invoke this |
|
2190
|
|
|
|
|
|
|
routine in order to translate base coordinates into pixel coordinates. |
|
2191
|
|
|
|
|
|
|
|
|
2192
|
|
|
|
|
|
|
=item $left = $panel-E<gt>left |
|
2193
|
|
|
|
|
|
|
|
|
2194
|
|
|
|
|
|
|
=item $right = $panel-E<gt>right |
|
2195
|
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
=item $top = $panel-E<gt>top |
|
2197
|
|
|
|
|
|
|
|
|
2198
|
|
|
|
|
|
|
=item $bottom = $panel-E<gt>bottom |
|
2199
|
|
|
|
|
|
|
|
|
2200
|
|
|
|
|
|
|
Return the pixel coordinates of the I<drawing area> of the panel, that |
|
2201
|
|
|
|
|
|
|
is, exclusive of the padding. |
|
2202
|
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
=back |
|
2204
|
|
|
|
|
|
|
|
|
2205
|
|
|
|
|
|
|
=head1 GLYPH OPTIONS |
|
2206
|
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
Each glyph has its own specialized subset of options, but |
|
2208
|
|
|
|
|
|
|
some are shared by all glyphs: |
|
2209
|
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
Option Description Default |
|
2211
|
|
|
|
|
|
|
------ ----------- ------- |
|
2212
|
|
|
|
|
|
|
|
|
2213
|
|
|
|
|
|
|
-key Description of track for undef |
|
2214
|
|
|
|
|
|
|
display in the track label. |
|
2215
|
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
-category The category of the track undef |
|
2217
|
|
|
|
|
|
|
for display in the |
|
2218
|
|
|
|
|
|
|
track label. |
|
2219
|
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
-fgcolor Foreground color black |
|
2221
|
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
-bgcolor Background color turquoise |
|
2223
|
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
-linewidth Width of lines drawn by 1 |
|
2225
|
|
|
|
|
|
|
glyph |
|
2226
|
|
|
|
|
|
|
|
|
2227
|
|
|
|
|
|
|
-height Height of glyph 10 |
|
2228
|
|
|
|
|
|
|
|
|
2229
|
|
|
|
|
|
|
-font Glyph font gdSmallFont |
|
2230
|
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
-fontcolor Primary font color black |
|
2232
|
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
-font2color Secondary font color turquoise |
|
2234
|
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
-opacity Value from 0.0 (invisible) 1.0 |
|
2236
|
|
|
|
|
|
|
to 1.0 (opaque) which |
|
2237
|
|
|
|
|
|
|
controls the translucency |
|
2238
|
|
|
|
|
|
|
of overlapping features. |
|
2239
|
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
-label Whether to draw a label false |
|
2241
|
|
|
|
|
|
|
|
|
2242
|
|
|
|
|
|
|
-description Whether to draw a false |
|
2243
|
|
|
|
|
|
|
description |
|
2244
|
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
-bump Bump direction 0 |
|
2246
|
|
|
|
|
|
|
|
|
2247
|
|
|
|
|
|
|
-sort_order Specify layout sort order "default" |
|
2248
|
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
-feature_limit |
|
2250
|
|
|
|
|
|
|
Maximum number of features undef (unlimited) |
|
2251
|
|
|
|
|
|
|
to display |
|
2252
|
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
-bump_limit Maximum number of levels undef (unlimited) |
|
2254
|
|
|
|
|
|
|
to bump |
|
2255
|
|
|
|
|
|
|
|
|
2256
|
|
|
|
|
|
|
-hbumppad Additional horizontal 0 |
|
2257
|
|
|
|
|
|
|
padding between bumped |
|
2258
|
|
|
|
|
|
|
features |
|
2259
|
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
-strand_arrow Whether to indicate undef (false) |
|
2261
|
|
|
|
|
|
|
strandedness |
|
2262
|
|
|
|
|
|
|
|
|
2263
|
|
|
|
|
|
|
-stranded Synonym for -strand_arrow undef (false) |
|
2264
|
|
|
|
|
|
|
|
|
2265
|
|
|
|
|
|
|
-part_labels Whether to label individual undef (false) |
|
2266
|
|
|
|
|
|
|
subparts. |
|
2267
|
|
|
|
|
|
|
|
|
2268
|
|
|
|
|
|
|
-part_label_merge Whether to merge undef (false) |
|
2269
|
|
|
|
|
|
|
adjacent subparts when |
|
2270
|
|
|
|
|
|
|
labeling. |
|
2271
|
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
-connector Type of connector to none |
|
2273
|
|
|
|
|
|
|
use to connect related |
|
2274
|
|
|
|
|
|
|
features. Options are |
|
2275
|
|
|
|
|
|
|
"solid," "hat", "dashed", |
|
2276
|
|
|
|
|
|
|
"quill" and "none". |
|
2277
|
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
-all_callbacks Whether to invoke undef |
|
2279
|
|
|
|
|
|
|
callbacks for autogenerated |
|
2280
|
|
|
|
|
|
|
"track" and "group" glyphs |
|
2281
|
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
-subpart_callbacks Whether to invoke false |
|
2283
|
|
|
|
|
|
|
callbacks for subparts of |
|
2284
|
|
|
|
|
|
|
the glyph. |
|
2285
|
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
-box_subparts Return boxes around feature 0 |
|
2287
|
|
|
|
|
|
|
subparts rather than around the |
|
2288
|
|
|
|
|
|
|
feature itself. |
|
2289
|
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
-link, -title, -target |
|
2291
|
|
|
|
|
|
|
These options are used when creating imagemaps |
|
2292
|
|
|
|
|
|
|
for display on the web. See L</"Creating Imagemaps">. |
|
2293
|
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
-filter Select which features to |
|
2295
|
|
|
|
|
|
|
display. Must be a CODE reference. |
|
2296
|
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
B<Specifying colors:> Colors can be expressed in either of two ways: |
|
2298
|
|
|
|
|
|
|
as symbolic names such as "cyan", as HTML-style #RRGGBB triples, and |
|
2299
|
|
|
|
|
|
|
r,g,b comma-separated numbers. The symbolic names are the 140 colors |
|
2300
|
|
|
|
|
|
|
defined in the Netscape/Internet Explorer color cube, and can be |
|
2301
|
|
|
|
|
|
|
retrieved using the Bio::Graphics::Panel-E<gt>color_names() method. |
|
2302
|
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
Transparent and semi-transparent colors can be specified using the |
|
2304
|
|
|
|
|
|
|
following syntax: |
|
2305
|
|
|
|
|
|
|
|
|
2306
|
|
|
|
|
|
|
#RRGGBBAA - red, green, blue and alpha |
|
2307
|
|
|
|
|
|
|
r,g,b,a - red, green, blue, alpha |
|
2308
|
|
|
|
|
|
|
blue:alpha - symbolic name and alpha |
|
2309
|
|
|
|
|
|
|
rgb(r,g,b) - CSS style rgb values |
|
2310
|
|
|
|
|
|
|
rgba(r,g,b,a) - CSS style rgba values |
|
2311
|
|
|
|
|
|
|
|
|
2312
|
|
|
|
|
|
|
Alpha values can be specified as GD style integers ranging from 0 |
|
2313
|
|
|
|
|
|
|
(opaque) to 127 (transparent), or as CSS-style floating point numbers |
|
2314
|
|
|
|
|
|
|
ranging from 0.0 (transparent) through 1.0 (opaque). As a special |
|
2315
|
|
|
|
|
|
|
case, a completely transparent color can be specified using the color |
|
2316
|
|
|
|
|
|
|
named "transparent". In the rgb() and rgba() forms, red, green, blue |
|
2317
|
|
|
|
|
|
|
values can be specified as percentages, as in rgb(100%,0%,50%); |
|
2318
|
|
|
|
|
|
|
otherwise, the values are integers from 0 to 255. |
|
2319
|
|
|
|
|
|
|
|
|
2320
|
|
|
|
|
|
|
In addition, the -fgcolor and -bgcolor options accept the special |
|
2321
|
|
|
|
|
|
|
color names "featureScore" and "featureRGB". In the first case, |
|
2322
|
|
|
|
|
|
|
Bio::Graphics will examine each feature in the track for a defined |
|
2323
|
|
|
|
|
|
|
"score" tag (or the presence of a score() method) with a numeric value |
|
2324
|
|
|
|
|
|
|
ranging from 0-1000. It will draw a grayscale color ranging from |
|
2325
|
|
|
|
|
|
|
lightest (0) to darkest (1000). If the color is named "featureRGB", |
|
2326
|
|
|
|
|
|
|
then Bio::Graphics will look for a tag named "RGB" and will use that |
|
2327
|
|
|
|
|
|
|
as the color. |
|
2328
|
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
B<Foreground color:> The -fgcolor option controls the foreground |
|
2330
|
|
|
|
|
|
|
color, including the edges of boxes and the like. |
|
2331
|
|
|
|
|
|
|
|
|
2332
|
|
|
|
|
|
|
B<Background color:> The -bgcolor option controls the background used |
|
2333
|
|
|
|
|
|
|
for filled boxes and other "solid" glyphs. The foreground color |
|
2334
|
|
|
|
|
|
|
controls the color of lines and strings. The -tkcolor argument |
|
2335
|
|
|
|
|
|
|
controls the background color of the entire track. |
|
2336
|
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
B<Default opacity:>For truecolor images, you can apply a default opacity |
|
2338
|
|
|
|
|
|
|
value to both foreground and background colors by supplying a B<-opacity> |
|
2339
|
|
|
|
|
|
|
argument. This is specified as a CSS-style floating point number from |
|
2340
|
|
|
|
|
|
|
0.0 to 1.0. If the color has an explicit alpha, then the default is |
|
2341
|
|
|
|
|
|
|
ignored. |
|
2342
|
|
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
B<Track color:> The -tkcolor option used to specify the background of |
|
2344
|
|
|
|
|
|
|
the entire track. |
|
2345
|
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
B<Font:> The -font option controls which font will be used. If the |
|
2347
|
|
|
|
|
|
|
Panel was created without passing a true value to -truecolor, then |
|
2348
|
|
|
|
|
|
|
only GD bitmapped fonts are available to you. These include |
|
2349
|
|
|
|
|
|
|
'gdTinyFont', 'gdSmallFont', 'gdLargeFont', 'gdMediumBoldFont', and |
|
2350
|
|
|
|
|
|
|
'gdGiantFont'. If the Panel was creaed using a truevalue for |
|
2351
|
|
|
|
|
|
|
-truecolor, then you can pass the name of any truetype font installed |
|
2352
|
|
|
|
|
|
|
on the server system. Any of these formats will work: |
|
2353
|
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
-font => 'Times New Roman', # Times font, let the system pick size |
|
2355
|
|
|
|
|
|
|
-font => 'Times New Roman-12' # Times font, 12 points |
|
2356
|
|
|
|
|
|
|
-font => 'Times New Roman-12:Italic' # Times font, 12 points italic |
|
2357
|
|
|
|
|
|
|
-font => 'Times New Roman-12:Bold' # Times font, 12 points bold |
|
2358
|
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
B<Font color:> The -fontcolor option controls the color of primary |
|
2360
|
|
|
|
|
|
|
text, such as labels |
|
2361
|
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
B<Secondary Font color:> The -font2color option controls the color of |
|
2363
|
|
|
|
|
|
|
secondary text, such as descriptions. |
|
2364
|
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
B<Labels:> The -label argument controls whether or not the ID of the |
|
2366
|
|
|
|
|
|
|
feature should be printed next to the feature. It is accepted by all |
|
2367
|
|
|
|
|
|
|
glyphs. By default, the label is printed just above the glyph and |
|
2368
|
|
|
|
|
|
|
left aligned with it. |
|
2369
|
|
|
|
|
|
|
|
|
2370
|
|
|
|
|
|
|
-label can be a constant string or a code reference. Values can be |
|
2371
|
|
|
|
|
|
|
any of: |
|
2372
|
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
-label value Description |
|
2374
|
|
|
|
|
|
|
------------ ----------- |
|
2375
|
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
0 Don't draw a label |
|
2377
|
|
|
|
|
|
|
1 Calculate a label based on primary tag of sequence |
|
2378
|
|
|
|
|
|
|
"a string" Use "a string" as the label |
|
2379
|
|
|
|
|
|
|
code ref Invoke the code reference to compute the label |
|
2380
|
|
|
|
|
|
|
|
|
2381
|
|
|
|
|
|
|
A known bug with this naming scheme is that you can't label a feature |
|
2382
|
|
|
|
|
|
|
with the string "1". To work around this, use "1 " (note the terminal |
|
2383
|
|
|
|
|
|
|
space). |
|
2384
|
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
B<Descriptions:> The -description argument controls whether or not a |
|
2386
|
|
|
|
|
|
|
brief description of the feature should be printed next to it. By |
|
2387
|
|
|
|
|
|
|
default, the description is printed just below the glyph and |
|
2388
|
|
|
|
|
|
|
left-aligned with it. A value of 0 will suppress the description. A |
|
2389
|
|
|
|
|
|
|
value of 1 will "magically" look for tags of type "note" or |
|
2390
|
|
|
|
|
|
|
"description" and draw them if found, otherwise the source tag, if |
|
2391
|
|
|
|
|
|
|
any, will be displayed. A code reference will be invoked to calculate |
|
2392
|
|
|
|
|
|
|
the description on the fly. Anything else will be treated as a string |
|
2393
|
|
|
|
|
|
|
and used verbatim. |
|
2394
|
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
B<Connectors:> A glyph can contain subglyphs, recursively. The top |
|
2396
|
|
|
|
|
|
|
level glyph is the track, which contains one or more groups, which |
|
2397
|
|
|
|
|
|
|
contain features, which contain subfeatures, and so forth. By |
|
2398
|
|
|
|
|
|
|
default, the "group" glyph draws dotted lines between each of its |
|
2399
|
|
|
|
|
|
|
subglyphs, the "segment" glyph draws a solid line between each of its |
|
2400
|
|
|
|
|
|
|
subglyphs, and the "transcript" and "transcript2" glyphs draw |
|
2401
|
|
|
|
|
|
|
hat-shaped lines between their subglyphs. All other glyphs do not |
|
2402
|
|
|
|
|
|
|
connect their components. You can override this behavior by providing |
|
2403
|
|
|
|
|
|
|
a -connector option, to explicitly set the type of connector. Valid |
|
2404
|
|
|
|
|
|
|
options are: |
|
2405
|
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
"hat" an upward-angling conector |
|
2408
|
|
|
|
|
|
|
"solid" a straight horizontal connector |
|
2409
|
|
|
|
|
|
|
"quill" a decorated line with small arrows indicating strandedness |
|
2410
|
|
|
|
|
|
|
(like the UCSC Genome Browser uses) |
|
2411
|
|
|
|
|
|
|
"dashed" a horizontal dashed line. |
|
2412
|
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
The B<-connector_color> option controls the color of the connector, if |
|
2414
|
|
|
|
|
|
|
any. |
|
2415
|
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
B<Collision control:> The B<-bump> argument controls what happens when |
|
2417
|
|
|
|
|
|
|
glyphs collide. By default, they will simply overlap (value 0). A |
|
2418
|
|
|
|
|
|
|
-bump value of +1 will cause overlapping glyphs to bump downwards |
|
2419
|
|
|
|
|
|
|
until there is room for them. A -bump value of -1 will cause |
|
2420
|
|
|
|
|
|
|
overlapping glyphs to bump upwards. You may also provide a -bump |
|
2421
|
|
|
|
|
|
|
value of +2 or -2 to activate a very simple type of collision control |
|
2422
|
|
|
|
|
|
|
in which each feature occupies its own line. This is useful for |
|
2423
|
|
|
|
|
|
|
showing dense, nearly-full length features such as similarity hits. A |
|
2424
|
|
|
|
|
|
|
bump of 3 or the string "fast" will turn on a faster |
|
2425
|
|
|
|
|
|
|
collision-detection algorithm that only works properly with the |
|
2426
|
|
|
|
|
|
|
default "left" sort order. |
|
2427
|
|
|
|
|
|
|
|
|
2428
|
|
|
|
|
|
|
Finally, a bump value of "overlap" will cause features to overlap each |
|
2429
|
|
|
|
|
|
|
other and to made partially translucent (the translucency can be |
|
2430
|
|
|
|
|
|
|
controlled with the -opacity setting). Features that are on opposite |
|
2431
|
|
|
|
|
|
|
strands will bump, but those on the same strand will not. |
|
2432
|
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
The bump argument can also be a code reference; see below. |
|
2434
|
|
|
|
|
|
|
|
|
2435
|
|
|
|
|
|
|
For convenience and backwards compatibility, if you specify a -bump |
|
2436
|
|
|
|
|
|
|
of 1 and use the default sort order, the faster algorithm will be |
|
2437
|
|
|
|
|
|
|
used. |
|
2438
|
|
|
|
|
|
|
|
|
2439
|
|
|
|
|
|
|
If you would like to see more horizontal whitespace between features |
|
2440
|
|
|
|
|
|
|
that occupy the same line, you can specify it with the B<-hbumppad> |
|
2441
|
|
|
|
|
|
|
option. Positive values increase the amount of whitespace between |
|
2442
|
|
|
|
|
|
|
features. Negative values decrease the whitespace. |
|
2443
|
|
|
|
|
|
|
|
|
2444
|
|
|
|
|
|
|
B<Keys:> The -key argument declares that the track is to be shown in a |
|
2445
|
|
|
|
|
|
|
key appended to the bottom of the image. The key contains a picture |
|
2446
|
|
|
|
|
|
|
of a glyph and a label describing what the glyph means. The label is |
|
2447
|
|
|
|
|
|
|
specified in the argument to -key. |
|
2448
|
|
|
|
|
|
|
|
|
2449
|
|
|
|
|
|
|
B<box_subparts:> Ordinarily, when you invoke the boxes() methods to |
|
2450
|
|
|
|
|
|
|
retrieve the rectangles surrounding the glyphs (which you need to do |
|
2451
|
|
|
|
|
|
|
to create clickable imagemaps, for example), the rectangles will |
|
2452
|
|
|
|
|
|
|
surround the top level features. If you wish for the rectangles to |
|
2453
|
|
|
|
|
|
|
surround subpieces of the glyph, such as the exons in a transcript, |
|
2454
|
|
|
|
|
|
|
set box_subparts to a true numeric value. The value you specify will |
|
2455
|
|
|
|
|
|
|
control the number of levels of subfeatures that the boxes will |
|
2456
|
|
|
|
|
|
|
descend into. For example, if using the "gene" glyph, set |
|
2457
|
|
|
|
|
|
|
-box_subparts to 2 to create boxes for the whole gene (level 0), the |
|
2458
|
|
|
|
|
|
|
mRNAs (level 1) and the exons (level 2). |
|
2459
|
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
B<part_labels:> If set to true, each subpart of a multipart feature |
|
2461
|
|
|
|
|
|
|
will be labeled with a number starting with 1 at the 5'-most |
|
2462
|
|
|
|
|
|
|
part. This is useful for counting exons. You can pass a callback to |
|
2463
|
|
|
|
|
|
|
this argument; the part number and the total number of parts will be |
|
2464
|
|
|
|
|
|
|
arguments three and four. For example, to label the exons as "exon 1", |
|
2465
|
|
|
|
|
|
|
"exon 2" and so on: |
|
2466
|
|
|
|
|
|
|
|
|
2467
|
|
|
|
|
|
|
-part_labels => sub { |
|
2468
|
|
|
|
|
|
|
my ($feature,undef,$partno) = @_; |
|
2469
|
|
|
|
|
|
|
return 'exon '.($partno+1); |
|
2470
|
|
|
|
|
|
|
} |
|
2471
|
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
The B<-label> argument must also be true. |
|
2473
|
|
|
|
|
|
|
|
|
2474
|
|
|
|
|
|
|
B<part_labels_merge:> If true, changes the behavior of -part_labels so |
|
2475
|
|
|
|
|
|
|
that features that abut each other without a gap are treated as a |
|
2476
|
|
|
|
|
|
|
single feature. Useful if you want to count the UTR and CDS segments |
|
2477
|
|
|
|
|
|
|
of an exon as a single unit, and the default for transcript glyphs. |
|
2478
|
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
B<strand_arrow:> If set to true, some glyphs will indicate their |
|
2480
|
|
|
|
|
|
|
strandedness, usually by drawing an arrow. For this to work, the |
|
2481
|
|
|
|
|
|
|
Bio::SeqFeature must have a strand of +1 or -1. The glyph will ignore |
|
2482
|
|
|
|
|
|
|
this directive if the underlying feature has a strand of zero or |
|
2483
|
|
|
|
|
|
|
undef. |
|
2484
|
|
|
|
|
|
|
|
|
2485
|
|
|
|
|
|
|
B<sort_order>: By default, features are drawn with a layout based only on the |
|
2486
|
|
|
|
|
|
|
position of the feature, assuring a maximal "packing" of the glyphs |
|
2487
|
|
|
|
|
|
|
when bumped. In some cases, however, it makes sense to display the |
|
2488
|
|
|
|
|
|
|
glyphs sorted by score or some other comparison, e.g. such that more |
|
2489
|
|
|
|
|
|
|
"important" features are nearer the top of the display, stacked above |
|
2490
|
|
|
|
|
|
|
less important features. The -sort_order option allows a few |
|
2491
|
|
|
|
|
|
|
different built-in values for changing the default sort order (which |
|
2492
|
|
|
|
|
|
|
is by "left" position): "low_score" (or "high_score") will cause |
|
2493
|
|
|
|
|
|
|
features to be sorted from lowest to highest score (or vice versa). |
|
2494
|
|
|
|
|
|
|
"left" (or "default") and "right" values will cause features to be |
|
2495
|
|
|
|
|
|
|
sorted by their position in the sequence. "longest" (or "shortest") |
|
2496
|
|
|
|
|
|
|
will cause the longest (or shortest) features to be sorted first, and |
|
2497
|
|
|
|
|
|
|
"strand" will cause the features to be sorted by strand: "+1" |
|
2498
|
|
|
|
|
|
|
(forward) then "0" (unknown, or NA) then "-1" (reverse). |
|
2499
|
|
|
|
|
|
|
|
|
2500
|
|
|
|
|
|
|
In all cases, the "left" position will be used to break any ties. To |
|
2501
|
|
|
|
|
|
|
break ties using another field, options may be strung together using a |
|
2502
|
|
|
|
|
|
|
"|" character; e.g. "strand|low_score|right" would cause the features |
|
2503
|
|
|
|
|
|
|
to be sorted first by strand, then score (lowest to highest), then by |
|
2504
|
|
|
|
|
|
|
"right" position in the sequence. |
|
2505
|
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
Finally, a subroutine coderef with a $$ prototype can be provided. It |
|
2507
|
|
|
|
|
|
|
will receive two B<glyph> as arguments and should return -1, 0 or 1 |
|
2508
|
|
|
|
|
|
|
(see Perl's sort() function for more information). For example, to |
|
2509
|
|
|
|
|
|
|
sort a set of database search hits by bits (stored in the features' |
|
2510
|
|
|
|
|
|
|
"score" fields), scaled by the log of the alignment length (with |
|
2511
|
|
|
|
|
|
|
"start" position breaking any ties): |
|
2512
|
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
sort_order = sub ($$) { |
|
2514
|
|
|
|
|
|
|
my ($glyph1,$glyph2) = @_; |
|
2515
|
|
|
|
|
|
|
my $a = $glyph1->feature; |
|
2516
|
|
|
|
|
|
|
my $b = $glyph2->feature; |
|
2517
|
|
|
|
|
|
|
( $b->score/log($b->length) |
|
2518
|
|
|
|
|
|
|
<=> |
|
2519
|
|
|
|
|
|
|
$a->score/log($a->length) ) |
|
2520
|
|
|
|
|
|
|
|| |
|
2521
|
|
|
|
|
|
|
( $a->start <=> $b->start ) |
|
2522
|
|
|
|
|
|
|
} |
|
2523
|
|
|
|
|
|
|
|
|
2524
|
|
|
|
|
|
|
It is important to remember to use the $$ prototype as shown in the |
|
2525
|
|
|
|
|
|
|
example. Otherwise Bio::Graphics will quit with an exception. The |
|
2526
|
|
|
|
|
|
|
arguments are subclasses of Bio::Graphics::Glyph, not the features |
|
2527
|
|
|
|
|
|
|
themselves. While glyphs implement some, but not all, of the feature |
|
2528
|
|
|
|
|
|
|
methods, to be safe call the two glyphs' feature() methods in order to |
|
2529
|
|
|
|
|
|
|
convert them into the actual features. |
|
2530
|
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
The '-always_sort' option, if true, will sort features even if bumping |
|
2532
|
|
|
|
|
|
|
is turned off. This is useful if you would like overlapping features |
|
2533
|
|
|
|
|
|
|
to stack in a particular order. Features towards the end of the list |
|
2534
|
|
|
|
|
|
|
will overlay those towards the beginning of the sort order. |
|
2535
|
|
|
|
|
|
|
|
|
2536
|
|
|
|
|
|
|
B<-feature_limit>: When this option is set to a non-zero value, calls |
|
2537
|
|
|
|
|
|
|
to a track's add_feature() method will maintain a count of features |
|
2538
|
|
|
|
|
|
|
added to a track. Once the feature count exceeds the value set in |
|
2539
|
|
|
|
|
|
|
-feature_limit, additional features will displace existing ones in a |
|
2540
|
|
|
|
|
|
|
way that effects a uniform sampling of the total feature set. This is |
|
2541
|
|
|
|
|
|
|
useful to protect against excessively large tracks. The total number |
|
2542
|
|
|
|
|
|
|
of features added can be retrieved by calling the track's |
|
2543
|
|
|
|
|
|
|
feature_count() method. |
|
2544
|
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
B<-bump_limit>: When bumping is chosen, colliding features will |
|
2546
|
|
|
|
|
|
|
ordinarily move upward or downward without limit. When many features |
|
2547
|
|
|
|
|
|
|
collide, this can lead to excessively high images. You can limit the |
|
2548
|
|
|
|
|
|
|
number of levels that features will bump by providing a numeric |
|
2549
|
|
|
|
|
|
|
B<bump_limit> option. After the limit is hit, features will pile up on |
|
2550
|
|
|
|
|
|
|
top of each other, usually as a band at the bottom of the track. |
|
2551
|
|
|
|
|
|
|
|
|
2552
|
|
|
|
|
|
|
The B<-filter> option, which must be a CODE reference, will be invoked |
|
2553
|
|
|
|
|
|
|
once for each feature prior to rendering it. The coderef will receive |
|
2554
|
|
|
|
|
|
|
the feature as its single option and should return true if the feature |
|
2555
|
|
|
|
|
|
|
is to be shown and false otherwise. |
|
2556
|
|
|
|
|
|
|
|
|
2557
|
|
|
|
|
|
|
=head2 Options and Callbacks |
|
2558
|
|
|
|
|
|
|
|
|
2559
|
|
|
|
|
|
|
Instead of providing a constant value to an option, you may subsitute |
|
2560
|
|
|
|
|
|
|
a code reference. This code reference will be called every time the |
|
2561
|
|
|
|
|
|
|
panel needs to configure a glyph. The callback will be called with |
|
2562
|
|
|
|
|
|
|
three arguments like this: |
|
2563
|
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
sub callback { |
|
2565
|
|
|
|
|
|
|
my ($feature,$option_name,$part_no,$total_parts,$glyph) = @_; |
|
2566
|
|
|
|
|
|
|
# do something which results in $option_value being set |
|
2567
|
|
|
|
|
|
|
return $option_value; |
|
2568
|
|
|
|
|
|
|
} |
|
2569
|
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
The five arguments are C<$feature>, a reference to the IO::SeqFeatureI |
|
2571
|
|
|
|
|
|
|
object, C<$option_name>, the name of the option to configure, |
|
2572
|
|
|
|
|
|
|
C<$part_no>, an integer index indicating which subpart of the feature |
|
2573
|
|
|
|
|
|
|
is being drawn, C<$total_parts>, an integer indicating the total |
|
2574
|
|
|
|
|
|
|
number of subfeatures in the feature, and finally C<$glyph>, the Glyph |
|
2575
|
|
|
|
|
|
|
object itself. The latter fields are useful in the case of treating |
|
2576
|
|
|
|
|
|
|
the first or last subfeature differently, such as using a different |
|
2577
|
|
|
|
|
|
|
color for the terminal exon of a gene. Usually you will only need to |
|
2578
|
|
|
|
|
|
|
examine the first argument. This example shows a callback examining |
|
2579
|
|
|
|
|
|
|
the score() attribute of a feature (possibly a BLAST hit) and return |
|
2580
|
|
|
|
|
|
|
the color "red" for high-scoring features, and "green" for low-scoring |
|
2581
|
|
|
|
|
|
|
features: |
|
2582
|
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
sub callback { |
|
2584
|
|
|
|
|
|
|
my $feature = shift; |
|
2585
|
|
|
|
|
|
|
if ($feature->score > 90) { |
|
2586
|
|
|
|
|
|
|
return 'red'; |
|
2587
|
|
|
|
|
|
|
else { |
|
2588
|
|
|
|
|
|
|
return 'green'; |
|
2589
|
|
|
|
|
|
|
} |
|
2590
|
|
|
|
|
|
|
} |
|
2591
|
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
The callback should return a string indicating the desired value of |
|
2593
|
|
|
|
|
|
|
the option. To tell the panel to use the default value for this |
|
2594
|
|
|
|
|
|
|
option, return the string "*default*". |
|
2595
|
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
The callback for -grid is slightly different because at the time this |
|
2597
|
|
|
|
|
|
|
option is needed there is no glyph defined. In this case, the callback |
|
2598
|
|
|
|
|
|
|
will get two arguments: the feature and the panel object: |
|
2599
|
|
|
|
|
|
|
|
|
2600
|
|
|
|
|
|
|
-glyph => sub { |
|
2601
|
|
|
|
|
|
|
my ($feature,$panel) = @_; |
|
2602
|
|
|
|
|
|
|
return 'gene' if $panel->length < 10_000; |
|
2603
|
|
|
|
|
|
|
return 'box'; |
|
2604
|
|
|
|
|
|
|
} |
|
2605
|
|
|
|
|
|
|
|
|
2606
|
|
|
|
|
|
|
When you install a callback for a feature that contains subparts, the |
|
2607
|
|
|
|
|
|
|
callback will be invoked first for the top-level feature, and then for |
|
2608
|
|
|
|
|
|
|
each of its subparts (recursively). You should make sure to examine |
|
2609
|
|
|
|
|
|
|
the feature's type to determine whether the option is appropriate. |
|
2610
|
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
Also be aware that some options are only called for subfeatures. For |
|
2612
|
|
|
|
|
|
|
example, when using multi-segmented features, the "bgcolor" and |
|
2613
|
|
|
|
|
|
|
"fgcolor" options apply to the subfeatures and not to the whole |
|
2614
|
|
|
|
|
|
|
feature; therefore the corresponding callbacks will only be invoked |
|
2615
|
|
|
|
|
|
|
for the subfeatures and not for the top-level feature. To get |
|
2616
|
|
|
|
|
|
|
information that applies to the top-level feature, use the glyph's |
|
2617
|
|
|
|
|
|
|
parent_feature() method. This returns: |
|
2618
|
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
* the parent if called with no arguments or with an argument of (1) |
|
2620
|
|
|
|
|
|
|
* the parent's parent if called with an argument of (2) |
|
2621
|
|
|
|
|
|
|
* the parent's parent's parent if called with an argument of (3) |
|
2622
|
|
|
|
|
|
|
* etc. |
|
2623
|
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
The general way to take advantage of this feature is: |
|
2625
|
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
sub callback { |
|
2627
|
|
|
|
|
|
|
my ($feature,$option_name,$part_no,$total_parts,$glyph) = @_; |
|
2628
|
|
|
|
|
|
|
my $parent = $glyph->parent_feature(); |
|
2629
|
|
|
|
|
|
|
|
|
2630
|
|
|
|
|
|
|
# do something which results in $option_value being set |
|
2631
|
|
|
|
|
|
|
return $option_value; |
|
2632
|
|
|
|
|
|
|
} |
|
2633
|
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
or, more concisely: |
|
2635
|
|
|
|
|
|
|
|
|
2636
|
|
|
|
|
|
|
sub callback { |
|
2637
|
|
|
|
|
|
|
my $feature = shift; # first argument |
|
2638
|
|
|
|
|
|
|
my $glyph = pop; # last argument |
|
2639
|
|
|
|
|
|
|
my $parent = $glyph->parent_feature(); |
|
2640
|
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
# do something which results in $option_value being set |
|
2642
|
|
|
|
|
|
|
return $option_value; |
|
2643
|
|
|
|
|
|
|
} |
|
2644
|
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
Some glyphs deliberately disable recursion into subparts. The |
|
2646
|
|
|
|
|
|
|
"track", "group", "transcript", "transcript2" and "segments" glyphs |
|
2647
|
|
|
|
|
|
|
selectively disable the -bump, -label and -description options. This |
|
2648
|
|
|
|
|
|
|
is to avoid, for example, a label being attached to each exon in a |
|
2649
|
|
|
|
|
|
|
transcript, or the various segments of a gapped alignment bumping each |
|
2650
|
|
|
|
|
|
|
other. You can override this behavior and force your callback to be |
|
2651
|
|
|
|
|
|
|
invoked by providing add_track() with a true B<-all_callbacks> |
|
2652
|
|
|
|
|
|
|
argument. In this case, you must be prepared to handle configuring |
|
2653
|
|
|
|
|
|
|
options for the "group" and "track" glyphs. |
|
2654
|
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
In particular, this means that in order to control the -bump option |
|
2656
|
|
|
|
|
|
|
with a callback, you should specify -all_callbacks=E<gt>1, and turn on |
|
2657
|
|
|
|
|
|
|
bumping when the callback is in the track or group glyphs. |
|
2658
|
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
The -subpart_callbacks options is similar, except that when this is |
|
2660
|
|
|
|
|
|
|
set to true callbacks are invoked for the main glyph and its |
|
2661
|
|
|
|
|
|
|
subparts. This option only affects the -label and -description |
|
2662
|
|
|
|
|
|
|
options. |
|
2663
|
|
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
|
=head2 ACCESSORS |
|
2665
|
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
The following accessor methods provide access to various attributes of |
|
2667
|
|
|
|
|
|
|
the panel object. Called with no arguments, they each return the |
|
2668
|
|
|
|
|
|
|
current value of the attribute. Called with a single argument, they |
|
2669
|
|
|
|
|
|
|
set the attribute and return its previous value. |
|
2670
|
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
Note that in most cases you must change attributes prior to invoking |
|
2672
|
|
|
|
|
|
|
gd(), png() or boxes(). These three methods all invoke an internal |
|
2673
|
|
|
|
|
|
|
layout() method which places the tracks and the glyphs within them, |
|
2674
|
|
|
|
|
|
|
and then caches the result. |
|
2675
|
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
Accessor Name Description |
|
2677
|
|
|
|
|
|
|
------------- ----------- |
|
2678
|
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
width() Get/set width of panel |
|
2680
|
|
|
|
|
|
|
spacing() Get/set spacing between tracks |
|
2681
|
|
|
|
|
|
|
key_spacing() Get/set spacing between keys |
|
2682
|
|
|
|
|
|
|
length() Get/set length of segment (bp) |
|
2683
|
|
|
|
|
|
|
flip() Get/set coordinate flipping |
|
2684
|
|
|
|
|
|
|
pad_top() Get/set top padding |
|
2685
|
|
|
|
|
|
|
pad_left() Get/set left padding |
|
2686
|
|
|
|
|
|
|
pad_bottom() Get/set bottom padding |
|
2687
|
|
|
|
|
|
|
pad_right() Get/set right padding |
|
2688
|
|
|
|
|
|
|
start() Get the start of the sequence (bp; read only) |
|
2689
|
|
|
|
|
|
|
end() Get the end of the sequence (bp; read only) |
|
2690
|
|
|
|
|
|
|
left() Get the left side of the drawing area (pixels; read only) |
|
2691
|
|
|
|
|
|
|
right() Get the right side of the drawing area (pixels; read only) |
|
2692
|
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
=head2 COLOR METHODS |
|
2694
|
|
|
|
|
|
|
|
|
2695
|
|
|
|
|
|
|
The following methods are used internally, but may be useful for those |
|
2696
|
|
|
|
|
|
|
implementing new glyph types. |
|
2697
|
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
=over 4 |
|
2699
|
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
=item @names = Bio::Graphics::Panel-E<gt>color_names |
|
2701
|
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
Return the symbolic names of the colors recognized by the panel |
|
2703
|
|
|
|
|
|
|
object. In a scalar context, returns an array reference. |
|
2704
|
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
=item ($red,$green,$blue) = Bio::Graphics::Panel-E<gt>color_name_to_rgb($color) |
|
2706
|
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
Given a symbolic color name, returns the red, green, blue components |
|
2708
|
|
|
|
|
|
|
of the color. In a scalar context, returns an array reference to the |
|
2709
|
|
|
|
|
|
|
rgb triplet. Returns undef for an invalid color name. |
|
2710
|
|
|
|
|
|
|
|
|
2711
|
|
|
|
|
|
|
=item @rgb = $panel-E<gt>rgb($index) |
|
2712
|
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
Given a GD color index (between 0 and 140), returns the RGB triplet |
|
2714
|
|
|
|
|
|
|
corresponding to this index. This method is only useful within a |
|
2715
|
|
|
|
|
|
|
glyph's draw() routine, after the panel has allocated a GD::Image and |
|
2716
|
|
|
|
|
|
|
is populating it. |
|
2717
|
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
=item $index = $panel-E<gt>translate_color($color) |
|
2719
|
|
|
|
|
|
|
|
|
2720
|
|
|
|
|
|
|
Given a color, returns the GD::Image index. The color may be |
|
2721
|
|
|
|
|
|
|
symbolic, such as "turquoise", or a #RRGGBB triple, as in #F0E0A8. |
|
2722
|
|
|
|
|
|
|
This method is only useful within a glyph's draw() routine, after the |
|
2723
|
|
|
|
|
|
|
panel has allocated a GD::Image and is populating it. |
|
2724
|
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
=item $panel-E<gt>set_pen($width,$color) |
|
2726
|
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
Changes the width and color of the GD drawing pen to the values |
|
2728
|
|
|
|
|
|
|
indicated. This is called automatically by the GlyphFactory fgcolor() |
|
2729
|
|
|
|
|
|
|
method. It returns the GD value gdBrushed, which should be used for |
|
2730
|
|
|
|
|
|
|
drawing. |
|
2731
|
|
|
|
|
|
|
|
|
2732
|
|
|
|
|
|
|
=back |
|
2733
|
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
=head2 Creating Imagemaps |
|
2735
|
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
You may wish to use Bio::Graphics to create clickable imagemaps for |
|
2737
|
|
|
|
|
|
|
display on the web. The main method for achieving this is |
|
2738
|
|
|
|
|
|
|
image_and_map(). Under special circumstances you may instead wish to |
|
2739
|
|
|
|
|
|
|
call either or both of create_web_image() and create_web_map(). |
|
2740
|
|
|
|
|
|
|
|
|
2741
|
|
|
|
|
|
|
Here is a synopsis of how to use image_and_map() in a CGI script, |
|
2742
|
|
|
|
|
|
|
using CGI.pm calls to provide the HTML scaffolding: |
|
2743
|
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
print h2('My Genome'); |
|
2745
|
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
my ($url,$map,$mapname) = |
|
2747
|
|
|
|
|
|
|
$panel->image_and_map(-root => '/var/www/html', |
|
2748
|
|
|
|
|
|
|
-url => '/tmpimages', |
|
2749
|
|
|
|
|
|
|
-link => 'http://www.google.com/search?q=$name'); |
|
2750
|
|
|
|
|
|
|
|
|
2751
|
|
|
|
|
|
|
print img({-src=>$url,-usemap=>"#$mapname"}); |
|
2752
|
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
print $map; |
|
2754
|
|
|
|
|
|
|
|
|
2755
|
|
|
|
|
|
|
We call image_and_map() with various arguments (described below) to |
|
2756
|
|
|
|
|
|
|
generate a three element list consisting of the URL at which the image |
|
2757
|
|
|
|
|
|
|
can be accessed, an HTML fragment containing the clickable imagemap |
|
2758
|
|
|
|
|
|
|
data, and the name of the map. We print out an E<lt>imageE<gt> tag |
|
2759
|
|
|
|
|
|
|
that uses the URL of the map as its src attribute and the name of the |
|
2760
|
|
|
|
|
|
|
map as the value of its usemap attribute. It is important to note |
|
2761
|
|
|
|
|
|
|
that we must put a "#" in front of the name of the map in order to |
|
2762
|
|
|
|
|
|
|
indicate that the map can be found in the same document as the |
|
2763
|
|
|
|
|
|
|
E<lt>imageE<gt> tag. Lastly, we print out the map itself. |
|
2764
|
|
|
|
|
|
|
|
|
2765
|
|
|
|
|
|
|
=over 4 |
|
2766
|
|
|
|
|
|
|
|
|
2767
|
|
|
|
|
|
|
=item ($url,$map,$mapname) = $panel-E<gt>image_and_map(@options) |
|
2768
|
|
|
|
|
|
|
|
|
2769
|
|
|
|
|
|
|
Create the image in a web-accessible directory and return its URL, its |
|
2770
|
|
|
|
|
|
|
clickable imagemap, and the name of the imagemap. The following |
|
2771
|
|
|
|
|
|
|
options are recognized: |
|
2772
|
|
|
|
|
|
|
|
|
2773
|
|
|
|
|
|
|
Option Description |
|
2774
|
|
|
|
|
|
|
------ ----------- |
|
2775
|
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
-url The URL to store the image at. |
|
2777
|
|
|
|
|
|
|
|
|
2778
|
|
|
|
|
|
|
|
|
2779
|
|
|
|
|
|
|
-root The directory path that should be appended to the |
|
2780
|
|
|
|
|
|
|
start of -url in order to obtain a physical |
|
2781
|
|
|
|
|
|
|
directory path. |
|
2782
|
|
|
|
|
|
|
-link A string pattern or coderef that will be used to |
|
2783
|
|
|
|
|
|
|
generate the outgoing hypertext links for the imagemap. |
|
2784
|
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
-title A string pattern or coderef that will be used to |
|
2786
|
|
|
|
|
|
|
generate the "title" tags of each element in the imagemap |
|
2787
|
|
|
|
|
|
|
(these appear as popup hint boxes in certain browsers). |
|
2788
|
|
|
|
|
|
|
|
|
2789
|
|
|
|
|
|
|
-target A string pattern or coderef that will be used to |
|
2790
|
|
|
|
|
|
|
generate the window target for each element. This can |
|
2791
|
|
|
|
|
|
|
be used to pop up a new window when the user clicks on |
|
2792
|
|
|
|
|
|
|
an element. |
|
2793
|
|
|
|
|
|
|
|
|
2794
|
|
|
|
|
|
|
-mapname The name to use for the E<lt>mapE<gt> tag. If not provided, |
|
2795
|
|
|
|
|
|
|
a unique one will be autogenerated for you. |
|
2796
|
|
|
|
|
|
|
|
|
2797
|
|
|
|
|
|
|
This method returns a three element list consisting of the URL at |
|
2798
|
|
|
|
|
|
|
which the image has been written to, the imagemap HTML, and the name |
|
2799
|
|
|
|
|
|
|
of the map. Usually you will incorporate this information into an |
|
2800
|
|
|
|
|
|
|
HTML document like so: |
|
2801
|
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
my ($url,$map,$mapname) = |
|
2803
|
|
|
|
|
|
|
$panel->image_and_map(-link=>'http://www.google.com/search?q=$name'); |
|
2804
|
|
|
|
|
|
|
print qq(<img src="$url" usemap="#$mapname">),"\n"; |
|
2805
|
|
|
|
|
|
|
print $map,"\n"; |
|
2806
|
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
=item $url = $panel-E<gt>create_web_image($url,$root) |
|
2808
|
|
|
|
|
|
|
|
|
2809
|
|
|
|
|
|
|
Create the image, write it into the directory indicated by |
|
2810
|
|
|
|
|
|
|
concatenating $root and $url (i.e. "$root/$url"), and return $url. |
|
2811
|
|
|
|
|
|
|
|
|
2812
|
|
|
|
|
|
|
=item $map = $panel-E<gt>create_web_map('mapname',$linkrule,$titlerule,$targetrule) |
|
2813
|
|
|
|
|
|
|
|
|
2814
|
|
|
|
|
|
|
Create a clickable imagemap named "mapname" using the indicated rules |
|
2815
|
|
|
|
|
|
|
to generate the hypertext links, the element titles, and the window |
|
2816
|
|
|
|
|
|
|
targets for the graphical elements. Return the HTML for the map, |
|
2817
|
|
|
|
|
|
|
including the enclosing E<lt>mapE<gt> tag itself. |
|
2818
|
|
|
|
|
|
|
|
|
2819
|
|
|
|
|
|
|
=back |
|
2820
|
|
|
|
|
|
|
|
|
2821
|
|
|
|
|
|
|
To use this method effectively, you will need a web server and an |
|
2822
|
|
|
|
|
|
|
image directory in the document tree that is writable by the web |
|
2823
|
|
|
|
|
|
|
server user. For example, if your web server's document root is |
|
2824
|
|
|
|
|
|
|
located at /var/www/html, you might want to create a directory named |
|
2825
|
|
|
|
|
|
|
"tmpimages" for this purpose: |
|
2826
|
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
mkdir /var/www/html/tmpimages |
|
2828
|
|
|
|
|
|
|
chmod 1777 /var/www/html/tmpimages |
|
2829
|
|
|
|
|
|
|
|
|
2830
|
|
|
|
|
|
|
The 1777 privilege will allow anyone to create files and |
|
2831
|
|
|
|
|
|
|
subdirectories in this directory, but only the owner of the file will |
|
2832
|
|
|
|
|
|
|
be able to delete it. |
|
2833
|
|
|
|
|
|
|
|
|
2834
|
|
|
|
|
|
|
When you call image_and_map(), you must provide it with two vital |
|
2835
|
|
|
|
|
|
|
pieces of information: the URL of the image directory and the physical |
|
2836
|
|
|
|
|
|
|
location of the web server's document tree. In our example, you would |
|
2837
|
|
|
|
|
|
|
call: |
|
2838
|
|
|
|
|
|
|
|
|
2839
|
|
|
|
|
|
|
$panel->image_and_map(-root => '/var/www/html',-url=>'/tmpimages'); |
|
2840
|
|
|
|
|
|
|
|
|
2841
|
|
|
|
|
|
|
If you are working with virtual hosts, you might wish to provide the |
|
2842
|
|
|
|
|
|
|
hostname:portnumber part of the URL. This will work just as well: |
|
2843
|
|
|
|
|
|
|
|
|
2844
|
|
|
|
|
|
|
$panel->image_and_map(-root => '/var/www/html', |
|
2845
|
|
|
|
|
|
|
-url => 'http://myhost.com:8080/tmpimages'); |
|
2846
|
|
|
|
|
|
|
|
|
2847
|
|
|
|
|
|
|
If you do not provide the -root argument, the method will try to |
|
2848
|
|
|
|
|
|
|
figure it out from the DOCUMENT_ROOT environment variable. If you do |
|
2849
|
|
|
|
|
|
|
not provide the -url argument, the method will assume "/tmp". |
|
2850
|
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
During execution, the image_and_map() method will generate a unique |
|
2852
|
|
|
|
|
|
|
name for the image using the Digest::MD5 module. You can get this |
|
2853
|
|
|
|
|
|
|
module on CPAN and it B<must> be installed in order to use |
|
2854
|
|
|
|
|
|
|
image_and_map(). The imagename will be a long hexadecimal string such |
|
2855
|
|
|
|
|
|
|
as "e7457643f12d413f20843d4030c197c6.png". Its URL will be |
|
2856
|
|
|
|
|
|
|
/tmpimages/e7457643f12d413f20843d4030c197c6.png, and its physical path |
|
2857
|
|
|
|
|
|
|
will be /var/www/html/tmpimages/e7457643f12d413f20843d4030c197c6.png |
|
2858
|
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
In addition to providing directory information, you must also tell |
|
2860
|
|
|
|
|
|
|
image_and_map() how to create outgoing links for each graphical |
|
2861
|
|
|
|
|
|
|
feature, and, optionally, how to create the "hover title" (the popup |
|
2862
|
|
|
|
|
|
|
yellow box displayed by most modern browsers), and the name of the |
|
2863
|
|
|
|
|
|
|
window or frame to link to when the user clicks on it. |
|
2864
|
|
|
|
|
|
|
|
|
2865
|
|
|
|
|
|
|
There are three ways to specify the link destination: |
|
2866
|
|
|
|
|
|
|
|
|
2867
|
|
|
|
|
|
|
=over 4 |
|
2868
|
|
|
|
|
|
|
|
|
2869
|
|
|
|
|
|
|
=item 1. |
|
2870
|
|
|
|
|
|
|
|
|
2871
|
|
|
|
|
|
|
By configuring one or more tracks with a -link argument. |
|
2872
|
|
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
|
=item 2. |
|
2874
|
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
By configuring the panel with a -link argument. |
|
2876
|
|
|
|
|
|
|
|
|
2877
|
|
|
|
|
|
|
=item 3. |
|
2878
|
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
By passing a -link argument in the call to image_and_map(). |
|
2880
|
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
=back |
|
2882
|
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
The -link argument can be either a string or a coderef. If you pass a |
|
2884
|
|
|
|
|
|
|
string, it will be interpreted as a URL pattern containing runtime |
|
2885
|
|
|
|
|
|
|
variables. These variables begin with a dollar sign ($), and are |
|
2886
|
|
|
|
|
|
|
replaced at run time with the information relating to the selected |
|
2887
|
|
|
|
|
|
|
annotation. Recognized variables include: |
|
2888
|
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
$name The feature's name (display name) |
|
2890
|
|
|
|
|
|
|
$id The feature's id (eg, PK from a database) |
|
2891
|
|
|
|
|
|
|
$class The feature's class (group class) |
|
2892
|
|
|
|
|
|
|
$method The feature's method (same as primary tag) |
|
2893
|
|
|
|
|
|
|
$source The feature's source |
|
2894
|
|
|
|
|
|
|
$ref The name of the sequence segment (chromosome, contig) |
|
2895
|
|
|
|
|
|
|
on which this feature is located |
|
2896
|
|
|
|
|
|
|
$description The feature's description (notes) |
|
2897
|
|
|
|
|
|
|
$start The start position of this feature, relative to $ref |
|
2898
|
|
|
|
|
|
|
$end The end position of this feature, relative to $ref |
|
2899
|
|
|
|
|
|
|
$length Length of this feature |
|
2900
|
|
|
|
|
|
|
$segstart The left end of $ref displayed in the detailed view |
|
2901
|
|
|
|
|
|
|
$segend The right end of $ref displayed in the detailed view |
|
2902
|
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
For example, to link each feature to a Google search on the feature's |
|
2904
|
|
|
|
|
|
|
description, use the argument: |
|
2905
|
|
|
|
|
|
|
|
|
2906
|
|
|
|
|
|
|
-link => 'http://www.google.com/search?q=$description' |
|
2907
|
|
|
|
|
|
|
|
|
2908
|
|
|
|
|
|
|
Be sure to use single quotes around the pattern, or Perl will attempt |
|
2909
|
|
|
|
|
|
|
to perform variable interpretation before image_and_map() has a chance |
|
2910
|
|
|
|
|
|
|
to work on it. |
|
2911
|
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
You may also pass a code reference to -link, in which case the code |
|
2913
|
|
|
|
|
|
|
will be called every time a URL needs to be generated for the |
|
2914
|
|
|
|
|
|
|
imagemap. The subroutine will be called with two arguments, the |
|
2915
|
|
|
|
|
|
|
feature and the Bio::Graphics::Panel object, and it should return the |
|
2916
|
|
|
|
|
|
|
URL to link to, or an empty string if a link is not desired. Here is a |
|
2917
|
|
|
|
|
|
|
simple example: |
|
2918
|
|
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
-link => sub { |
|
2920
|
|
|
|
|
|
|
my ($feature,$panel) = @_; |
|
2921
|
|
|
|
|
|
|
my $type = $feature->primary_tag; |
|
2922
|
|
|
|
|
|
|
my $name = $feature->display_name; |
|
2923
|
|
|
|
|
|
|
if ($primary_tag eq 'clone') { |
|
2924
|
|
|
|
|
|
|
return "http://www.google.com/search?q=$name"; |
|
2925
|
|
|
|
|
|
|
} else { |
|
2926
|
|
|
|
|
|
|
return "http://www.yahoo.com/search?p=$name"; |
|
2927
|
|
|
|
|
|
|
} |
|
2928
|
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
The -link argument cascades. image_and_map() will first look for a |
|
2930
|
|
|
|
|
|
|
-link option in the track configuration, and if that's not found, it |
|
2931
|
|
|
|
|
|
|
will look in the Panel configuration (created during |
|
2932
|
|
|
|
|
|
|
Bio::Graphics::Panel-E<gt>new). If no -link configuration option is found |
|
2933
|
|
|
|
|
|
|
in either location, then image_and_map() will use the value of -link |
|
2934
|
|
|
|
|
|
|
passed in its argument list, if any. |
|
2935
|
|
|
|
|
|
|
|
|
2936
|
|
|
|
|
|
|
The -title and -target options behave in a similar manner to -link. |
|
2937
|
|
|
|
|
|
|
-title is used to assign each feature "title" and "alt" attributes. |
|
2938
|
|
|
|
|
|
|
The "title" attribute is used by many browsers to create a popup hints |
|
2939
|
|
|
|
|
|
|
box when the mouse hovers over the feature's glyph for a preset length |
|
2940
|
|
|
|
|
|
|
of time, while the "alt" attribute is used to create navigable menu |
|
2941
|
|
|
|
|
|
|
items for the visually impaired. As with -link, you can set the title |
|
2942
|
|
|
|
|
|
|
by passing either a substitution pattern or a code ref, and the -title |
|
2943
|
|
|
|
|
|
|
option can be set in the track, the panel, or the method call itself |
|
2944
|
|
|
|
|
|
|
in that order of priority. |
|
2945
|
|
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
|
If not provided, image_and_map() will autogenerate its own title in |
|
2947
|
|
|
|
|
|
|
the form "E<lt>methodE<gt> E<lt>display_nameE<gt> E<lt>seqidE<gt>:start..end". |
|
2948
|
|
|
|
|
|
|
|
|
2949
|
|
|
|
|
|
|
The -target option can be used to specify the window or frame that |
|
2950
|
|
|
|
|
|
|
clicked features will link to. By default, when the user clicks on a |
|
2951
|
|
|
|
|
|
|
feature, the loaded URL will replace the current page. You can modify |
|
2952
|
|
|
|
|
|
|
this by providing -target with the name of a preexisting or new window |
|
2953
|
|
|
|
|
|
|
name in order to create effects like popup windows, multiple frames, |
|
2954
|
|
|
|
|
|
|
popunders and the like. The value of -target follows the same rules |
|
2955
|
|
|
|
|
|
|
as -title and -link, including variable substitution and the use of |
|
2956
|
|
|
|
|
|
|
code refs. |
|
2957
|
|
|
|
|
|
|
|
|
2958
|
|
|
|
|
|
|
NOTE: Each time you call image_and_map() it will generate a new image |
|
2959
|
|
|
|
|
|
|
file. Images that are identical to an earlier one will reuse the same |
|
2960
|
|
|
|
|
|
|
name, but those that are different, even by one pixel, will result in |
|
2961
|
|
|
|
|
|
|
the generation of a new image. If you have limited disk space, you |
|
2962
|
|
|
|
|
|
|
might wish to check the images directory periodically and remove those |
|
2963
|
|
|
|
|
|
|
that have not been accessed recently. The following cron script will |
|
2964
|
|
|
|
|
|
|
remove image files that haven't been accessed in more than 20 days. |
|
2965
|
|
|
|
|
|
|
|
|
2966
|
|
|
|
|
|
|
30 2 * * * find /var/www/html/tmpimages -type f -atime +20 -exec rm {} \; |
|
2967
|
|
|
|
|
|
|
|
|
2968
|
|
|
|
|
|
|
=head1 BUGS |
|
2969
|
|
|
|
|
|
|
|
|
2970
|
|
|
|
|
|
|
Please report them. |
|
2971
|
|
|
|
|
|
|
|
|
2972
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
2973
|
|
|
|
|
|
|
|
|
2974
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph>, |
|
2975
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::arrow>, |
|
2976
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::cds>, |
|
2977
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::crossbox>, |
|
2978
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::diamond>, |
|
2979
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::dna>, |
|
2980
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::dot>, |
|
2981
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::ellipse>, |
|
2982
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::extending_arrow>, |
|
2983
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::generic>, |
|
2984
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::graded_segments>, |
|
2985
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::heterogeneous_segments>, |
|
2986
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::line>, |
|
2987
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::pinsertion>, |
|
2988
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::primers>, |
|
2989
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::rndrect>, |
|
2990
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::segments>, |
|
2991
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::redgreen_box>, |
|
2992
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::ruler_arrow>, |
|
2993
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::toomany>, |
|
2994
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::transcript>, |
|
2995
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::transcript2>, |
|
2996
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::translation>, |
|
2997
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::triangle>, |
|
2998
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::xyplot>, |
|
2999
|
|
|
|
|
|
|
L<Bio::Graphics::Glyph::whiskerplot>, |
|
3000
|
|
|
|
|
|
|
L<Bio::SeqI>, |
|
3001
|
|
|
|
|
|
|
L<Bio::SeqFeatureI>, |
|
3002
|
|
|
|
|
|
|
L<Bio::Das>, |
|
3003
|
|
|
|
|
|
|
L<GD> |
|
3004
|
|
|
|
|
|
|
L<GD::SVG> |
|
3005
|
|
|
|
|
|
|
L<glyph_help.pl> |
|
3006
|
|
|
|
|
|
|
|
|
3007
|
|
|
|
|
|
|
=head1 AUTHOR |
|
3008
|
|
|
|
|
|
|
|
|
3009
|
|
|
|
|
|
|
Lincoln Stein E<lt>lstein@cshl.orgE<gt> |
|
3010
|
|
|
|
|
|
|
|
|
3011
|
|
|
|
|
|
|
Copyright (c) 2001 Cold Spring Harbor Laboratory |
|
3012
|
|
|
|
|
|
|
|
|
3013
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
|
3014
|
|
|
|
|
|
|
it under the same terms as Perl itself. See DISCLAIMER.txt for |
|
3015
|
|
|
|
|
|
|
disclaimers of warranty. |
|
3016
|
|
|
|
|
|
|
|
|
3017
|
|
|
|
|
|
|
=cut |
|
3018
|
|
|
|
|
|
|
|