1package Bio::Graphics::Panel;
2
3use strict;
4use Bio::Graphics::Glyph::Factory;
5use Bio::Graphics::Feature;
6use Bio::Graphics::GDWrapper;
7
8# KEYLABELFONT must be treated as string until image_class is established
9use constant KEYLABELFONT => 'gdMediumBoldFont';
10use constant KEYSPACING   => 5; # extra space between key columns
11use constant KEYPADTOP    => 5;  # extra padding before the key starts
12use constant KEYCOLOR     => 'wheat';
13use constant KEYSTYLE     => 'bottom';
14use constant KEYALIGN     => 'left';
15use constant GRIDCOLOR    => 'lightcyan';
16use constant GRIDMAJORCOLOR    => 'lightgrey';
17use constant MISSING_TRACK_COLOR =>'gray';
18use constant EXTRA_RIGHT_PADDING => 30;
19
20use base qw(Bio::Root::Root);
21our $GlyphScratch;
22
23my %COLORS;  # translation table for symbolic color names to RGB triple
24my $IMAGEMAP = 'bgmap00001';
25read_colors();
26
27sub 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
31sub 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
123sub rotate {
124  my $self = shift;
125  my $d    = $self->{rotate};
126  $self->{rotate} = shift if @_;
127  $d;
128}
129
130sub pad_left {
131  my $self = shift;
132  my $g = $self->{pad_left};
133  $self->{pad_left} = shift if @_;
134  $g;
135}
136sub pad_right {
137  my $self = shift;
138  my $g = $self->{pad_right};
139  $self->{pad_right} = shift if @_;
140  $g;
141}
142sub pad_top {
143  my $self = shift;
144  my $g = $self->{pad_top};
145  $self->{pad_top} = shift if @_;
146  $g;
147}
148sub pad_bottom {
149  my $self = shift;
150  my $g = $self->{pad_bottom};
151  $self->{pad_bottom} = shift if @_;
152  $g;
153}
154sub extend_grid {
155  my $self = shift;
156  my $g = $self->{extend_grid};
157  $self->{extend_grid} = shift if @_;
158  $g;
159}
160sub flip {
161  my $self = shift;
162  my $g = $self->{flip};
163  $self->{flip} = shift if @_;
164  $g;
165}
166sub 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
178sub 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
185sub key_style {
186  my $self = shift;
187  my $g = $self->{key_style};
188  $self->{key_style} = shift if @_;
189  $g;
190}
191
192sub 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
201sub 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
209sub 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
230sub 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
247sub scale {
248  my $self = shift;
249  $self->{scale} ||= $self->width/($self->length);
250}
251
252sub start { shift->{offset}+1}
253sub end   { $_[0]->start + $_[0]->{length}-1}
254
255sub offset { shift->{offset} }
256sub width {
257  my $self = shift;
258  my $d = $self->{width};
259  $self->{width} = shift if @_;
260  $d;
261}
262
263sub left {
264  my $self = shift;
265  $self->pad_left;
266}
267sub right {
268  my $self = shift;
269  $self->pad_left + $self->width; # - $self->pad_right;
270}
271sub top {
272  shift->pad_top;
273}
274sub bottom {
275  my $self = shift;
276  $self->height - $self->pad_bottom;
277}
278
279sub spacing {
280  my $self = shift;
281  my $d = $self->{spacing};
282  $self->{spacing} = shift if @_;
283  $d;
284}
285
286sub key_spacing {
287  my $self = shift;
288  my $d = $self->{key_spacing};
289  $self->{key_spacing} = shift if @_;
290  $d;
291}
292
293sub 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
304sub gridcolor {shift->{gridcolor}}
305
306sub gridmajorcolor {shift->{gridmajorcolor}}
307
308sub all_callbacks { shift->{all_callbacks} }
309
310sub add_track {
311  my $self = shift;
312  $self->_do_add_track(scalar(@{$self->{tracks}}),@_);
313}
314
315sub unshift_track {
316  my $self = shift;
317  $self->_do_add_track(0,@_);
318}
319
320sub 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
330sub _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
389sub _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
420sub _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
451sub extra_right_padding { EXTRA_RIGHT_PADDING }
452
453sub 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
487sub 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
497sub 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
623sub 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
643sub 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
654sub 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
667sub startGroup {
668    my $self = shift;
669    my $gd   = shift;
670    $gd->startGroup if $gd->can('startGroup');
671}
672
673sub 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
682sub image_class     { return shift->{image_class}; }
683sub image_package   { return shift->{image_package}; }
684sub polygon_package { return shift->{polygon_package}; }
685
686sub 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
732sub 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
741sub 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
757sub 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
775sub 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
789sub 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
884sub 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
891sub key_boxes {
892  my $ref  = shift->{key_boxes};
893  return wantarray ? @$ref : $ref;
894}
895
896sub 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
903sub track2key {
904  my $self = shift;
905  my $track = shift;
906  return $track->make_key_name();
907}
908
909sub 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
927sub 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)
958sub 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
989sub 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
1020sub rgb {
1021  my $self = shift;
1022  my $idx  = shift;
1023  my $gd = $self->{gd} or return;
1024  return $gd->rgb($idx);
1025}
1026
1027sub transparent_color {
1028    my $self = shift;
1029    my ($opacity,@colors) = @_;
1030    return $self->_translate_color($opacity,@colors);
1031}
1032
1033sub translate_color {
1034    my $self = shift;
1035    my @colors = @_;
1036    return $self->_translate_color(1.0,@colors);
1037}
1038
1039sub _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)
1097sub 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
1109sub 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
1125sub bgcolor {
1126   my $self = shift;
1127   return unless $self->{bgcolor};
1128   return $self->translate_color($self->{bgcolor});
1129}
1130
1131sub 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
1146sub png {
1147  my $gd = shift->gd;
1148  $gd->png;
1149}
1150
1151sub 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.
1161sub 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
1182sub 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
1217sub 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
1254sub 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
1262sub 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
1270sub 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
1282sub 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
1291sub color_names {
1292    my $class = shift;
1293    $class->read_colors unless %COLORS;
1294    return wantarray ? keys %COLORS : [keys %COLORS];
1295}
1296
1297sub glyph_scratch {
1298    my $self = shift;
1299    my $d = $GlyphScratch;
1300    $GlyphScratch = shift if @_;
1301    $d;
1302}
1303
1304sub finished {
1305    my $self = shift;
1306    for my $track (@{$self->{tracks} || []}) {
1307	$track->finished();
1308    }
1309    delete $self->{tracks};
1310}
1311
13121;
1313
1314__DATA__
1315white                FF           FF            FF
1316black                00           00            00
1317aliceblue            F0           F8            FF
1318antiquewhite         FA           EB            D7
1319aqua                 00           FF            FF
1320aquamarine           7F           FF            D4
1321azure                F0           FF            FF
1322beige                F5           F5            DC
1323bisque               FF           E4            C4
1324blanchedalmond       FF           EB            CD
1325blue                 00           00            FF
1326blueviolet           8A           2B            E2
1327brown                A5           2A            2A
1328burlywood            DE           B8            87
1329cadetblue            5F           9E            A0
1330chartreuse           7F           FF            00
1331chocolate            D2           69            1E
1332coral                FF           7F            50
1333cornflowerblue       64           95            ED
1334cornsilk             FF           F8            DC
1335crimson              DC           14            3C
1336cyan                 00           FF            FF
1337darkblue             00           00            8B
1338darkcyan             00           8B            8B
1339darkgoldenrod        B8           86            0B
1340darkgray             A9           A9            A9
1341darkgreen            00           64            00
1342darkkhaki            BD           B7            6B
1343darkmagenta          8B           00            8B
1344darkolivegreen       55           6B            2F
1345darkorange           FF           8C            00
1346darkorchid           99           32            CC
1347darkred              8B           00            00
1348darksalmon           E9           96            7A
1349darkseagreen         8F           BC            8F
1350darkslateblue        48           3D            8B
1351darkslategray        2F           4F            4F
1352darkturquoise        00           CE            D1
1353darkviolet           94           00            D3
1354deeppink             FF           14            100
1355deepskyblue          00           BF            FF
1356dimgray              69           69            69
1357dodgerblue           1E           90            FF
1358firebrick            B2           22            22
1359floralwhite          FF           FA            F0
1360forestgreen          22           8B            22
1361fuchsia              FF           00            FF
1362gainsboro            DC           DC            DC
1363ghostwhite           F8           F8            FF
1364gold                 FF           D7            00
1365goldenrod            DA           A5            20
1366gray                 80           80            80
1367grey                 80           80            80
1368green                00           80            00
1369greenyellow          AD           FF            2F
1370honeydew             F0           FF            F0
1371hotpink              FF           69            B4
1372indianred            CD           5C            5C
1373indigo               4B           00            82
1374ivory                FF           FF            F0
1375khaki                F0           E6            8C
1376lavender             E6           E6            FA
1377lavenderblush        FF           F0            F5
1378lawngreen            7C           FC            00
1379lemonchiffon         FF           FA            CD
1380lightblue            AD           D8            E6
1381lightcoral           F0           80            80
1382lightcyan            E0           FF            FF
1383lightgoldenrodyellow FA           FA            D2
1384lightgreen           90           EE            90
1385lightgrey            D3           D3            D3
1386lightpink            FF           B6            C1
1387lightsalmon          FF           A0            7A
1388lightseagreen        20           B2            AA
1389lightskyblue         87           CE            FA
1390lightslategray       77           88            99
1391lightsteelblue       B0           C4            DE
1392lightyellow          FF           FF            E0
1393lime                 00           FF            00
1394limegreen            32           CD            32
1395linen                FA           F0            E6
1396magenta              FF           00            FF
1397maroon               80           00            00
1398mediumaquamarine     66           CD            AA
1399mediumblue           00           00            CD
1400mediumorchid         BA           55            D3
1401mediumpurple         100          70            DB
1402mediumseagreen       3C           B3            71
1403mediumslateblue      7B           68            EE
1404mediumspringgreen    00           FA            9A
1405mediumturquoise      48           D1            CC
1406mediumvioletred      C7           15            85
1407midnightblue         19           19            70
1408mintcream            F5           FF            FA
1409mistyrose            FF           E4            E1
1410moccasin             FF           E4            B5
1411navajowhite          FF           DE            AD
1412navy                 00           00            80
1413oldlace              FD           F5            E6
1414olive                80           80            00
1415olivedrab            6B           8E            23
1416orange               FF           A5            00
1417orangered            FF           45            00
1418orchid               DA           70            D6
1419palegoldenrod        EE           E8            AA
1420palegreen            98           FB            98
1421paleturquoise        AF           EE            EE
1422palevioletred        DB           70            100
1423papayawhip           FF           EF            D5
1424peachpuff            FF           DA            B9
1425peru                 CD           85            3F
1426pink                 FF           C0            CB
1427plum                 DD           A0            DD
1428powderblue           B0           E0            E6
1429purple               80           00            80
1430red                  FF           00            00
1431rosybrown            BC           8F            8F
1432royalblue            41           69            E1
1433saddlebrown          8B           45            13
1434salmon               FA           80            72
1435sandybrown           F4           A4            60
1436seagreen             2E           8B            57
1437seashell             FF           F5            EE
1438sienna               A0           52            2D
1439silver               C0           C0            C0
1440skyblue              87           CE            EB
1441slateblue            6A           5A            CD
1442slategray            70           80            90
1443snow                 FF           FA            FA
1444springgreen          00           FF            7F
1445steelblue            46           82            B4
1446tan                  D2           B4            8C
1447teal                 00           80            80
1448thistle              D8           BF            D8
1449tomato               FF           63            47
1450turquoise            40           E0            D0
1451violet               EE           82            EE
1452wheat                F5           DE            B3
1453whitesmoke           F5           F5            F5
1454yellow               FF           FF            00
1455yellowgreen          9A           CD            32
1456gradient1	00 ff 00
1457gradient2	0a ff 00
1458gradient3	14 ff 00
1459gradient4	1e ff 00
1460gradient5	28 ff 00
1461gradient6	32 ff 00
1462gradient7	3d ff 00
1463gradient8	47 ff 00
1464gradient9	51 ff 00
1465gradient10	5b ff 00
1466gradient11	65 ff 00
1467gradient12	70 ff 00
1468gradient13	7a ff 00
1469gradient14	84 ff 00
1470gradient15	8e ff 00
1471gradient16	99 ff 00
1472gradient17	a3 ff 00
1473gradient18	ad ff 00
1474gradient19	b7 ff 00
1475gradient20	c1 ff 00
1476gradient21	cc ff 00
1477gradient22	d6 ff 00
1478gradient23	e0 ff 00
1479gradient24	ea ff 00
1480gradient25	f4 ff 00
1481gradient26	ff ff 00
1482gradient27	ff f4 00
1483gradient28	ff ea 00
1484gradient29	ff e0 00
1485gradient30	ff d6 00
1486gradient31	ff cc 00
1487gradient32	ff c1 00
1488gradient33	ff b7 00
1489gradient34	ff ad 00
1490gradient35	ff a3 00
1491gradient36	ff 99 00
1492gradient37	ff 8e 00
1493gradient38	ff 84 00
1494gradient39	ff 7a 00
1495gradient40	ff 70 00
1496gradient41	ff 65 00
1497gradient42	ff 5b 00
1498gradient43	ff 51 00
1499gradient44	ff 47 00
1500gradient45	ff 3d 00
1501gradient46	ff 32 00
1502gradient47	ff 28 00
1503gradient48	ff 1e 00
1504gradient49	ff 14 00
1505gradient50	ff 0a 00
1506__END__
1507
1508=head1 NAME
1509
1510Bio::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
1579The Bio::Graphics::Panel class provides drawing and formatting
1580services for any object that implements the Bio::SeqFeatureI
1581interface, including Ace::Sequence::Feature and Das::Segment::Feature
1582objects.  It can be used to draw sequence annotations, physical
1583(contig) maps, or any other type of map in which a set of discrete
1584ranges need to be laid out on the number line.
1585
1586The module supports a drawing style in which each type of feature
1587occupies a discrete "track" that spans the width of the display.  Each
1588track will have its own distinctive "glyph", a configurable graphical
1589representation of the feature.
1590
1591The module also supports a more flexible style in which several
1592different feature types and their associated glyphs can occupy the
1593same track.  The choice of glyph is under run-time control.
1594
1595Semantic zooming (for instance, changing the type of glyph depending
1596on the density of features) is supported by a callback system for
1597configuration variables.  The module has built-in support for Bio::Das
1598stylesheets, and stylesheet-driven configuration can be intermixed
1599with semantic zooming, if desired.
1600
1601You can add a key to the generated image using either of two key
1602styles.  One style places the key captions at the top of each track.
1603The other style generates a graphical key at the bottom of the image.
1604
1605Note that this module depends on GD. The optional SVG output depends
1606on GD::SVG and SVG.
1607
1608The installed script glyph_help.pl provides quick help on glyphs and
1609their options.
1610
1611=head1 METHODS
1612
1613This section describes the class and object methods for
1614Bio::Graphics::Panel.
1615
1616Typically you will begin by creating a new Bio::Graphics::Panel
1617object, passing it the desired width of the image to generate and an
1618origin and length describing the coordinate range to display.  The
1619Bio::Graphics::Panel-E<gt>new() method has many configuration variables
1620that allow you to control the appearance of the image.
1621
1622You will then call add_track() one or more times to add sets of
1623related features to the picture.  add_track() places a new horizontal
1624track on the image, and is likewise highly configurable.  When you
1625have added all the features you desire, you may call png() to convert
1626the image into a PNG-format image, or boxes() to return coordinate
1627information that can be used to create an imagemap.
1628
1629=head2 CONSTRUCTORS
1630
1631new() is the constructor for Bio::Graphics::Panel:
1632
1633=over 4
1634
1635=item $panel = Bio::Graphics::Panel-E<gt>new(@options)
1636
1637The new() method creates a new panel object.  The options are
1638a 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
1775Typically you will pass new() an object that implements the
1776Bio::RangeI interface, providing a length() method, from which the
1777panel will derive its scale.
1778
1779  $panel = Bio::Graphics::Panel->new(-segment => $sequence,
1780				     -width   => 800);
1781
1782new() will return undef in case of an error.
1783
1784Note that if you use the "left" or "right" key styles, you are
1785responsible for allocating sufficient -pad_left or -pad_right room for
1786the labels to appear.  The necessary width is the number of characters
1787in the longest key times the font width (gdMediumBoldFont by default)
1788plus 3 pixels of internal padding.  The simplest way to calculate this
1789is to iterate over the possible track labels, find the largest one,
1790and then to compute its width using the formula:
1791
1792  $width = gdMediumBoldFont->width * length($longest_key) +3;
1793
1794In order to obtain scalable vector graphics (SVG) output, you should
1795pass new() the -image_class=E<gt>'GD::SVG' parameter. This will cause
1796Bio::Graphics::Panel to load the optional GD::SVG module. See the gd()
1797and svg() methods below for additional information.
1798
1799You can tile an image onto the panel either before or after it draws
1800the grid. Simply provide the filename of the image in the -background
1801or -postgrid options. The image file must be of type PNG, JPEG, XBM or
1802GIF and have a filename ending in .png, .jpg, .jpeg, .xbm or .gif.
1803
1804You can also pass a code ref for the -background or -postgrid option,
1805in which case the subroutine will be invoked at the appropriate time
1806with the GD::Image object and the Panel object as its two arguments.
1807You can then use the panel methods to map base pair coordinates into
1808pixel coordinates and do some custom drawing.  For example, this code
1809fragment will draw a gray rectangle between bases 500 and 600 to
1810indicate 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
1826The B<-truetype> argument will activate rendering of labels using
1827antialiased vector fonts. If it is a value of "1", then labels will be
1828rendered using the default font (Verdana). Pass a font name to use
1829this font as the default:
1830
1831  -truetype => 'Times New Roman',
1832
1833Note that you can change the font on a track-by-track basis simply by
1834using 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
1844The add_track() method adds a new track to the image.
1845
1846Tracks are horizontal bands which span the entire width of the panel.
1847Each track contains a number of graphical elements called "glyphs",
1848corresponding to a sequence feature.
1849
1850There are a large number of glyph types.  By default, each track will
1851be homogeneous on a single glyph type, but you can mix several glyph
1852types on the same track by providing a code reference to the -glyph
1853argument.  Other options passed to add_track() control the color and
1854size of the glyphs, whether they are allowed to overlap, and other
1855formatting attributes.  The height of a track is determined from its
1856contents and cannot be directly influenced.
1857
1858The first two arguments are the glyph name and an array reference
1859containing the list of features to display.  The order of the
1860arguments is irrelevant, allowing either of these idioms:
1861
1862  $panel->add_track(arrow => \@features);
1863  $panel->add_track(\@features => 'arrow');
1864
1865The glyph name indicates how each feature is to be rendered.  A
1866variety of glyphs are available, and the number is growing. You may
1867omit the glyph name entirely by providing a B<-glyph> argument among
1868@options, as described below.
1869
1870Currently, 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
1977If the glyph name is omitted from add_track(), the "generic" glyph
1978will be used by default.  To get more information about a glyph, run
1979perldoc on "Bio::Graphics::Glyph::glyphname", replacing "glyphname"
1980with the name of the glyph you are interested in.
1981
1982The "box" glyph is optimized for single features with no
1983subfeatures. If you are drawing such a feature, using "box" will be
1984noticeably faster than "generic."
1985
1986The @options array is a list of name/value pairs that control the
1987attributes of the track.  Some options are interpretered directly by
1988the track.  Others are passed down to the individual glyphs (see
1989L<"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
2005B<-tkcolor> controls the background color of the track as a whole.
2006
2007B<-glyph> controls the glyph type.  If present, it supersedes the
2008glyph name given in the first or second argument to add_track().  The
2009value of B<-glyph> may be a constant string, a hash reference, or a
2010code reference.  In the case of a constant string, that string will be
2011used as the class name for all generated glyphs.  If a hash reference
2012is passed, then the feature's primary_tag() will be used as the key to
2013the hash, and the value, if any, used to generate the glyph type.  If
2014a code reference is passed, then this callback will be passed
2015arguments consisting of the feature and the panel object.  The
2016callback is expected to examine the feature and return a glyph name as
2017its single result.
2018
2019Example:
2020
2021  $panel->add_track(\@exons,
2022		    -glyph => sub { my ($feature,$panel) = @_;
2023                                    $feature->source_tag eq 'curated'
2024                                          ? 'ellipse' : 'box'; }
2025                    );
2026
2027The B<-stylesheet> argument is used to pass a Bio::Das stylesheet
2028object to the panel.  This stylesheet will be called to determine both
2029the glyph and the glyph options.  If both a stylesheet and direct
2030options are provided, the latter take precedence.
2031
2032The B<-color_series> argument causes the track to ignore the -bgcolor
2033setting and instead to assign glyphs a series of contrasting
2034colors. This is usually used in combination with -bump=>'overlap' in
2035order to create overlapping features. A true value activates the color
2036series. You may adjust the default color series using the
2037B<-color_cycle> option, which is either a reference to an array of
2038Bio::Graphics color values, or a space-delimited string of color
2039names/value.
2040
2041If successful, add_track() returns an Bio::Graphics::Glyph object.
2042You can use this object to add additional features or to control the
2043appearance of the track with greater detail, or just ignore it.
2044Tracks are added in order from the top of the image to the bottom.  To
2045add tracks to the top of the image, use unshift_track().
2046
2047B<Adding groups of features:> It is not uncommon to add a group of
2048features which are logically connected, such as the 5' and 3' ends of
2049EST reads.  To group features into sets that remain on the same
2050horizontal position and bump together, pass the sets as an anonymous
2051array.  For example:
2052
2053  $panel->add_track(segments => [[$abc_5,$abc_3],
2054				 [$xxx_5,$xxx_3],
2055				 [$yyy_5,$yyy_3]]
2056		    );
2057
2058Typical 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
2067The track object is simply a specialized type of glyph. See
2068L<Bio::Graphics::Glyph> for a description of the methods that it
2069supports.
2070
2071=item $track = unshift_track($glyph,$features,@options)
2072
2073unshift_track() works like add_track(), except that the new track is
2074added to the top of the image rather than the bottom.
2075
2076=item $track = $panel-E<gt>insert_track($position,$glyph,$features,@options)
2077
2078This works like add_track(), but the track is inserted into the
2079indicated position.  The track will be inserted B<before> the
2080indicated position; thus specify a track of 0 to insert the new track
2081at the beginning.
2082
2083=item $gd = $panel-E<gt>gd([$gd])
2084
2085The gd() method lays out the image and returns a GD::Image object
2086containing it.  You may then call the GD::Image object's png() or
2087jpeg() methods to get the image data.
2088
2089Optionally, you may pass gd() a preexisting GD::Image object that you
2090wish to draw on top of.  If you do so, you should call the width() and
2091height() methods first to ensure that the image has sufficient
2092dimensions.
2093
2094If you passed new() the -image_class=E<gt>'GD::SVG' parameter, the gd() method
2095returns a GD::SVG::Image object. This object overrides GD::Image
2096methods in order to generate SVG output. It behaves exactly as
2097described for GD::Image objects with one exception: it implements and
2098svg() method instead of the png() or jpeg() methods. Currently there
2099is no direct access to underlying SVG calls but this is subject to
2100change in the future.
2101
2102=item $png = $panel-E<gt>png
2103
2104The png() method returns the image as a PNG-format drawing, without
2105the intermediate step of returning a GD::Image object.
2106
2107=item $svg = $panel-E<gt>svg
2108
2109The svg() method returns the image in an XML-ified SVG format.
2110
2111=item $panel-E<gt>finished
2112
2113Bio::Graphics creates memory cycles.  When you are finished with the
2114panel, you should call its finished() method.  Otherwise you will have
2115memory leaks.  This is only an issue if you're going to create several
2116panels in a single program.
2117
2118=item $image_class = $panel-E<gt>image_class
2119
2120The image_class() method returns the current drawing package being
2121used, currently one of GD or GD::SVG.  This is primarily used
2122internally to ensure that calls to GD's exported methods are called in
2123an object-oriented manner to avoid compile time undefined string
2124errors.  This is usually not needed for external use.
2125
2126=item $image_package = $panel-E<gt>image_package
2127
2128This accessor method, like image_class() above is provided as a
2129convenience.  It returns the current image package in use, currently
2130one of GD::Image or GD::SVG::Image.  This is not normally used
2131externally.
2132
2133=item $polygon_package = $panel-E<gt>polygon_package
2134
2135This accessor method, like image_package() above is provided as a
2136convenience.  It returns the current polygon package in use, currently
2137one of GD::Polygon or GD::SVG::Polygon.  This is not normally used
2138externally except in the design of glyphs.
2139
2140=item $boxes = $panel-E<gt>boxes
2141
2142=item @boxes = $panel-E<gt>boxes
2143
2144The boxes() method returns a list of arrayrefs containing the
2145coordinates of each glyph.  The method is useful for constructing an
2146image map.  In a scalar context, boxes() returns an arrayref.  In an
2147list context, the method returns the list directly.
2148
2149Each member of the list is an arrayref of the following format:
2150
2151  [ $feature, $x1, $y1, $x2, $y2, $track ]
2152
2153The first element is the feature object; either an
2154Ace::Sequence::Feature, a Das::Segment::Feature, or another Bioperl
2155Bio::SeqFeatureI object.  The coordinates are the topleft and
2156bottomright corners of the glyph, including any space allocated for
2157labels. The track is the Bio::Graphics::Glyph object corresponding to
2158the 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
2164Returns the positions of the track keys as an arrayref or a list,
2165depending 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
2171After calling gd() or boxes(), you can learn the resulting Y
2172coordinate of a track by calling track_position() with the value
2173returned by add_track() or unshift_track().  This will return undef if
2174called before gd() or boxes() or with an invalid track.
2175
2176=item $rotate       = $panel-E<gt>rotate([$new_value])
2177
2178Gets or sets the "rotate" flag. If rotate is set to true (default
2179false), then calls to gd(), png(), gif(), boxes(), and image_and_map()
2180will all return an image and/or imagemap that has been rotated to the
2181right by 90 degrees. This is mostly useful for drawing karyotypes with
2182the ideogram glyph, in order to rotate the chromosomes into the usual
2183vertical position.
2184
2185=item @pixel_coords = $panel-E<gt>location2pixel(@feature_coords)
2186
2187Public routine to map feature coordinates (in base pairs) into pixel
2188coordinates relative to the left-hand edge of the picture. If you
2189define a -background callback, the callback may wish to invoke this
2190routine 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
2200Return the pixel coordinates of the I<drawing area> of the panel, that
2201is, exclusive of the padding.
2202
2203=back
2204
2205=head1 GLYPH OPTIONS
2206
2207Each glyph has its own specialized subset of options, but
2208some 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
2297B<Specifying colors:> Colors can be expressed in either of two ways:
2298as symbolic names such as "cyan", as HTML-style #RRGGBB triples, and
2299r,g,b comma-separated numbers. The symbolic names are the 140 colors
2300defined in the Netscape/Internet Explorer color cube, and can be
2301retrieved using the Bio::Graphics::Panel-E<gt>color_names() method.
2302
2303Transparent and semi-transparent colors can be specified using the
2304following 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
2312Alpha values can be specified as GD style integers ranging from 0
2313(opaque) to 127 (transparent), or as CSS-style floating point numbers
2314ranging from 0.0 (transparent) through 1.0 (opaque). As a special
2315case, a completely transparent color can be specified using the color
2316named "transparent". In the rgb() and rgba() forms, red, green, blue
2317values can be specified as percentages, as in rgb(100%,0%,50%);
2318otherwise, the values are integers from 0 to 255.
2319
2320In addition, the -fgcolor and -bgcolor options accept the special
2321color names "featureScore" and "featureRGB". In the first case,
2322Bio::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
2324ranging from 0-1000. It will draw a grayscale color ranging from
2325lightest (0) to darkest (1000). If the color is named "featureRGB",
2326then Bio::Graphics will look for a tag named "RGB" and will use that
2327as the color.
2328
2329B<Foreground color:> The -fgcolor option controls the foreground
2330color, including the edges of boxes and the like.
2331
2332B<Background color:> The -bgcolor option controls the background used
2333for filled boxes and other "solid" glyphs.  The foreground color
2334controls the color of lines and strings.  The -tkcolor argument
2335controls the background color of the entire track.
2336
2337B<Default opacity:>For truecolor images, you can apply a default opacity
2338value to both foreground and background colors by supplying a B<-opacity>
2339argument. This is specified as a CSS-style floating point number from
23400.0 to 1.0. If the color has an explicit alpha, then the default is
2341ignored.
2342
2343B<Track color:> The -tkcolor option used to specify the background of
2344the entire track.
2345
2346B<Font:> The -font option controls which font will be used. If the
2347Panel was created without passing a true value to -truecolor, then
2348only 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
2352on 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
2359B<Font color:> The -fontcolor option controls the color of primary
2360text, such as labels
2361
2362B<Secondary Font color:> The -font2color option controls the color of
2363secondary text, such as descriptions.
2364
2365B<Labels:> The -label argument controls whether or not the ID of the
2366feature should be printed next to the feature.  It is accepted by all
2367glyphs.  By default, the label is printed just above the glyph and
2368left aligned with it.
2369
2370-label can be a constant string or a code reference.  Values can be
2371any 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
2381A known bug with this naming scheme is that you can't label a feature
2382with the string "1".  To work around this, use "1 " (note the terminal
2383space).
2384
2385B<Descriptions:> The -description argument controls whether or not a
2386brief description of the feature should be printed next to it.  By
2387default, the description is printed just below the glyph and
2388left-aligned with it.  A value of 0 will suppress the description.  A
2389value of 1 will "magically" look for tags of type "note" or
2390"description" and draw them if found, otherwise the source tag, if
2391any, will be displayed.  A code reference will be invoked to calculate
2392the description on the fly.  Anything else will be treated as a string
2393and used verbatim.
2394
2395B<Connectors:> A glyph can contain subglyphs, recursively.  The top
2396level glyph is the track, which contains one or more groups, which
2397contain features, which contain subfeatures, and so forth.  By
2398default, the "group" glyph draws dotted lines between each of its
2399subglyphs, the "segment" glyph draws a solid line between each of its
2400subglyphs, and the "transcript" and "transcript2" glyphs draw
2401hat-shaped lines between their subglyphs.  All other glyphs do not
2402connect their components.  You can override this behavior by providing
2403a -connector option, to explicitly set the type of connector.  Valid
2404options 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
2413The B<-connector_color> option controls the color of the connector, if
2414any.
2415
2416B<Collision control:> The B<-bump> argument controls what happens when
2417glyphs collide.  By default, they will simply overlap (value 0).  A
2418-bump value of +1 will cause overlapping glyphs to bump downwards
2419until there is room for them.  A -bump value of -1 will cause
2420overlapping glyphs to bump upwards.  You may also provide a -bump
2421value of +2 or -2 to activate a very simple type of collision control
2422in which each feature occupies its own line. This is useful for
2423showing dense, nearly-full length features such as similarity hits.  A
2424bump of 3 or the string "fast" will turn on a faster
2425collision-detection algorithm that only works properly with the
2426default "left" sort order.
2427
2428Finally, a bump value of "overlap" will cause features to overlap each
2429other and to made partially translucent (the translucency can be
2430controlled with the -opacity setting). Features that are on opposite
2431strands will bump, but those on the same strand will not.
2432
2433The bump argument can also be a code reference; see below.
2434
2435For convenience and backwards compatibility, if you specify a -bump
2436of 1 and use the default sort order, the faster algorithm will be
2437used.
2438
2439If you would like to see more horizontal whitespace between features
2440that occupy the same line, you can specify it with the B<-hbumppad>
2441option.  Positive values increase the amount of whitespace between
2442features.  Negative values decrease the whitespace.
2443
2444B<Keys:> The -key argument declares that the track is to be shown in a
2445key appended to the bottom of the image.  The key contains a picture
2446of a glyph and a label describing what the glyph means.  The label is
2447specified in the argument to -key.
2448
2449B<box_subparts:> Ordinarily, when you invoke the boxes() methods to
2450retrieve the rectangles surrounding the glyphs (which you need to do
2451to create clickable imagemaps, for example), the rectangles will
2452surround the top level features.  If you wish for the rectangles to
2453surround subpieces of the glyph, such as the exons in a transcript,
2454set box_subparts to a true numeric value. The value you specify will
2455control the number of levels of subfeatures that the boxes will
2456descend into. For example, if using the "gene" glyph, set
2457-box_subparts to 2 to create boxes for the whole gene (level 0), the
2458mRNAs (level 1) and the exons (level 2).
2459
2460B<part_labels:> If set to true, each subpart of a multipart feature
2461will be labeled with a number starting with 1 at the 5'-most
2462part. This is useful for counting exons. You can pass a callback to
2463this argument; the part number and the total number of parts will be
2464arguments 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
2472The B<-label> argument must also be true.
2473
2474B<part_labels_merge:> If true, changes the behavior of -part_labels so
2475that features that abut each other without a gap are treated as a
2476single feature. Useful if you want to count the UTR and CDS segments
2477of an exon as a single unit, and the default for transcript glyphs.
2478
2479B<strand_arrow:> If set to true, some glyphs will indicate their
2480strandedness, usually by drawing an arrow.  For this to work, the
2481Bio::SeqFeature must have a strand of +1 or -1.  The glyph will ignore
2482this directive if the underlying feature has a strand of zero or
2483undef.
2484
2485B<sort_order>: By default, features are drawn with a layout based only on the
2486position of the feature, assuring a maximal "packing" of the glyphs
2487when bumped.  In some cases, however, it makes sense to display the
2488glyphs sorted by score or some other comparison, e.g. such that more
2489"important" features are nearer the top of the display, stacked above
2490less important features.  The -sort_order option allows a few
2491different built-in values for changing the default sort order (which
2492is by "left" position): "low_score" (or "high_score") will cause
2493features to be sorted from lowest to highest score (or vice versa).
2494"left" (or "default") and "right" values will cause features to be
2495sorted by their position in the sequence.  "longest" (or "shortest")
2496will 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
2500In all cases, the "left" position will be used to break any ties.  To
2501break ties using another field, options may be strung together using a
2502"|" character; e.g. "strand|low_score|right" would cause the features
2503to be sorted first by strand, then score (lowest to highest), then by
2504"right" position in the sequence.
2505
2506Finally, a subroutine coderef with a $$ prototype can be provided.  It
2507will 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
2509sort 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
2524It is important to remember to use the $$ prototype as shown in the
2525example.  Otherwise Bio::Graphics will quit with an exception. The
2526arguments are subclasses of Bio::Graphics::Glyph, not the features
2527themselves.  While glyphs implement some, but not all, of the feature
2528methods, to be safe call the two glyphs' feature() methods in order to
2529convert them into the actual features.
2530
2531The '-always_sort' option, if true, will sort features even if bumping
2532is turned off.  This is useful if you would like overlapping features
2533to stack in a particular order.  Features towards the end of the list
2534will overlay those towards the beginning of the sort order.
2535
2536B<-feature_limit>: When this option is set to a non-zero value, calls
2537to a track's add_feature() method will maintain a count of features
2538added to a track.  Once the feature count exceeds the value set in
2539-feature_limit, additional features will displace existing ones in a
2540way that effects a uniform sampling of the total feature set. This is
2541useful to protect against excessively large tracks. The total number
2542of features added can be retrieved by calling the track's
2543feature_count() method.
2544
2545B<-bump_limit>: When bumping is chosen, colliding features will
2546ordinarily move upward or downward without limit.  When many features
2547collide, this can lead to excessively high images.  You can limit the
2548number of levels that features will bump by providing a numeric
2549B<bump_limit> option. After the limit is hit, features will pile up on
2550top of each other, usually as a band at the bottom of the track.
2551
2552The B<-filter> option, which must be a CODE reference, will be invoked
2553once for each feature prior to rendering it. The coderef will receive
2554the feature as its single option and should return true if the feature
2555is to be shown and false otherwise.
2556
2557=head2 Options and Callbacks
2558
2559Instead of providing a constant value to an option, you may subsitute
2560a code reference.  This code reference will be called every time the
2561panel needs to configure a glyph.  The callback will be called with
2562three 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
2570The five arguments are C<$feature>, a reference to the IO::SeqFeatureI
2571object, C<$option_name>, the name of the option to configure,
2572C<$part_no>, an integer index indicating which subpart of the feature
2573is being drawn, C<$total_parts>, an integer indicating the total
2574number of subfeatures in the feature, and finally C<$glyph>, the Glyph
2575object itself.  The latter fields are useful in the case of treating
2576the first or last subfeature differently, such as using a different
2577color for the terminal exon of a gene.  Usually you will only need to
2578examine the first argument.  This example shows a callback examining
2579the score() attribute of a feature (possibly a BLAST hit) and return
2580the color "red" for high-scoring features, and "green" for low-scoring
2581features:
2582
2583  sub callback {
2584     my $feature = shift;
2585     if ($feature->score > 90) {
2586       return 'red';
2587     else {
2588       return 'green';
2589    }
2590  }
2591
2592The callback should return a string indicating the desired value of
2593the option.  To tell the panel to use the default value for this
2594option, return the string "*default*".
2595
2596The callback for -grid is slightly different because at the time this
2597option is needed there is no glyph defined. In this case, the callback
2598will 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
2606When you install a callback for a feature that contains subparts, the
2607callback will be invoked first for the top-level feature, and then for
2608each of its subparts (recursively).  You should make sure to examine
2609the feature's type to determine whether the option is appropriate.
2610
2611Also be aware that some options are only called for subfeatures. For
2612example, when using multi-segmented features, the "bgcolor" and
2613"fgcolor" options apply to the subfeatures and not to the whole
2614feature; therefore the corresponding callbacks will only be invoked
2615for the subfeatures and not for the top-level feature. To get
2616information that applies to the top-level feature, use the glyph's
2617parent_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
2624The 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
2634or, 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
2645Some glyphs deliberately disable recursion into subparts.  The
2646"track", "group", "transcript", "transcript2" and "segments" glyphs
2647selectively disable the -bump, -label and -description options.  This
2648is to avoid, for example, a label being attached to each exon in a
2649transcript, or the various segments of a gapped alignment bumping each
2650other.  You can override this behavior and force your callback to be
2651invoked by providing add_track() with a true B<-all_callbacks>
2652argument.  In this case, you must be prepared to handle configuring
2653options for the "group" and "track" glyphs.
2654
2655In particular, this means that in order to control the -bump option
2656with a callback, you should specify -all_callbacks=E<gt>1, and turn on
2657bumping when the callback is in the track or group glyphs.
2658
2659The -subpart_callbacks options is similar, except that when this is
2660set to true callbacks are invoked for the main glyph and its
2661subparts. This option only affects the -label and -description
2662options.
2663
2664=head2 ACCESSORS
2665
2666The following accessor methods provide access to various attributes of
2667the panel object.  Called with no arguments, they each return the
2668current value of the attribute.  Called with a single argument, they
2669set the attribute and return its previous value.
2670
2671Note that in most cases you must change attributes prior to invoking
2672gd(), png() or boxes().  These three methods all invoke an internal
2673layout() method which places the tracks and the glyphs within them,
2674and 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
2695The following methods are used internally, but may be useful for those
2696implementing new glyph types.
2697
2698=over 4
2699
2700=item @names = Bio::Graphics::Panel-E<gt>color_names
2701
2702Return the symbolic names of the colors recognized by the panel
2703object.  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
2707Given a symbolic color name, returns the red, green, blue components
2708of the color.  In a scalar context, returns an array reference to the
2709rgb triplet.  Returns undef for an invalid color name.
2710
2711=item @rgb = $panel-E<gt>rgb($index)
2712
2713Given a GD color index (between 0 and 140), returns the RGB triplet
2714corresponding to this index.  This method is only useful within a
2715glyph's draw() routine, after the panel has allocated a GD::Image and
2716is populating it.
2717
2718=item $index = $panel-E<gt>translate_color($color)
2719
2720Given a color, returns the GD::Image index.  The color may be
2721symbolic, such as "turquoise", or a #RRGGBB triple, as in #F0E0A8.
2722This method is only useful within a glyph's draw() routine, after the
2723panel has allocated a GD::Image and is populating it.
2724
2725=item $panel-E<gt>set_pen($width,$color)
2726
2727Changes the width and color of the GD drawing pen to the values
2728indicated.  This is called automatically by the GlyphFactory fgcolor()
2729method.  It returns the GD value gdBrushed, which should be used for
2730drawing.
2731
2732=back
2733
2734=head2 Creating Imagemaps
2735
2736You may wish to use Bio::Graphics to create clickable imagemaps for
2737display on the web.  The main method for achieving this is
2738image_and_map().  Under special circumstances you may instead wish to
2739call either or both of create_web_image() and create_web_map().
2740
2741Here is a synopsis of how to use image_and_map() in a CGI script,
2742using 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
2755We call image_and_map() with various arguments (described below) to
2756generate a three element list consisting of the URL at which the image
2757can be accessed, an HTML fragment containing the clickable imagemap
2758data, and the name of the map.  We print out an E<lt>imageE<gt> tag
2759that uses the URL of the map as its src attribute and the name of the
2760map as the value of its usemap attribute.  It is important to note
2761that we must put a "#" in front of the name of the map in order to
2762indicate that the map can be found in the same document as the
2763E<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
2769Create the image in a web-accessible directory and return its URL, its
2770clickable imagemap, and the name of the imagemap.  The following
2771options 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
2797This method returns a three element list consisting of the URL at
2798which the image has been written to, the imagemap HTML, and the name
2799of the map.  Usually you will incorporate this information into an
2800HTML 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
2809Create the image, write it into the directory indicated by
2810concatenating $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
2814Create a clickable imagemap named "mapname" using the indicated rules
2815to generate the hypertext links, the element titles, and the window
2816targets for the graphical elements.  Return the HTML for the map,
2817including the enclosing E<lt>mapE<gt> tag itself.
2818
2819=back
2820
2821To use this method effectively, you will need a web server and an
2822image directory in the document tree that is writable by the web
2823server user.  For example, if your web server's document root is
2824located 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
2830The 1777 privilege will allow anyone to create files and
2831subdirectories in this directory, but only the owner of the file will
2832be able to delete it.
2833
2834When you call image_and_map(), you must provide it with two vital
2835pieces of information: the URL of the image directory and the physical
2836location of the web server's document tree.  In our example, you would
2837call:
2838
2839  $panel->image_and_map(-root => '/var/www/html',-url=>'/tmpimages');
2840
2841If you are working with virtual hosts, you might wish to provide the
2842hostname: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
2847If you do not provide the -root argument, the method will try to
2848figure it out from the DOCUMENT_ROOT environment variable.  If you do
2849not provide the -url argument, the method will assume "/tmp".
2850
2851During execution, the image_and_map() method will generate a unique
2852name for the image using the Digest::MD5 module.  You can get this
2853module on CPAN and it B<must> be installed in order to use
2854image_and_map().  The imagename will be a long hexadecimal string such
2855as "e7457643f12d413f20843d4030c197c6.png".  Its URL will be
2856/tmpimages/e7457643f12d413f20843d4030c197c6.png, and its physical path
2857will be /var/www/html/tmpimages/e7457643f12d413f20843d4030c197c6.png
2858
2859In addition to providing directory information, you must also tell
2860image_and_map() how to create outgoing links for each graphical
2861feature, and, optionally, how to create the "hover title" (the popup
2862yellow box displayed by most modern browsers), and the name of the
2863window or frame to link to when the user clicks on it.
2864
2865There are three ways to specify the link destination:
2866
2867=over 4
2868
2869=item 1.
2870
2871By configuring one or more tracks with a -link argument.
2872
2873=item 2.
2874
2875By configuring the panel with a -link argument.
2876
2877=item 3.
2878
2879By passing a -link argument in the call to image_and_map().
2880
2881=back
2882
2883The -link argument can be either a string or a coderef.  If you pass a
2884string, it will be interpreted as a URL pattern containing runtime
2885variables.  These variables begin with a dollar sign ($), and are
2886replaced at run time with the information relating to the selected
2887annotation.  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
2903For example, to link each feature to a Google search on the feature's
2904description, use the argument:
2905
2906  -link => 'http://www.google.com/search?q=$description'
2907
2908Be sure to use single quotes around the pattern, or Perl will attempt
2909to perform variable interpretation before image_and_map() has a chance
2910to work on it.
2911
2912You may also pass a code reference to -link, in which case the code
2913will be called every time a URL needs to be generated for the
2914imagemap.  The subroutine will be called with two arguments, the
2915feature and the Bio::Graphics::Panel object, and it should return the
2916URL to link to, or an empty string if a link is not desired. Here is a
2917simple 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
2929The -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
2931will look in the Panel configuration (created during
2932Bio::Graphics::Panel-E<gt>new). If no -link configuration option is found
2933in either location, then image_and_map() will use the value of -link
2934passed in its argument list, if any.
2935
2936The -title and -target options behave in a similar manner to -link.
2937-title is used to assign each feature "title" and "alt" attributes.
2938The "title" attribute is used by many browsers to create a popup hints
2939box when the mouse hovers over the feature's glyph for a preset length
2940of time, while the "alt" attribute is used to create navigable menu
2941items for the visually impaired.  As with -link, you can set the title
2942by passing either a substitution pattern or a code ref, and the -title
2943option can be set in the track, the panel, or the method call itself
2944in that order of priority.
2945
2946If not provided, image_and_map() will autogenerate its own title in
2947the form "E<lt>methodE<gt> E<lt>display_nameE<gt> E<lt>seqidE<gt>:start..end".
2948
2949The -target option can be used to specify the window or frame that
2950clicked features will link to.  By default, when the user clicks on a
2951feature, the loaded URL will replace the current page.  You can modify
2952this by providing -target with the name of a preexisting or new window
2953name in order to create effects like popup windows, multiple frames,
2954popunders and the like.  The value of -target follows the same rules
2955as -title and -link, including variable substitution and the use of
2956code refs.
2957
2958NOTE: Each time you call image_and_map() it will generate a new image
2959file.  Images that are identical to an earlier one will reuse the same
2960name, but those that are different, even by one pixel, will result in
2961the generation of a new image.  If you have limited disk space, you
2962might wish to check the images directory periodically and remove those
2963that have not been accessed recently.  The following cron script will
2964remove image files that haven't been accessed in more than 20 days.
2965
296630 2 * * * find /var/www/html/tmpimages -type f -atime +20 -exec rm {} \;
2967
2968=head1 BUGS
2969
2970Please report them.
2971
2972=head1 SEE ALSO
2973
2974L<Bio::Graphics::Glyph>,
2975L<Bio::Graphics::Glyph::arrow>,
2976L<Bio::Graphics::Glyph::cds>,
2977L<Bio::Graphics::Glyph::crossbox>,
2978L<Bio::Graphics::Glyph::diamond>,
2979L<Bio::Graphics::Glyph::dna>,
2980L<Bio::Graphics::Glyph::dot>,
2981L<Bio::Graphics::Glyph::ellipse>,
2982L<Bio::Graphics::Glyph::extending_arrow>,
2983L<Bio::Graphics::Glyph::generic>,
2984L<Bio::Graphics::Glyph::graded_segments>,
2985L<Bio::Graphics::Glyph::heterogeneous_segments>,
2986L<Bio::Graphics::Glyph::line>,
2987L<Bio::Graphics::Glyph::pinsertion>,
2988L<Bio::Graphics::Glyph::primers>,
2989L<Bio::Graphics::Glyph::rndrect>,
2990L<Bio::Graphics::Glyph::segments>,
2991L<Bio::Graphics::Glyph::redgreen_box>,
2992L<Bio::Graphics::Glyph::ruler_arrow>,
2993L<Bio::Graphics::Glyph::toomany>,
2994L<Bio::Graphics::Glyph::transcript>,
2995L<Bio::Graphics::Glyph::transcript2>,
2996L<Bio::Graphics::Glyph::translation>,
2997L<Bio::Graphics::Glyph::triangle>,
2998L<Bio::Graphics::Glyph::xyplot>,
2999L<Bio::Graphics::Glyph::whiskerplot>,
3000L<Bio::SeqI>,
3001L<Bio::SeqFeatureI>,
3002L<Bio::Das>,
3003L<GD>
3004L<GD::SVG>
3005L<glyph_help.pl>
3006
3007=head1 AUTHOR
3008
3009Lincoln Stein E<lt>lstein@cshl.orgE<gt>
3010
3011Copyright (c) 2001 Cold Spring Harbor Laboratory
3012
3013This library is free software; you can redistribute it and/or modify
3014it under the same terms as Perl itself.  See DISCLAIMER.txt for
3015disclaimers of warranty.
3016
3017=cut
3018
3019