[Bio] / SeedViewer / GenomeDrawer.cgi Repository:
ViewVC logotype

Annotation of /SeedViewer/GenomeDrawer.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : paczian 1.1 use strict;
2 :     use warnings;
3 :    
4 :     use CGI;
5 :     use MIME::Base64;
6 :     use GD;
7 :     use GD::Polyline;
8 :     use Math::Trig;
9 :    
10 :     my $cgi = CGI->new();
11 :    
12 :     my $self = {};
13 :    
14 :     $self->{color_set} = [ [ 255, 255, 255 ],
15 :     [ 0, 0, 0 ],
16 :     [ 235, 5, 40 ],
17 :     [ 200, 200, 200 ] ];
18 :     $self->{lines} = [];
19 :     $self->{show_legend} = 1;
20 :     $self->{legend_width} = 120;
21 :     $self->{width} = 800;
22 :     $self->{colors} = [];
23 :     $self->{line_height} = 28;
24 :     $self->{height} = undef;
25 :     $self->{display_titles} = 0;
26 :     $self->{window_size} = 50000;
27 :     $self->{scale} = undef;
28 :     $self->{line_select} = 0;
29 :     $self->{select_positions} = {};
30 :     $self->{select_checks} = {};
31 :     $self->{scale} = $self->{width} / $self->{window_size};
32 :    
33 :     # load data
34 :     my $fn = $cgi->param('file');
35 :     if (open(FH, $fn)) {
36 :     my $data = [];
37 :     my $config = [];
38 :     my $hdr = 0;
39 :     my $i = 0;
40 :     while (<FH>) {
41 :     my $line = $_;
42 :     chomp $line;
43 :     if ($line eq "//") {
44 :     push(@{$self->{lines}}, { data => $data->[$i], config => $config->[$i] });
45 :     $i++;
46 :     $hdr = <FH>;
47 :     chomp $hdr;
48 :     my ($abbr, $beg, $end) = split(/\t/, $hdr);
49 :     $config->[$i]->{short_title} = $abbr;
50 :     $config->[$i]->{basepair_offset} = $beg;
51 :     $self->{window_size} = $end - $beg;
52 :     } elsif (! $hdr) {
53 :     my ($abbr, $beg, $end) = split(/\t/, $line);
54 :     $config->[0]->{short_title} = $abbr;
55 :     $config->[0]->{basepair_offset} = $beg;
56 :     $self->{window_size} = $end - $beg;
57 :     $hdr = 1;
58 :     } else {
59 :     my ($beg, $end, $shape, $color, $link, $popup) = split(/\t/, $line);
60 :     if ($shape eq 'leftArrow') {
61 :     $shape = $beg;
62 :     $beg = $end;
63 :     $end = $shape;
64 :     $shape = 'arrow';
65 :     } elsif ($shape eq 'rightArrow') {
66 :     $shape = 'arrow';
67 :     } else {
68 :     $shape = 'box';
69 :     }
70 :     my $c = [];
71 :     @$c = split(/-/, $color);
72 :     push(@{$data->[$i]}, {'start' => $beg,
73 :     'end' => $end,
74 :     'type' => $shape,
75 :     'color' => $c,
76 :     'href' => $link,
77 :     'title' => $popup });
78 :     }
79 :     }
80 :     close FH;
81 :     push(@{$self->{lines}}, { data => $data->[$i], config => $config->[$i] });
82 :     } else {
83 :     print $cgi->header();
84 :     print "could not open file $fn: $! $@";
85 :     exit 0;
86 :     }
87 :    
88 :     $self->{height} = &height();
89 :    
90 :     # initialize image
91 :     $self->{image} = new GD::Image($self->{width} + $self->{show_legend} * $self->{legend_width}, $self->{height});
92 :     foreach my $triplet (@{$self->{color_set}}) {
93 :     push(@{$self->{colors}}, $self->{image}->colorResolve($triplet->[0], $triplet->[1], $triplet->[2]));
94 :     }
95 :    
96 :     # create image map
97 :     my $unique_map_id = int(rand(100000));
98 :     my $map = "<map name='imap_".$unique_map_id."'>";
99 :     my @maparray;
100 :    
101 :     # draw lines
102 :     my $i = 0;
103 :     my $y_offset = 0;
104 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
105 :     foreach my $line (@{$self->{lines}}) {
106 :     my $lh = $line->{config}->{line_height} || $self->{line_height};
107 :     $self->{lh} = $lh;
108 :    
109 :     # draw center line
110 :     unless ($line->{config}->{no_middle_line}) {
111 :     $self->{image}->line($x_offset, $y_offset + 3 + ($lh / 2), $self->{width} + $x_offset, $y_offset + 3 + ($lh / 2), $self->{colors}->[1]);
112 :     }
113 :    
114 :     # check for legend
115 :     if ($self->{show_legend}) {
116 :    
117 :     # check for description of line
118 :     if (defined($line->{config}->{short_title}) && !defined($line->{config}->{title})) {
119 :     $line->{config}->{title} = $line->{config}->{short_title};
120 :     }
121 :     if (defined($line->{config}->{title})) {
122 :     my $short_title = undef;
123 :     if (defined($line->{config}->{short_title})) {
124 :     $short_title = $line->{config}->{short_title};
125 :     }
126 :     my $onclick = " ";
127 :     if (defined($line->{config}->{title_link})) {
128 :     $onclick .= "onclick=\"" . $line->{config}->{title_link} . "\"";
129 :     }
130 :    
131 :     $self->{image}->string(gdSmallFont, 0, $y_offset + ($lh / 2) - 4, $short_title, $self->{colors}->[1]);
132 :     }
133 :     }
134 :    
135 :     # sort items according to z-layer
136 :     if (defined($line->{data}->[0]->{zlayer})) {
137 :     my @sortline = sort { $a->{zlayer} <=> $b->{zlayer} } @{$line->{data}};
138 :     $line->{data} = \@sortline;
139 :     }
140 :    
141 :     # draw items
142 :     my $h = 0;
143 :     foreach my $item (@{$line->{data}}) {
144 :     next unless defined($item->{start}) && defined($item->{end});
145 :    
146 :     # set to default fill and frame color
147 :     $item->{fillcolor} = $self->{colors}->[4];
148 :     $item->{framecolor} = $self->{colors}->[1];
149 :     if ($item->{color}) {
150 :     $item->{fillcolor} = $self->{image}->colorResolve($item->{color}->[0], $item->{color}->[1], $item->{color}->[2]);
151 :     }
152 :     unless (defined($line->{config}->{basepair_offset})) {
153 :     $line->{config}->{basepair_offset} = 0;
154 :     }
155 :     $item->{start_scaled} = ($item->{start} - $line->{config}->{basepair_offset}) * $self->{scale};
156 :     $item->{end_scaled} = ($item->{end} - $line->{config}->{basepair_offset}) * $self->{scale};
157 :     my $i_start = $item->{start_scaled};
158 :     my $i_end = $item->{end_scaled};
159 :     if ($i_start > $i_end) {
160 :     my $x = $i_start;
161 :     $i_start = $i_end;
162 :     $i_end = $x;
163 :     }
164 :    
165 :     # determine type of item to draw
166 :     unless (defined($item->{type})) {
167 :     draw_box($y_offset, $item);
168 :     } elsif ($item->{type} eq "box") {
169 :     draw_box($y_offset, $item);
170 :     } elsif ($item->{type} eq "arrow") {
171 :     draw_arrow($y_offset, $item);
172 :     } elsif ($item->{type} eq "smallbox") {
173 :     draw_smallbox($y_offset, $item);
174 :     } elsif ($item->{type} eq "smallbox_noborder") {
175 :     draw_smallbox($y_offset, $item, 1);
176 :     } elsif ($item->{type} eq "bigbox") {
177 :     draw_bigbox($y_offset, $item);
178 :     } elsif ($item->{type} eq "bigbox_noborder") {
179 :     draw_bigbox($y_offset, $item, 1);
180 :     } elsif ($item->{type} eq "ellipse") {
181 :     draw_ellipse($y_offset, $item);
182 :     } elsif ($item->{type} eq "line") {
183 :     draw_line($y_offset, $item);
184 :     } elsif ($item->{type} eq "diamond") {
185 :     draw_diamond($y_offset, $item);
186 :     }
187 :    
188 :     my $title = "";
189 :     if ($item->{title}) {
190 :     $title = ' title="'.$item->{title}.'"';
191 :     }
192 :    
193 :     my $href = "";
194 :     if ($item->{href}) {
195 :     $href = ' href="'.$item->{href}.'"';
196 :     }
197 :    
198 :     my $x1 = int($x_offset + $i_start);
199 :     my $y1 = int($y_offset);
200 :     my $x2 = int($x_offset + $i_end);
201 :     my $y2 = int($y_offset + $lh);
202 :    
203 :     push(@maparray, '<area shape="rect"'.$href.' coords="' . join(',', $x1, $y1, $x2, $y2) . '"' .$title.'>');
204 :     $h++;
205 :     }
206 :    
207 :     # calculate y-offset
208 :     $y_offset = $y_offset + $lh;
209 :    
210 :     # increase counter
211 :     $i++;
212 :     }
213 :    
214 :     # finish image map
215 :     $map .= join("\n", reverse(@maparray));
216 :     $map .= "</map>";
217 :    
218 :     my $mime = MIME::Base64::encode($self->{image}->png(), "");
219 :     my $image_link = "data:image/gif;base64,$mime";
220 :    
221 :     # create html
222 :     print $cgi->header();
223 :     print '<img usemap="#imap_'.$unique_map_id.'" style="border: none;" src="' . $image_link . '">'.$map;
224 :    
225 :     # draw an arrow
226 :     sub draw_arrow {
227 :     my ($y_offset, $item) = @_;
228 :    
229 :     # required parameters
230 :     my $start = $item->{start_scaled};
231 :     my $end = $item->{end_scaled};
232 :     my $ypos = $y_offset;
233 :     my $im = $self->{image};
234 :     my $fillcolor = $item->{fillcolor};
235 :     my $framecolor = $item->{framecolor};
236 :     my $labelcolor = $item->{labelcolor} || $self->{colors}->[1];
237 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
238 :    
239 :     # optional parameters
240 :     my $arrow_height = $self->{lh};
241 :     my $arrow_head_width = 9;
242 :     my $label = "";
243 :     if ($self->{display_titles}) {
244 :     $label = $item->{label};
245 :     }
246 :     unless (defined($label)) {
247 :     $label = "";
248 :     }
249 :     my $linepadding = 10;
250 :    
251 :     # precalculations
252 :     my $direction = 1;
253 :     if ($start > $end) {
254 :     $direction = 0;
255 :     my $x = $start;
256 :     $start = $end;
257 :     $end = $x;
258 :     }
259 :     if ($start < 0) {
260 :     $start = 0;
261 :     }
262 :     if ($end < 0) {
263 :     return ($im, $start, $end);
264 :     }
265 :     $arrow_height = $arrow_height - $linepadding;
266 :     $ypos = $ypos + 8;
267 :     my $boxpadding = $arrow_height / 5;
268 :     my $fontheight = 12;
269 :    
270 :     # draw arrow
271 :     my $arrowhead = new GD::Polygon;
272 :    
273 :     # calculate x-pos for title
274 :     my $string_start_x_right = $x_offset + $start + (($end - $start - $arrow_head_width) / 2) - (length($label) * 6 / 2);
275 :     my $string_start_x_left = $x_offset + $start + (($end - $start + $arrow_head_width) / 2) - (length($label) * 6 / 2);
276 :    
277 :     # check for arrow direction
278 :     if ($direction) {
279 :    
280 :     # draw arrow box
281 :     if ($arrow_head_width < ($end - $start)) {
282 :     $im->rectangle($x_offset + $start,$ypos + $boxpadding,$x_offset + $end - $arrow_head_width,$ypos + $arrow_height - $boxpadding + 1, $framecolor);
283 :     $im->setThickness(1);
284 :     } else {
285 :     $arrow_head_width = $end - $start;
286 :     }
287 :    
288 :     # calculate arrowhead
289 :     $arrowhead->addPt($x_offset + $end - $arrow_head_width, $ypos);
290 :     $arrowhead->addPt($x_offset + $end, $ypos + ($arrow_height / 2));
291 :     $arrowhead->addPt($x_offset + $end - $arrow_head_width, $ypos + $arrow_height);
292 :    
293 :     # draw label
294 :     $im->string(gdSmallFont, $string_start_x_right, $ypos + $boxpadding - $fontheight - 2, $label, $labelcolor);
295 :    
296 :     # draw arrowhead
297 :     $im->filledPolygon($arrowhead, $fillcolor);
298 :     if ( $item->{tile} ) {
299 :     $im->setTile($item->{tile});
300 :     $im->filledPolygon($arrowhead, gdTiled);
301 :     }
302 :     $im->polygon($arrowhead, $framecolor);
303 :     $im->setThickness(1);
304 :    
305 :     # draw arrow content
306 :     $im->filledRectangle($x_offset + $start + 1,$ypos + $boxpadding + 1,$x_offset + $end - $arrow_head_width,$ypos + $arrow_height - $boxpadding,$fillcolor);
307 :     if ( $item->{tile} ) {
308 :     $im->setTile($item->{tile});
309 :     $im->filledRectangle($x_offset + $start + 1,$ypos + $boxpadding + 1,$x_offset + $end - $arrow_head_width,$ypos + $arrow_height - $boxpadding,gdTiled);
310 :     }
311 :    
312 :     } else {
313 :    
314 :     # draw arrow box
315 :     if ($arrow_head_width < ($end - $start)) {
316 :     $im->rectangle($x_offset + $start + $arrow_head_width,$ypos + $boxpadding,$x_offset + $end,$ypos + $arrow_height - $boxpadding + 1, $framecolor);
317 :     $im->setThickness(1);
318 :     } else {
319 :     $arrow_head_width = $end - $start;
320 :     }
321 :    
322 :     # calculate arrowhead
323 :     $arrowhead->addPt($x_offset + $start + $arrow_head_width, $ypos);
324 :     $arrowhead->addPt($x_offset + $start, $ypos + ($arrow_height / 2));
325 :     $arrowhead->addPt($x_offset + $start + $arrow_head_width, $ypos + $arrow_height);
326 :    
327 :     # draw label
328 :     $im->string(gdSmallFont, $string_start_x_left, $ypos + $boxpadding - $fontheight - 2, $label, $labelcolor);
329 :     # draw arrowhead
330 :     $im->filledPolygon($arrowhead, $fillcolor);
331 :     $im->polygon($arrowhead, $framecolor);
332 :     $im->setThickness(1);
333 :    
334 :     # draw arrow content
335 :     $im->filledRectangle($x_offset + $start + $arrow_head_width - 1,$ypos + $boxpadding + 1,$x_offset + $end - 1,$ypos + $arrow_height - $boxpadding,$fillcolor);
336 :     if ( $item->{tile} ) {
337 :     $im->setTile($item->{tile});
338 :     $im->filledRectangle($x_offset + $start + $arrow_head_width - 1,$ypos + $boxpadding + 1,$x_offset + $end - 1,$ypos + $arrow_height - $boxpadding,gdTiled);
339 :     }
340 :     }
341 :    
342 :     return ($im, $start, $end);
343 :     }
344 :    
345 :     # draw a diamon
346 :     sub draw_diamond {
347 :     my ($self, $y_offset, $item) = @_;
348 :    
349 :     # required parameters
350 :     my $start = $item->{start_scaled};
351 :     my $end = $item->{end_scaled};
352 :     my $ypos = $y_offset + 5;
353 :     my $im = $self->{image};
354 :     my $fillcolor = $item->{fillcolor};
355 :     my $labelcolor = $item->{labelcolor} || $self->{colors}->[1];
356 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
357 :    
358 :     # optional parameters
359 :     my $item_height = $self->{lh} - 5;
360 :    
361 :     # precalculations
362 :     if ($start > $end) {
363 :     my $x = $start;
364 :     $start = $end;
365 :     $end = $x;
366 :     }
367 :     my $len = ($end - $start) / 2;
368 :    
369 :     # draw the diamond
370 :     my $diamond = new GD::Polygon;
371 :     $diamond->addPt($x_offset + $start, $ypos + ($item_height / 2));
372 :     $diamond->addPt($x_offset + $start + ($len / 2), $ypos + $item_height);
373 :     $diamond->addPt($x_offset + $end, $ypos + ($item_height / 2));
374 :     $diamond->addPt($x_offset + $start + ($len / 2), $ypos);
375 :     $im->filledPolygon($diamond, $fillcolor);
376 :    
377 :     return ($im, $start, $end);
378 :     }
379 :    
380 :     # draw a small box
381 :     sub draw_smallbox {
382 :     my ($self, $y_offset, $item, $noborder) = @_;
383 :    
384 :     # required parameters
385 :     my $start = $item->{start_scaled};
386 :     my $end = $item->{end_scaled};
387 :     my $ypos = $y_offset;
388 :     my $im = $self->{image};
389 :     my $fillcolor = $item->{fillcolor};
390 :     my $framecolor = $item->{framecolor};
391 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
392 :    
393 :     # optional parameters
394 :     my $linepadding = 10;
395 :     my $box_height = $self->{lh} - 2 - $linepadding;
396 :     $ypos = $ypos + 10;
397 :     my $boxpadding = $box_height / 5;
398 :     $box_height = $box_height - 2;
399 :    
400 :     # precalculations
401 :     if ($start > $end) {
402 :     my $x = $start;
403 :     $start = $end;
404 :     $end = $x;
405 :     }
406 :    
407 :     # draw box content
408 :     $im->filledRectangle($x_offset + $start,$ypos + $boxpadding,$x_offset + $end,$ypos + $box_height - $boxpadding + 2,$fillcolor);
409 :    
410 :     # draw box
411 :     unless (defined($noborder)) {
412 :     $im->rectangle($x_offset + $start,$ypos + $boxpadding,$x_offset + $end,$ypos + $box_height - $boxpadding + 2, $framecolor);
413 :     }
414 :    
415 :     return ($im, $start, $end);
416 :     }
417 :    
418 :     # draw a big box
419 :     sub draw_bigbox {
420 :     my ($self, $y_offset, $item, $noborder) = @_;
421 :    
422 :     # required parameters
423 :     my $start = $item->{start_scaled};
424 :     my $end = $item->{end_scaled};
425 :     my $ypos = $y_offset;
426 :     my $im = $self->{image};
427 :     my $fillcolor = $item->{fillcolor};
428 :     my $framecolor = $item->{framecolor};
429 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
430 :    
431 :    
432 :     # optional parameters
433 :     my $box_height = $self->{lh} - 2;
434 :    
435 :     # precalculations
436 :     if ($start > $end) {
437 :     my $x = $start;
438 :     $start = $end;
439 :     $end = $x;
440 :     }
441 :    
442 :     # draw box content
443 :     $im->filledRectangle($x_offset + $start,$ypos,$x_offset + $end,$ypos + $box_height,$fillcolor);
444 :    
445 :     # draw box
446 :     unless ($noborder) {
447 :     $im->rectangle($x_offset + $start,$ypos,$x_offset + $end,$ypos + $box_height, $framecolor);
448 :     }
449 :    
450 :     return ($im, $start, $end);
451 :     }
452 :    
453 :     # draw a box
454 :     sub draw_box {
455 :     my ($self, $y_offset, $item) = @_;
456 :    
457 :     # required parameters
458 :     my $start = $item->{start_scaled};
459 :     my $end = $item->{end_scaled};
460 :     my $ypos = $y_offset;
461 :     my $im = $self->{image};
462 :     my $fillcolor = $item->{fillcolor};
463 :     my $framecolor = $item->{framecolor};
464 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
465 :    
466 :     # optional parameters
467 :     my $box_height = $self->{lh} - 2;
468 :    
469 :     # precalculations
470 :     if ($start > $end) {
471 :     my $x = $start;
472 :     $start = $end;
473 :     $end = $x;
474 :     }
475 :    
476 :     $ypos = $ypos + 8;
477 :     $box_height = $box_height - 8;
478 :    
479 :     # draw box
480 :     $im->filledRectangle($x_offset + $start,$ypos,$x_offset + $end,$ypos + $box_height,$fillcolor);
481 :     $im->rectangle($x_offset + $start - 1,$ypos,$x_offset + $end + 1,$ypos + $box_height, $framecolor);
482 :    
483 :     return ($im, $start, $end);
484 :     }
485 :    
486 :     # draw a line (it has to be drawn somewhere...)
487 :     sub draw_line {
488 :     my ($self, $y_offset, $item) = @_;
489 :    
490 :     # required parameters
491 :     my $start = $item->{start_scaled};
492 :     my $end = $item->{end_scaled};
493 :     my $ypos = $y_offset;
494 :     my $im = $self->{image};
495 :     my $framecolor = $item->{framecolor};
496 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
497 :     my $labelcolor = $item->{labelcolor} || $self->{colors}->[1];
498 :     my $fontheight = $item->{label} ? 12 : 6;
499 :    
500 :     # optional parameters
501 :     my $height = $self->{lh};
502 :     $im->line($x_offset + $start,$ypos + $fontheight,$x_offset + $start,$ypos + $self->{lh}, $framecolor);
503 :    
504 :     # check for label
505 :     if ($item->{label}) {
506 :     my $off = int((length($item->{label}) * 6) / 2);
507 :     $im->string(gdSmallFont, $x_offset + $start - $off, $ypos, $item->{label}, $labelcolor);
508 :     }
509 :    
510 :     return ($im, $start, $end);
511 :     }
512 :    
513 :     # draw a ellipse
514 :     sub draw_ellipse {
515 :     my ($self, $y_offset, $item) = @_;
516 :    
517 :     # required parameters
518 :     my $start = $item->{start_scaled};
519 :     my $end = $item->{end_scaled};
520 :     my $ypos = $y_offset + 5;
521 :     my $im = $self->{image};
522 :     my $fillcolor = $item->{fillcolor};
523 :     my $framecolor = $item->{framecolor};
524 :     my $x_offset = $self->{show_legend} * $self->{legend_width};
525 :    
526 :     my $lineheight = $self->{lh} - 5;
527 :    
528 :     # precalculations
529 :     if ($start > $end) {
530 :     my $x = $start;
531 :     $start = $end;
532 :     $end = $x;
533 :     }
534 :     my $length = $end - $start;
535 :     $im->filledEllipse($x_offset + $start + ($length / 2), $ypos + ($lineheight / 2) + 1, $length, $lineheight - 6, $fillcolor);
536 :     if ( $item->{tile} ) {
537 :     $im->setTile($item->{tile});
538 :     $im->filledEllipse($x_offset + $start + ($length / 2), $ypos + ($lineheight / 2) + 1, $length, $lineheight - 6, gdTiled);
539 :     }
540 :     $im->ellipse($x_offset + $start + ($length / 2), $ypos + ($lineheight / 2) + 1, $length, $lineheight - 6, $framecolor);
541 :    
542 :     return ($im, $start, $end);
543 :     }
544 :    
545 :    
546 :     sub height {
547 :    
548 :     my $height = 0;
549 :     foreach my $line (@{$self->{lines}}) {
550 :     my $lh = $line->{config}->{line_height} || $self->{line_height};
551 :     $height += $lh;
552 :     }
553 :     unless ($height) {
554 :     $height = $self->{line_height};
555 :     }
556 :    
557 :     return $height;
558 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3