[Bio] / FortyEight / RawOrganismGenomeBrowser.pm Repository:
ViewVC logotype

Annotation of /FortyEight/RawOrganismGenomeBrowser.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : paczian 1.1 package RawOrganismGenomeBrowser;
2 :    
3 :     use strict;
4 :     use warnings;
5 :     use URI::Escape;
6 :    
7 :     1;
8 :    
9 :     use CGI qw(:standard);
10 :     use Data::Dumper;
11 :     use FIG;
12 :    
13 :     use GD;
14 :     use GD::Polyline;
15 :     use Math::Trig;
16 :     use List::Util;
17 :     use MIME::Base64;
18 :    
19 :     sub new {
20 :     my ($parameters) = @_;
21 :    
22 :     my $cgi = new CGI;
23 :     my $id = $parameters->{id} || 'genome_browser';
24 :     my $arrow_zoom_level = $parameters->{arrow_zoom_level} || 100000;
25 :    
26 :     my $genome_directory = $parameters->{genome_directory};
27 :     my $genome = $parameters->{genome_id};
28 :    
29 :     my $genome_name = $parameters->{genome_name} || "";
30 :    
31 :     my $contig_lengths = &get_contig_data($genome_directory);
32 :     my $contig = $cgi->param('contig') || (sort(keys(%$contig_lengths)))[0];
33 :    
34 :     # check what to display
35 :     my $show_cds;
36 :     if (defined($cgi->param('show_cds'))) {
37 :     $show_cds = $cgi->param('show_cds');
38 :     }
39 :     my $show_rna;
40 :     if (defined($cgi->param('show_rna'))) {
41 :     $show_rna = $cgi->param('show_rna');
42 :     }
43 :     my $show_pp;
44 :     if (defined($cgi->param('show_pp'))) {
45 :     $show_pp = $cgi->param('show_pp');
46 :     }
47 :     my $show_pi;
48 :     if (defined($cgi->param('show_pi'))) {
49 :     $show_pi = $cgi->param('show_pi');
50 :     }
51 :     if (defined($cgi->param('initial'))) {
52 :     $show_cds = 'on';
53 :     $show_rna = 'on';
54 :     $show_pp = 'on';
55 :     $show_pi = 'on';
56 :     }
57 :    
58 :     my $zoom_select;
59 :     my $frame_select;
60 :     my $curr_frames = $parameters->{frames} || 6;
61 :     my $options;
62 :    
63 :     # determine zoom level
64 :     my $curr_zoom = $contig_lengths->{$contig};
65 :     if (defined($parameters->{zoom_level})) {
66 :     $curr_zoom = $parameters->{zoom_level};
67 :     }
68 :     if ($cgi->param('zoom_level')) {
69 :     $curr_zoom = $cgi->param('zoom_level');
70 :     }
71 :    
72 :     # determine window to display
73 :     my $start = $cgi->param('start') || 1;
74 :     my $end = $cgi->param('end') || $curr_zoom;
75 :    
76 :     # get contig lengths
77 :     my @contigs = sort(keys(%$contig_lengths));
78 :     if (defined($cgi->param('contig'))) {
79 :     $contig = $cgi->param('contig');
80 :     }
81 :    
82 :     # sanity check start and end
83 :     if ($start < 1) {
84 :     $start = 1;
85 :     }
86 :     if ($end > $contig_lengths->{$contig}) {
87 :     $end = $contig_lengths->{$contig};
88 :     }
89 :    
90 :     # check for total view
91 :     if ($curr_zoom eq $contig_lengths->{$contig}) {
92 :     $start = 1;
93 :     $end = $contig_lengths->{$contig};
94 :     }
95 :    
96 :     # calculate window size
97 :     my $window = $end - $start;
98 :    
99 :     # create zoom selector
100 :     $zoom_select = $cgi->popup_menu( -id => $id . "_zoom_select",
101 :     -name => "zoom_level",
102 :     -default => $curr_zoom,
103 :     -onchange => "browse(\"zoom\", \"" . $id . "\");",
104 :     -values => [$contig_lengths->{$contig}, '1000000', '500000', '100000', '20000', '10000', '1000'],
105 :     -labels => {$contig_lengths->{$contig} => 'all','1000000' => '1 Mbp', '500000' => '500 kbp', '100000' => '100 kbp', '20000' => '20 kbp', '10000' => '10 kbp', '1000' => '1 kbp'});
106 :    
107 :     # determine number of reading frames
108 :     if ($cgi->param('frame_num')) {
109 :     $curr_frames = $cgi->param('frame_num');
110 :     }
111 :    
112 :     # create frame selector
113 :     $frame_select = $cgi->popup_menu(-id => $id . "_frame_select",
114 :     -name => "frame_num",
115 :     -default => $curr_frames,
116 :     -values => ['6', '2', '1'],
117 :     -labels => {'6' => 'all', '2' => '+/-', '1' => 'single'});
118 :    
119 :     # create options panel
120 :     $options = "<table><tr style='display: none;'><td><b>Options</b></td></tr><tr><td>Reading Frames</td></tr><tr><td>" . $frame_select . "</td></tr><tr style='display: none;'><td>" . $cgi->checkbox(-name => 'show_cds', -checked => $show_cds, -label => '') . get_minibox(19). 'Show CDS' . "</td></tr><tr style='display: none;'><td>" . $cgi->checkbox(-name => 'show_rna', -checked => $show_rna, -label => '') . get_minibox(0). 'Show RNA' . "</td></tr><tr style='display: none;'><td>" . $cgi->checkbox(-name => 'show_pi', -checked => $show_pi, -label => '') . get_minibox(5) . 'Show Pathogenicity' . "</td></tr><tr style='display: none;'><td>" . $cgi->checkbox(-name => 'show_pp', -checked => $show_pp, -label => ''). get_minibox(4) . 'Show Prophages' . "</td></tr><tr><td><input type='submit' value='Refresh'></td></tr></table>";
121 :    
122 :     # id, location, aliases, type, minloc, maxloc, assigned_function, made_by, quality
123 :     my $all_features = get_visible_features($genome_directory, $contig, $start, $end);
124 :     unless (@$all_features) {
125 :     $all_features = [];
126 :     }
127 :    
128 :     # collect the data for the different frame options
129 :     my $data_plus_frame_0;
130 :     my $data_plus_frame_1;
131 :     my $data_plus_frame_2;
132 :     my $data_middle;
133 :     my $data_minus_frame_0;
134 :     my $data_minus_frame_1;
135 :     my $data_minus_frame_2;
136 :     my $data_plus;
137 :     my $data_minus;
138 :     my @overlay_resolved_data;
139 :    
140 :     my $data_all;
141 :     my $peg_type = 'arrow';
142 :     if (($end - $start) > $arrow_zoom_level) {
143 :     $peg_type = 'box';
144 :     }
145 :    
146 :     foreach my $feature (@$all_features) {
147 :     # assign feature attributes
148 :     my ($peg_id, $cds_start, $cds_end, $function, $subsystem) = @$feature;
149 :    
150 :     my $description = [];
151 :     my $category = 1;
152 :     my $name = "";
153 :     my $title = '';
154 :     my $zlayer = 1;
155 :     my $strong = 0;
156 :     my $type;
157 :     my $featuretype;
158 :     if ($peg_id =~ /peg/) { $featuretype = 'peg'; }
159 :     elsif ($peg_id =~ /rna/) { $featuretype = 'rna'; }
160 :     elsif ($peg_id =~ /pp/) { $featuretype = 'pp'; }
161 :     elsif ($peg_id =~ /pi/) { $featuretype = 'pi'; }
162 :     else { $featuretype = 'unknown'; }
163 :    
164 :     push(@$description, { title => 'ID', value => $peg_id || "" });
165 :    
166 :     my $no_frame = 0;
167 :     if ($featuretype eq 'peg') {
168 :     unless ($show_cds) { next; }
169 :     $title = 'CDS Information';
170 :     $zlayer = 2;
171 :     $category = 0;
172 :     if (defined($parameters->{clusters})) {
173 :     if (exists($parameters->{clusters}->{$peg_id})) {
174 :     $category = $parameters->{clusters}->{$peg_id};
175 :     $name = $category;
176 :     }
177 :     }
178 :     if (defined($parameters->{coupling})) {
179 :     if (exists($parameters->{coupling}->{$peg_id})) {
180 :     push(@$all_features, [ $peg_id, $feature->[1], $feature->[2], 'cluster', $feature->[4], $feature->[5], $function, $feature->[7], $feature->[8], $cds_start, $cds_end ]);
181 :     }
182 :     }
183 :     $type = $peg_type;
184 :     push(@$description, { title => 'Function', value => $function || "" });
185 :     } elsif ($featuretype eq 'rna') {
186 :     unless ($show_rna) { next; }
187 :     $title = 'RNA Information';
188 :     $zlayer = 3;
189 :     $category = 3;
190 :     $type = 'box';
191 :     $no_frame = 1;
192 :     } elsif ($featuretype eq 'pp') {
193 :     $zlayer = 1;
194 :     unless ($show_pp) { next; }
195 :     $title = 'Prophage Information';
196 :     $category = 4;
197 :     $type = 'box';
198 :     $no_frame = 1;
199 :     } elsif ($featuretype eq 'pi') {
200 :     $zlayer = 2;
201 :     unless ($show_pi) { next; }
202 :     $title = 'Pathogenicity Island Information';
203 :     $category = 5;
204 :     $type = 'box';
205 :     $no_frame = 1;
206 :     } elsif ($featuretype eq 'cluster') {
207 :     $zlayer = 1;
208 :     $title = 'Clustered Gene';
209 :     $category = 0;
210 :     $type = 'bigbox';
211 :     $no_frame = 0;
212 :     } else {
213 :     $zlayer = 1;
214 :     $title = 'Unknown Entity';
215 :     $category = 0;
216 :     $type = 'box';
217 :     $no_frame = 1;
218 :     }
219 :     push(@$description, { title => 'Contig', value => $contig },
220 :     { title => 'Start', value => $cds_start },
221 :     { title => 'Stop', value => $cds_end },
222 :     { title => 'Length', value => abs($cds_start - $cds_end) . ' bp' });
223 :    
224 :     my $links_list = [ { link => 'index.cgi?action=ShowAnnotation&prot=' . $peg_id, linktitle => 'View Annotation' }];
225 :    
226 :     push(@$links_list, { link => 'index.cgi?action=ShowOrganism&subaction=BrowseGenome&genome=' . $genome . '&start=' . ($cds_start - 5000) . '&end=' . ($cds_end + 5000) . '&initial=1&zoom_level=20000', linktitle => 'Zoom on Area' });
227 :    
228 :     # if the menu contains only one link, make it onclick instead of menu
229 :     my $onclick;
230 :     if (scalar(@$links_list) == 1) {
231 :     $onclick = "location='" . $links_list->[0]->{link} . "';";
232 :     $links_list = undef;
233 :     }
234 :    
235 :     my $values = { start => $cds_start,
236 :     end => $cds_end,
237 :     title => $title,
238 :     zlayer => $zlayer,
239 :     name => $name || "",
240 :     type => $type,
241 :     category => $category,
242 :     onclick => $onclick,
243 :     links_list => $links_list,
244 :     strong => $strong,
245 :     description => $description };
246 :     if (defined($feature->[11])) {
247 :     $values->{highlight} = 1;
248 :     }
249 :    
250 :     if ($curr_frames eq 'resolve') {
251 :     my $not_inserted = 1;
252 :     foreach my $overlay_line (@overlay_resolved_data) {
253 :     my $no_overlay = 1;
254 :     foreach my $item (@$overlay_line) {
255 :     if (
256 :     (($cds_start > min($item->{start}, $item->{end})) && ($cds_start < max($item->{start}, $item->{end}))) ||
257 :     (($cds_end > min($item->{start}, $item->{end})) && ($cds_end < max($item->{start}, $item->{end}))) ||
258 :     ((min($cds_start, $cds_end) < min($item->{start}, $item->{end})) && (max($cds_start, $cds_end) > max($item->{start}, $item->{end}))))
259 :     {
260 :     $no_overlay = 0;
261 :     last;
262 :     }
263 :     }
264 :     if ($no_overlay) {
265 :     push(@$overlay_line, $values);
266 :     $not_inserted = 0;
267 :     last;
268 :     }
269 :     }
270 :     if ($not_inserted) {
271 :     push(@overlay_resolved_data, [ $values ]);
272 :     }
273 :     }
274 :     push(@$data_all, $values);
275 :     if ($no_frame) {
276 :     push(@$data_middle, $values);
277 :     } else {
278 :     if ($cds_start < $cds_end) {
279 :     push(@$data_plus, $values);
280 :     if (($cds_start % 3) == 0) {
281 :     push(@$data_plus_frame_0, $values);
282 :     } elsif (($cds_start % 3) == 1) {
283 :     push(@$data_plus_frame_1, $values);
284 :     } else {
285 :     push(@$data_plus_frame_2, $values);
286 :     }
287 :     } else {
288 :     push(@$data_minus, $values);
289 :     if (($cds_end % 3) == 0) {
290 :     push(@$data_minus_frame_0, $values);
291 :     } elsif (($cds_end % 3) == 1) {
292 :     push(@$data_minus_frame_1, $values);
293 :     } else {
294 :     push(@$data_minus_frame_2, $values);
295 :     }
296 :     }
297 :     }
298 :     }
299 :    
300 :     # determine number of frames to be displayed
301 :     my $data;
302 :     my $line_config;
303 :    
304 :     # adjust length of organism name to max. 15 characters
305 :     my $organism_name = $parameters->{organism} || "";
306 :     my $organism_short_name = $organism_name;
307 :     if (length($organism_short_name) > 14) {
308 :     my $cutoff = length($organism_short_name) - 13;
309 :     $organism_short_name =~ /^(\w+)/;
310 :     my $new_first = $1;
311 :     if ((length($new_first) - $cutoff) < 3) {
312 :     $new_first = substr($new_first, 0, 1) . ".";
313 :     $organism_short_name =~ s/^(\w+)/$new_first/;
314 :     $organism_short_name = substr($organism_short_name, 0, 14);
315 :    
316 :     } else {
317 :     $new_first = substr($new_first, 0, length($new_first) - $cutoff) . ".";
318 :     $organism_short_name =~ s/^(\w+)/$new_first/;
319 :     }
320 :     }
321 :    
322 :     if ($curr_frames eq '6') {
323 :     $data = [ $data_plus_frame_0,
324 :     $data_plus_frame_1,
325 :     $data_plus_frame_2,
326 :     $data_middle,
327 :     $data_minus_frame_0,
328 :     $data_minus_frame_1,
329 :     $data_minus_frame_2 ];
330 :     $line_config = [ { height => 26, style => 'arrowline', title => "+2" },
331 :     { height => 26, style => 'arrowline', title => "+1" },
332 :     { height => 26, style => 'arrowline', title => "+0" },
333 :     { height => 26, style => 'arrowline', title => $organism_name, short_title => $organism_short_name , title_link => "" },
334 :     { height => 26, style => 'arrowline', title => "-0" },
335 :     { height => 26, style => 'arrowline', title => "-1" },
336 :     { height => 26, style => 'arrowline', title => "-2" } ];
337 :     } elsif ($curr_frames eq '2') {
338 :     $data = [ $data_plus,
339 :     $data_middle,
340 :     $data_minus ];
341 :     unless ($organism_short_name) {
342 :     $organism_short_name = " ";
343 :     }
344 :     $line_config = [ { height => 26, style => 'arrowline', title => "$organism_name", short_title => $organism_short_name . " +", title_link => "" },
345 :     { height => 26, style => 'arrowline', title => $organism_name, short_title => $organism_short_name , title_link => "" },
346 :     { height => 26, style => 'arrowline', title => " -" } ];
347 :     } elsif ($curr_frames eq 'resolve') {
348 :     $data = [ @overlay_resolved_data ];
349 :     my $first = 1;
350 :     foreach (@overlay_resolved_data) {
351 :     if ($first) {
352 :     $first = 0;
353 :     push(@$line_config, { height => 26, style => 'arrowline', title => "$organism_name", short_title => $organism_short_name, title_link => "" });
354 :     } else {
355 :     push(@$line_config, { height => 26, style => 'arrowline', title => "" });
356 :     }
357 :     }
358 :     } else {
359 :     $data = [ $data_all ];
360 :     $line_config = [ { height => 26, style => 'arrowline', title => "$organism_name", short_title => $organism_short_name, title_link => "" } ];
361 :     }
362 :    
363 :     # initialize html variable
364 :     my $html = "";
365 :    
366 :     # create contig select
367 :     my $contig_select = "<td>Contig <select name='contig' onchange='genome_browser_form_" . $id . ".submit();'>";
368 :     foreach my $contig_name (@contigs) {
369 :     my $selected = "";
370 :     if (defined($cgi->param('contig'))) {
371 :     if ($cgi->param('contig') eq $contig_name) {
372 :     $selected = " selected=selected";
373 :     }
374 :     }
375 :     $contig_select .= "<option value='$contig_name'$selected>$contig_name</option>";
376 :     }
377 :     $contig_select .= "</select></td>";
378 :     if (scalar(@contigs) == 0) {
379 :     $contig_select = "";
380 :     }
381 :    
382 :     # start form
383 : paarmann 1.2 $html .= "<div><form action='rast.cgi' method='post' id='" . $id . "_form' name='genome_browser_form_" . $id . "'>";
384 : paczian 1.1 $html .= "<input type=hidden name='page' value='BrowseGenome'>";
385 :     $html .= "<input type=hidden name='gsize' id='" . $id . "_gsize' value='" . $contig_lengths->{$contig} . "'>";
386 :     $html .= "<input type=hidden name='genome' value='" . ($cgi->param('genome') || "") . "'>";
387 :     $html .= "<input type=hidden name='job' value='" . ($cgi->param('job') || "") . "'>";
388 :    
389 :     $html .= "<table><tr><td colspan=8 align=center>Show bases <input type='text' name='start' id='" . $id . "_start' value='$start'> to <input type='text' name='end' id='" . $id . "_end' value='$end'></td><td rowspan=4>" . $options . "</td></tr>";
390 :     $html .="<tr><td align=center><input type='button' value='<<' onclick='browse(\"left_far\", \"" . $id . "\");'></td><td align=center><input type='button' value='<' onclick='browse(\"left\", \"" . $id . "\");'></td><td align=center><input type='button' value='zoom in' onclick='browse(\"zoom_in\", \"" . $id . "\");'></td><td>" . $zoom_select . "</td>" . $contig_select . "<td align=center><input type='button' value='zoom out' onclick='browse(\"zoom_out\", \"" . $id . "\");'></td><td align=center><input type='button' value='>' onclick='browse(\"right\", \"" . $id . "\");'></td><td align=center><input type='button' value='>>' onclick='browse(\"right_far\", \"" . $id . "\");'></td></tr>";
391 :     $html .= "<input type=hidden name=genome value='" . $genome . "'><br/>";
392 :    
393 :     # insert a navigation image
394 :     $html .= "<tr><td colspan=8>" . getNavigation($contig_lengths->{$contig}, $start, $end - $start, 800, 25, $id) . "</td></tr>";
395 :    
396 :     $html .= "<tr><td colspan=8>";
397 :    
398 :     # produce the image
399 :     $html .= get_image( {
400 :     data => $data,
401 :     start => $start,
402 :     end => $end,
403 :     line_config => $line_config,
404 :     width => 625,
405 :     legend_width => 100,
406 :     show_names_in_graphic => 1,
407 :     id => $id
408 :     } );
409 :    
410 :     # close table
411 :     $html .= "</td></tr></table></div>";
412 :    
413 :     # close form
414 :     $html .= "</form>";
415 :    
416 :     # return the html
417 :     return $html;
418 :     }
419 :    
420 :     sub get_image {
421 :     my ($params) = @_;
422 :    
423 :     # get mandatory values
424 :     my $data = $params->{data};
425 :     my $start = $params->{start};
426 :     my $end = $params->{end};
427 :     my $id = $params->{id};
428 :    
429 :     # get optional values
430 :     my $width = $params->{width} || 500;
431 :     my $line_height = $params->{line_height} || 40;
432 :     my $arrow_head_width = $params->{arrow_head_width} || 8;
433 :     my $line_config = $params->{line_config} || undef;
434 :     my $show_names_in_graphic = $params->{show_names_in_graphic};
435 :     my $legend_width = $params->{legend_width} || 100;
436 :    
437 :     # calculate resulting values
438 :     my $numlines = scalar(@$data);
439 :    
440 :     # check for line configurations
441 :     unless (defined($line_config)) {
442 :     for (my $i=0; $i<$numlines; $i++) {
443 :     push(@$line_config, { height => $line_height, style => 'line' } );
444 :     }
445 :     }
446 :    
447 :     my $height = 0;
448 :     foreach my $line (@$line_config) {
449 :     $height = $height + $line->{height};
450 :     }
451 :     my $scale_width = $width / ($end - $start);
452 :    
453 :     # initialize image and colors
454 :     my $colorset = getColors();
455 :    
456 :     my $im = new GD::Image($width + $legend_width, $height);
457 :     my $white = $im->colorResolve($colorset->[0]->[0], $colorset->[0]->[1], $colorset->[0]->[2]);
458 :    
459 :     my $item_colors = allocateColors($colorset, $im);
460 :    
461 :     $im->filledRectangle(1, 1, $width - 2, $height - 2, $item_colors->[0]);
462 :    
463 :     # create image map
464 :     my $map = "<map name='imap_$id'>";
465 :     my @maparray;
466 :    
467 :     # draw lines
468 :     my $i = 0;
469 :     my $y_offset = 0;
470 :     my $x_offset = $legend_width;
471 :     foreach my $line (@$data) {
472 :    
473 :     # check line-style
474 :     if ($line_config->[$i]->{style} eq 'line') {
475 :     $im->line($x_offset, $y_offset + ($line_config->[$i]->{height} / 2), $width + $x_offset, $y_offset + ($line_config->[$i]->{height} / 2), $item_colors->[1]);
476 :     } elsif (($line_config->[$i]->{style} eq 'arrowline') || ($line_config->[$i]->{style} eq 'scale')) {
477 :     $im->line($x_offset, $y_offset + 3 + ($line_config->[$i]->{height} / 2), $width + $x_offset, $y_offset + 3 + ($line_config->[$i]->{height} / 2), $item_colors->[1]);
478 :     }
479 :    
480 :     # check for description of line
481 :     if (defined($line_config->[$i]->{title})) {
482 :     my $short_title = undef;
483 :     if (defined($line_config->[$i]->{short_title})) {
484 :     $short_title = $line_config->[$i]->{short_title};
485 :     }
486 :     my $onclick = " ";
487 :     if (defined($line_config->[$i]->{title_link})) {
488 :     $onclick .= "onclick=\"" . $line_config->[$i]->{title_link} . "\"";
489 :     }
490 :    
491 :     my $tooltip = "onMouseover=\"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this,'Organism','" . $line_config->[$i]->{title} . "','');this.tooltip.addHandler();return true;\"";
492 :     if (defined($short_title) || defined($line_config->[$i]->{title_link})) {
493 :     push(@maparray, '<area shape="rect" coords="' . join(',', 2, $y_offset, $x_offset, $y_offset + $line_config->[$i]->{height}) . "\" " . $tooltip . $onclick . ' onMouseout="window.status=\'\';hidetip();return true;">');
494 :     } else {
495 :     $short_title = $line_config->[$i]->{title};
496 :     }
497 :    
498 :     $im->string(gdSmallFont, 2, $y_offset + ($line_config->[$i]->{height} / 2) - 4, $short_title, $item_colors->[1]);
499 :     }
500 :    
501 :     # sort items according to z-layer
502 :     if (defined($line)) {
503 :     my @sortline = sort { $a->{zlayer} <=> $b->{zlayer} } @$line;
504 :     $line = \@sortline;
505 :     }
506 :    
507 :     # draw items
508 :     foreach my $item (@$line) {
509 :    
510 :     if ($item->{type} eq "scale") {
511 :     $item->{start} = 0;
512 :     $item->{end} = 0;
513 :     $item->{name} = "-";
514 :     $item->{title} = "";
515 :     }
516 :    
517 :     # set to default fill color
518 :     my $fillcolor = $item_colors->[4];
519 :     my $framecolor = $item_colors->[1];
520 :    
521 :     if ($item->{type} eq "arrow") {
522 :     $fillcolor = $item_colors->[3];
523 :     if (defined($item->{highlight})) {
524 :     $fillcolor = $item_colors->[2];
525 :     $framecolor = $item_colors->[1];
526 :     }
527 :     } elsif ($item->{type} eq "box") {
528 :     $fillcolor = $item_colors->[5];
529 :     }
530 :    
531 :     # check for multi-coloring
532 :     if (defined($item->{category})) {
533 :     $fillcolor = $item_colors->[$item->{category} + 3];
534 :     if (defined($item->{highlight})) {
535 :     $fillcolor = $item_colors->[2];
536 :     }
537 :     }
538 :    
539 :     my $i_start = 0;
540 :     my $i_end = 0;
541 :    
542 :     # create params hash
543 :     my $item_params = {
544 :     start => $scale_width * ($item->{start} - $start),
545 :     end => $scale_width * ($item->{end} - $start),
546 :     ypos => $y_offset,
547 :     image => $im,
548 :     fillcolor => $fillcolor,
549 :     framecolor => $framecolor,
550 :     labelcolor => $item_colors->[1],
551 :     item_height => $line_config->[$i]->{height},
552 :     width => $width,
553 :     x_offset => $x_offset,
554 :     strong => $item->{strong},
555 :     title => $item->{title} || ""
556 :     };
557 :    
558 :     if ($show_names_in_graphic) {
559 :     $item_params->{label} = $item->{name} || "";
560 :     } else {
561 :     $item_params->{label} = "";
562 :     }
563 :    
564 :     # determine type of item to draw
565 :     unless (defined($item->{type})) {
566 :    
567 :     } elsif ($item->{type} eq "arrow") {
568 :    
569 :     # set item specific params
570 :     $item_params->{arrow_head_width} = $arrow_head_width;
571 :    
572 :     # call draw item function
573 :     ($im, $i_start, $i_end) = draw_arrow($item_params);
574 :     } elsif ($item->{type} eq "box") {
575 :    
576 :     # call draw item function
577 :     ($im, $i_start, $i_end) = draw_box($item_params);
578 :    
579 :     } elsif ($item->{type} eq "smallbox") {
580 :    
581 :     # call draw item function
582 :     ($im, $i_start, $i_end) = draw_smallbox($item_params);
583 :    
584 :     } elsif ($item->{type} eq "bigbox") {
585 :    
586 :     # call draw item function
587 :     ($im, $i_start, $i_end) = draw_bigbox($item_params);
588 :    
589 :     } elsif ($item->{type} eq "scale") {
590 :    
591 :     # set item specific params
592 :     $item_params->{scaleitems} = $item->{scaleitems} || 10;
593 :    
594 :     # call draw item function
595 :     $im = draw_scale($item_params);
596 :     } elsif ($item->{type} eq "ellipse") {
597 :    
598 :     # call draw item function
599 :     ($im, $i_start, $i_end) = draw_ellipse($item_params);
600 :     }
601 :    
602 :     # add item to image map
603 :     my $menu = "";
604 :     my $info = "<table>";
605 :     if (exists($item->{description})) {
606 :     foreach my $desc_item (@{$item->{description}}) {
607 :     $desc_item->{value} =~ s/(.{50})/$1<br\/>/g;
608 :     $desc_item->{value} =~ s/'/`/g;
609 :     $desc_item->{value} =~ s/"/``/g;
610 :    
611 :     $info .= "<tr><td style=&quot;vertical-align: top; padding-right: 10px;&quot;><b>" . $desc_item->{title} . "</b></td><td>" . $desc_item->{value} . "</td></tr>";
612 :     }
613 :     }
614 :     if (defined($item->{links_list})) {
615 :     $menu .= "<table>";
616 :     foreach my $link (@{$item->{links_list}}) {
617 :     $menu .= "<tr><td><a href=&quot;" . $link->{link} . "&quot;>" . $link->{linktitle} . "</a></td></tr>";
618 :     }
619 :     $menu .= "</table>";
620 :     }
621 :     $info .= "</table>";
622 :     my $tooltip = "onMouseover=\"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this,'" . $item->{title} . "','".$info."','".$menu."');this.tooltip.addHandler();return true;\"";
623 :    
624 :     my $onclick = " ";
625 :     if ($item->{onclick}) {
626 :     $onclick .= "onclick=\"" . $item->{onclick} . "\"";
627 :     }
628 :     push(@maparray, '<area shape="rect" coords="' . join(',', $x_offset + $i_start, $y_offset, $x_offset + $i_end, $y_offset + $line_config->[$i]->{height}) . "\" " . $tooltip . $onclick . ' onMouseout="window.status=\'\';hidetip();return true;">');
629 :     }
630 :    
631 :     # calculate y-offset
632 :     $y_offset = $y_offset + $line_config->[$i]->{height};
633 :    
634 :     # increase counter
635 :     $i++;
636 :     }
637 :    
638 :     # create inline gif
639 :     my $encoded = MIME::Base64::encode($im->png());
640 :    
641 :     # finish image map
642 :     $map .= join("\n", reverse(@maparray));
643 :     $map .= "</map>";
644 :    
645 :     # create html
646 :     my $image = qq~<img style="border: none;" src="data:image/gif;base64,~ . $encoded . qq~" usemap="#imap_$id">~ . $map;
647 :    
648 :     # return image string
649 :     return $image;
650 :     }
651 :    
652 :     # supplementary drawing methods
653 :    
654 :     # draw a scale
655 :     sub draw_scale {
656 :     my ($params) = @_;
657 :    
658 :     # required parameters
659 :     my $ypos = $params->{ypos};
660 :     my $im = $params->{image};
661 :     my $scaleitems = $params->{scaleitems};
662 :     my $item_height = $params->{item_height};
663 :     my $width = $params->{width};
664 :     my $linecolor = $params->{framecolor};
665 :     my $x_offset = $params->{x_offset};
666 :    
667 :     # optional parameters
668 :     my $scaleheight = $params->{scaleheight} || 7;
669 :    
670 :     # precalculations
671 :     my $padding = int($width / $scaleitems);
672 :     $ypos = 3 + int($ypos + ($item_height / 2));
673 :     my $y1 = $ypos - int($scaleheight / 2);
674 :     my $y2 = $ypos + int($scaleheight / 2);
675 :    
676 :     # draw scales
677 :     for (my $i=0; $i<$scaleitems; $i++) {
678 :     my $xpos = $i * $padding + $x_offset;
679 :     $im->line($xpos, $y1, $xpos, $y2, $linecolor);
680 :     }
681 :    
682 :     return $im;
683 :     }
684 :    
685 :     # draw an arrow
686 :     sub draw_arrow {
687 :     my ($params) = @_;
688 :    
689 :     # required parameters
690 :     my $start = $params->{start};
691 :     my $end = $params->{end};
692 :     my $ypos = $params->{ypos};
693 :     my $im = $params->{image};
694 :     my $fillcolor = $params->{fillcolor};
695 :     my $framecolor = $params->{framecolor};
696 :     my $labelcolor = $params->{labelcolor};
697 :     my $x_offset = $params->{x_offset};
698 :     my $strong = $params->{strong};
699 :    
700 :     # optional parameters
701 :     my $arrow_height = $params->{item_height};
702 :     my $arrow_head_width = $params->{arrow_head_width};
703 :     my $label = $params->{label} || "";
704 :     my $linepadding = $params->{linepadding} || 10;
705 :    
706 :     # precalculations
707 :     my $direction = 1;
708 :     if ($start > $end) {
709 :     $direction = 0;
710 :     my $x = $start;
711 :     $start = $end;
712 :     $end = $x;
713 :     }
714 :     if ($start < 0) {
715 :     $start = 0;
716 :     }
717 :     if ($end < 0) {
718 :     return ($im, $start, $end);
719 :     }
720 :     $arrow_height = $arrow_height - $linepadding;
721 :     $ypos = $ypos + 8;
722 :     my $boxpadding = $arrow_height / 5;
723 :     my $fontheight = 12;
724 :    
725 :     # draw arrow
726 :     my $arrowhead = new GD::Polygon;
727 :    
728 :     # calculate x-pos for title
729 :     my $string_start_x_right = $x_offset + $start + (($end - $start - $arrow_head_width) / 2) - (length($label) * 6 / 2);
730 :     my $string_start_x_left = $x_offset + $start + (($end - $start + $arrow_head_width) / 2) - (length($label) * 6 / 2);
731 :    
732 :     # check for arrow direction
733 :     if ($direction) {
734 :    
735 :     # draw arrow box
736 :     if ($arrow_head_width < ($end - $start)) {
737 :     if ($strong) { $im->setThickness(2); }
738 :     $im->rectangle($x_offset + $start,$ypos + $boxpadding,$x_offset + $end - $arrow_head_width,$ypos + $arrow_height - $boxpadding + 1, $framecolor);
739 :     $im->setThickness(1);
740 :     } else {
741 :     $arrow_head_width = $end - $start;
742 :     }
743 :    
744 :     # calculate arrowhead
745 :     $arrowhead->addPt($x_offset + $end - $arrow_head_width, $ypos);
746 :     $arrowhead->addPt($x_offset + $end, $ypos + ($arrow_height / 2));
747 :     $arrowhead->addPt($x_offset + $end - $arrow_head_width, $ypos + $arrow_height);
748 :    
749 :     # draw label
750 :     $im->string(gdSmallFont, $string_start_x_right, $ypos + $boxpadding - $fontheight - 2, $label, $labelcolor);
751 :    
752 :     # draw arrowhead
753 :     $im->filledPolygon($arrowhead, $fillcolor);
754 :     if ($strong) { $im->setThickness(2); }
755 :     $im->polygon($arrowhead, $framecolor);
756 :     $im->setThickness(1);
757 :    
758 :     # draw arrow content
759 :     $im->filledRectangle($x_offset + $start + 1,$ypos + $boxpadding + 1,$x_offset + $end - $arrow_head_width,$ypos + $arrow_height - $boxpadding - $strong,$fillcolor);
760 :    
761 :     } else {
762 :    
763 :     # draw arrow box
764 :     if ($arrow_head_width < ($end - $start)) {
765 :     if ($strong) { $im->setThickness(2); }
766 :     $im->rectangle($x_offset + $start + $arrow_head_width,$ypos + $boxpadding,$x_offset + $end,$ypos + $arrow_height - $boxpadding + 1, $framecolor);
767 :     $im->setThickness(1);
768 :     } else {
769 :     $arrow_head_width = $end - $start;
770 :     }
771 :    
772 :     # calculate arrowhead
773 :     $arrowhead->addPt($x_offset + $start + $arrow_head_width, $ypos);
774 :     $arrowhead->addPt($x_offset + $start, $ypos + ($arrow_height / 2));
775 :     $arrowhead->addPt($x_offset + $start + $arrow_head_width, $ypos + $arrow_height);
776 :    
777 :     # draw label
778 :     $im->string(gdSmallFont, $string_start_x_left, $ypos + $boxpadding - $fontheight - 2, $label, $labelcolor);
779 :    
780 :     # draw arrowhead
781 :     $im->filledPolygon($arrowhead, $fillcolor);
782 :     if ($strong) { $im->setThickness(2); }
783 :     $im->polygon($arrowhead, $framecolor);
784 :     $im->setThickness(1);
785 :    
786 :     # draw arrow content
787 :     $im->filledRectangle($x_offset + $start + $arrow_head_width - 1,$ypos + $boxpadding + 1,$x_offset + $end - 1,$ypos + $arrow_height - $boxpadding - $strong,$fillcolor);
788 :    
789 :     }
790 :    
791 :     return ($im, $start, $end);
792 :     }
793 :    
794 :     # draw a small box
795 :     sub draw_smallbox {
796 :     my ($params) = @_;
797 :    
798 :     # required parameters
799 :     my $start = $params->{start};
800 :     my $end = $params->{end};
801 :     my $ypos = $params->{ypos};
802 :     my $im = $params->{image};
803 :     my $fillcolor = $params->{fillcolor};
804 :     my $framecolor = $params->{framecolor};
805 :     my $x_offset = $params->{x_offset};
806 :    
807 :     # optional parameters
808 :     my $linepadding = $params->{linepadding} || 10;
809 :     my $box_height = $params->{item_height} - 2 - $linepadding;
810 :     $ypos = $ypos + 10;
811 :     my $boxpadding = $box_height / 5;
812 :     $box_height = $box_height - 2;
813 :    
814 :     # precalculations
815 :     if ($start > $end) {
816 :     my $x = $start;
817 :     $start = $end;
818 :     $end = $x;
819 :     }
820 :    
821 :     # draw box
822 :     $im->rectangle($x_offset + $start,$ypos + $boxpadding,$x_offset + $end,$ypos + $box_height - $boxpadding, $framecolor);
823 :    
824 :     # draw box content
825 :     $im->filledRectangle($x_offset + $start + 1,$ypos + $boxpadding + 1,$x_offset + $end - 1,$ypos + $box_height - 1 - $boxpadding,$fillcolor);
826 :    
827 :     return ($im, $start, $end);
828 :     }
829 :    
830 :     # draw a big box
831 :     sub draw_bigbox {
832 :     my ($params) = @_;
833 :    
834 :     # required parameters
835 :     my $start = $params->{start};
836 :     my $end = $params->{end};
837 :     my $ypos = $params->{ypos};
838 :     my $im = $params->{image};
839 :     my $fillcolor = $params->{fillcolor};
840 :     my $framecolor = $params->{framecolor};
841 :     my $x_offset = $params->{x_offset};
842 :    
843 :     # optional parameters
844 :     my $box_height = $params->{item_height} - 1;
845 :    
846 :     # precalculations
847 :     if ($start > $end) {
848 :     my $x = $start;
849 :     $start = $end;
850 :     $end = $x;
851 :     }
852 :    
853 :     # draw box
854 :     #$im->rectangle($x_offset + $start - 1,$ypos,$x_offset + $end + 1,$ypos + $box_height, $framecolor);
855 :    
856 :     # draw box content
857 :     $im->filledRectangle($x_offset + $start-2,$ypos-2,$x_offset + $end+2,$ypos + $box_height+2,$fillcolor);
858 :    
859 :     return ($im, $start, $end);
860 :     }
861 :    
862 :     # draw a box
863 :     sub draw_box {
864 :     my ($params) = @_;
865 :    
866 :     # required parameters
867 :     my $start = $params->{start};
868 :     my $end = $params->{end};
869 :     my $ypos = $params->{ypos};
870 :     my $im = $params->{image};
871 :     my $fillcolor = $params->{fillcolor};
872 :     my $framecolor = $params->{framecolor};
873 :     my $x_offset = $params->{x_offset};
874 :    
875 :     # optional parameters
876 :     my $box_height = $params->{item_height} - 2;
877 :    
878 :     # precalculations
879 :     if ($start > $end) {
880 :     my $x = $start;
881 :     $start = $end;
882 :     $end = $x;
883 :     }
884 :    
885 :     $ypos = $ypos + 8;
886 :     $box_height = $box_height - 8;
887 :    
888 :     # draw box
889 :     $im->filledRectangle($x_offset + $start,$ypos,$x_offset + $end,$ypos + $box_height,$fillcolor);
890 :    
891 :     return ($im, $start, $end);
892 :     }
893 :    
894 :     # draw a ellipse
895 :     sub draw_ellipse {
896 :     my ($params) = @_;
897 :    
898 :     # required parameters
899 :     my $start = $params->{start};
900 :     my $end = $params->{end};
901 :     my $ypos = $params->{ypos};
902 :     my $im = $params->{image};
903 :     my $lineheight = $params->{item_height};
904 :     my $fillcolor = $params->{fillcolor};
905 :     my $framecolor = $params->{framecolor};
906 :     my $x_offset = $params->{x_offset};
907 :    
908 :     # precalculations
909 :     if ($start > $end) {
910 :     my $x = $start;
911 :     $start = $end;
912 :     $end = $x;
913 :     }
914 :     $im->filledEllipse($x_offset + $start + ($end - $start),$ypos + ($lineheight / 2),$x_offset + $end - $start,$lineheight - 6,$fillcolor);
915 :     $im->ellipse($x_offset + $start + ($end - $start),$ypos + ($lineheight / 2),$x_offset + $end - $start,$lineheight - 4,$framecolor);
916 :    
917 :     return ($im, $start, $end);
918 :     }
919 :    
920 :     sub getColors {
921 :     my $colorset = [
922 :     [ 255, 255, 255 ],
923 :     [ 0, 0, 0 ],
924 :     [ 235, 5, 40 ],
925 :     [ 200, 200, 200 ],
926 :     [ 170, 205, 120 ], #1
927 :     [ 50, 255, 50 ],
928 :     [ 60, 60, 190 ],
929 :     [ 145, 175, 160 ],
930 :     [ 255, 145, 60 ],
931 :     [ 0, 0, 155 ],
932 :     [ 255, 221, 0 ],
933 :     [ 0, 155, 155 ],
934 :     [ 200, 100, 200 ],
935 :     [ 27, 133, 52 ],
936 :     [ 135, 65, 65 ],
937 :     [ 0, 90, 255 ],
938 :     [ 95, 100, 100 ],
939 :     [ 80, 210, 150 ],
940 :     [ 225, 250, 160 ],
941 :     [ 170, 30, 145 ],
942 :     [ 255, 215, 125 ],
943 :     [ 140, 165, 210 ],
944 :     [ 160, 15, 250 ],
945 :     [ 45, 155, 185 ],
946 :     ];
947 :    
948 :     return $colorset;
949 :     }
950 :    
951 :     sub allocateColors {
952 :     my ($colorset, $im) = @_;
953 :    
954 :     my $colors;
955 :    
956 :     foreach my $triplet (@$colorset) {
957 :     push(@$colors, $im->colorResolve($triplet->[0], $triplet->[1], $triplet->[2]));
958 :     }
959 :    
960 :     return $colors;
961 :     }
962 :    
963 :     sub getNavigation {
964 :     my ($length, $position, $window, $width, $height, $id) = @_;
965 :    
966 :     my $nav = "";
967 :     my $im = new GD::Image($width, $height);
968 :    
969 :     my $bg_color = $im->colorResolve(150, 150, 150);
970 :     my $red = $im->colorResolve(255, 0, 0);
971 :     my $black = $im->colorResolve(0,0,0);
972 :    
973 :     $im->rectangle(0,0,$width - 1, $height - 1, $black);
974 :    
975 :     my $factor = $width / $length;
976 :     $position = $position * $factor;
977 :     $window = $window * $factor;
978 :     $im->rectangle($position + 1, 1, $position + $window - 2, $height - 2, $red);
979 :    
980 :     my $encoded = MIME::Base64::encode($im->png());
981 :    
982 :     $nav .= "<img style='border: none;' src='data:image/gif;base64," . $encoded . "' id='" . $id . "'>";
983 :     $nav .= "<script>document.getElementById('" . $id . "').onclick = navigate;</script>";
984 :    
985 :     return $nav;
986 :     }
987 :    
988 :     sub get_minibox {
989 :     my ($index) = @_;
990 :     my $width = 11;
991 :     my $im = new GD::Image($width, $width);
992 :     my $colors = &allocateColors(&getColors(), $im);
993 :     $im->filledRectangle(0,0,$width,$width, $colors->[$index]);
994 :     my $encoded = MIME::Base64::encode($im->png());
995 :     my $minibox = qq~<img src="data:image/gif;base64,~ . $encoded . qq~">~;
996 :     return $minibox;
997 :     }
998 :    
999 :     sub min {
1000 :     shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1001 :     my(@x) = @_;
1002 :     my($min,$i);
1003 :    
1004 :     (@x > 0) || return undef;
1005 :     $min = $x[0];
1006 :     for ($i=1; ($i < @x); $i++) {
1007 :     $min = ($min > $x[$i]) ? $x[$i] : $min;
1008 :     }
1009 :     return $min;
1010 :     }
1011 :    
1012 :     sub max {
1013 :     shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1014 :     my(@x) = @_;
1015 :     my($max,$i);
1016 :    
1017 :     (@x > 0) || return undef;
1018 :     $max = $x[0];
1019 :     for ($i=1; ($i < @x); $i++) {
1020 :     $max = ($max < $x[$i]) ? $x[$i] : $max;
1021 :     }
1022 :     return $max;
1023 :     }
1024 :    
1025 :     =pod
1026 :    
1027 :     =item * B<get_visible_features> (I<dir, contig, beg, end>)
1028 :    
1029 :     Returns the data for the genome browser, retrieved from a single
1030 :     organism directory.
1031 :    
1032 :     Parameters:
1033 :    
1034 :     dir - the directory the organism is in
1035 :     contig - the name of the contig to be displayed
1036 :     beg - the beginning base to be displayed
1037 :     end - the end base to be displayed
1038 :    
1039 :     =cut
1040 :    
1041 :     sub get_visible_features {
1042 :     my($dir,$contig,$beg,$end) = @_;
1043 :    
1044 :     my @features = map { (($_ =~ /^(\S+)\t(\S+)_(\d+)_(\d+)\t/) &&
1045 :     ($contig eq $2) &&
1046 :     (&FIG::between($beg,$3,$end) ||
1047 :     &FIG::between($beg,$4,$end) ||
1048 :     ((&FIG::min($3,$4) < $beg) && (&FIG::max($3,$4) > $end)))) ? [$1,$3,$4] : ()
1049 :     } `cat $dir/Features/*/tbl`;
1050 :    
1051 :     my %seek = map { $_->[0] => 1 } @features;
1052 :     my %func_of;
1053 :     my %in_sub;
1054 :     foreach my $tuple (map { (($_ =~ /^(\S+)\t(\S.*\S)/) && $seek{$1}) ? [$1,$2] : () } `cat $dir/proposed_functions`)
1055 :     {
1056 :     my($peg,$func) = @$tuple;
1057 :     $func_of{$peg} = $func;
1058 :     }
1059 :    
1060 :     foreach $_ (`cut -f1,3 $dir/Subsystems/bindings`)
1061 :     {
1062 :     if (($_ =~ /^([^\t]+)\t(\S+)/) && $func_of{$2})
1063 :     {
1064 :     $in_sub{$2} = $1;
1065 :     }
1066 :     }
1067 :    
1068 :     my @complete_features = map { my ($peg,$beg1,$end1) = @$_; [$peg,$beg1,$end1,$func_of{$peg},$in_sub{$peg}] } @features;
1069 :    
1070 :     return \@complete_features;
1071 :     }
1072 :    
1073 :     =pod
1074 :    
1075 :     =item * B<get_contig_data> (I<dir>)
1076 :    
1077 :     Returns a hash with the contig names of a given organism as key
1078 :     and it's length as the value. The data is retrieved from a single
1079 :     organism directory.
1080 :    
1081 :     Parameters:
1082 :    
1083 :     dir - the directory the organism is in
1084 :    
1085 :     =cut
1086 :    
1087 :     sub get_contig_data {
1088 :     my($dir) = @_;
1089 :    
1090 :     my $lens = {};
1091 :     if (open(CONTIGS,"<$dir/contigs"))
1092 :     {
1093 :     $/ = "\n>";
1094 :     while ($_ = <CONTIGS>)
1095 :     {
1096 :     chomp;
1097 :     if ($_ =~ /^(\S+)[^\n]*\n(.*)/s)
1098 :     {
1099 :     my $id = $1;
1100 :     my $seq = $2;
1101 :     $seq =~ s/\s//g;
1102 :     $id =~ s/^\>//;
1103 :     $lens->{$id} = length($seq);
1104 :     }
1105 :     }
1106 :     $/ = "\n";
1107 :     close(CONTIGS);
1108 :     }
1109 :    
1110 :     return $lens;
1111 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3