Summary

Bio::Graphics::Panel - Generate GD images of Bio::Seq objects

Package variables

Included modules

Synopsis

 # This script parses a GenBank or EMBL file named on the command
 # line and produces a PNG rendering of it.  Call it like this:
 # render.pl my_file.embl | display -

 use strict;
 use Bio::Graphics;
 use Bio::SeqIO;

 my $file = shift                       or die "provide a sequence file as the argument";
 my $io = Bio::SeqIO->new(-file=>$file) or die "could not create Bio::SeqIO";
 my $seq = $io->next_seq                or die "could not find a sequence in the file";

 my @features = $seq->all_SeqFeatures;

 # sort features by their primary tags
 my %sorted_features;
 for my $f (@features) {
   my $tag = $f->primary_tag;
   push @{$sorted_features{$tag}},$f;
 }

 my $panel = Bio::Graphics::Panel->new(
                                      -length    => $seq->length,
 				      -key_style => 'between',
 				      -width     => 800,
 				      -pad_left  => 10,
 				      -pad_right => 10,
 				      );
 $panel->add_track( arrow => Bio::SeqFeature::Generic->new(-start=>1,
                                                           -end=>$seq->length),
 		  -bump => 0,
 		  -double=>1,
 		  -tick => 2);
 $panel->add_track(generic => Bio::SeqFeature::Generic->new(-start=>1,
							  -end=>$seq->length),
 		  -glyph  => 'generic',
 		  -bgcolor => 'blue',
 		  -label  => 1,
 		 );

 # general case
 my @colors = qw(cyan orange blue purple green chartreuse magenta yellow aqua);
 my $idx    = 0;
 for my $tag (sort keys %sorted_features) {
   my $features = $sorted_features{$tag};
   $panel->add_track($features,
 		    -glyph    =>  'generic',
 		    -bgcolor  =>  $colors[$idx++ % @colors],
 		    -fgcolor  => 'black',
 		    -font2color => 'red',
 		    -key      => "${tag}s",
 		    -bump     => +1,
 		    -height   => 8,
 		    -label    => 1,
 		    -description => 1,
 		   );
 }

 print $panel->png;
 exit 0;

Description

The Bio::Graphics::Panel class provides drawing and formatting
services for any object that implements the Bio::SeqFeatureI
interface, including Ace::Sequence::Feature and Das::Segment::Feature
objects. It can be used to draw sequence annotations, physical
(contig) maps, or any other type of map in which a set of discrete
ranges need to be laid out on the number line.
The module supports a drawing style in which each type of feature
occupies a discrete "track" that spans the width of the display. Each
track will have its own distinctive "glyph", a configurable graphical
representation of the feature.
The module also supports a more flexible style in which several
different feature types and their associated glyphs can occupy the
same track. The choice of glyph is under run-time control.
Semantic zooming (for instance, changing the type of glyph depending
on the density of features) is supported by a callback system for
configuration variables. The module has built-in support for Bio::Das
stylesheets, and stylesheet-driven configuration can be intermixed
with semantic zooming, if desired.
You can add a key to the generated image using either of two key
styles. One style places the key captions at the top of each track.
The other style generates a graphical key at the bottom of the image.
Note that this modules depends on GD.

Methods

Methods description

None available.

Methods code

sub new {

  my $class = shift;
  my %options = @_;

  $class->read_colors() unless %COLORS;

  my $length = $options{-length} || 0;
  my $offset = $options{-offset}  || 0;
  my $spacing = $options{-spacing} || 5;
  my $bgcolor = $options{-bgcolor} || 0;
  my $keyfont = $options{-key_font} || KEYLABELFONT;
  my $keycolor = $options{-key_color} || KEYCOLOR;
  my $keyspacing = $options{-key_spacing} || KEYSPACING;
  my $keystyle = $options{-key_style} || KEYSTYLE;
  my $keyalign = $options{-key_align} || KEYALIGN;
  my $allcallbacks = $options{-all_callbacks} || 0;
  my $gridcolor    = $options{-gridcolor} || GRIDCOLOR;
  my $grid         = $options{-grid}       || 0;
  my $flip         = $options{-flip}       || 0;
  my $empty_track_style   = $options{-empty_tracks} || 'key';
  my $truecolor    = $options{-truecolor}  || 0;

  if (my $seg = $options{-segment}) {
    $offset = eval {$seg->start-1} || 0;
    $length = $seg->length;
  }

  $offset   ||= $options{-start}-1 if defined $options{-start};
  $length   ||= $options{-stop}-$options{-start}+1 
     if defined $options{-start} && defined $options{-stop};

  return bless {
		tracks => [],
		width      => $options{-width} || 600,
		pad_top    => $options{-pad_top}||0,
		pad_bottom => $options{-pad_bottom}||0,
		pad_left   => $options{-pad_left}||0,
		pad_right  => $options{-pad_right}||0,
		length => $length,
		offset => $offset,
		gridcolor => $gridcolor,
		grid    => $grid,
		bgcolor => $bgcolor,
		height => 0, # AUTO
		spacing => $spacing,
		key_font => $keyfont,
		key_color => $keycolor,
		key_spacing => $keyspacing,
		key_style => $keystyle,
		key_align => $keyalign,
		all_callbacks => $allcallbacks,
		truecolor     => $truecolor,
		flip          => $flip,
		empty_track_style    => $empty_track_style,
	       },$class;

}

sub pad_left {

  my $self = shift;
  my $g = $self->{pad_left};
  $self->{pad_left} = shift if @_;
  $g;

}

sub pad_right {

  my $self = shift;
  my $g = $self->{pad_right};
  $self->{pad_right} = shift if @_;
  $g;

}

sub pad_top {

  my $self = shift;
  my $g = $self->{pad_top};
  $self->{pad_top} = shift if @_;
  $g;

}

sub pad_bottom {

  my $self = shift;
  my $g = $self->{pad_bottom};
  $self->{pad_bottom} = shift if @_;
  $g;

}

sub flip {

  my $self = shift;
  my $g = $self->{flip};
  $self->{flip} = shift if @_;
  $g;

}

sub empty_track_style {

  my $self = shift;
  my $g = $self->{empty_track_style};
  $self->{empty_track_style} = shift if @_;
  $g;

}

sub key_style {

  my $self = shift;
  my $g = $self->{key_style};
  $self->{key_style} = shift if @_;
  $g;

}

sub location2pixel {

  my $self   = shift;
  my $end    = $self->end + 1;
  my @coords = $self->{flip} ? map { $end-$_ } @_ : @_;
  $self->map_pt(@coords);

}

sub map_pt {

  my $self   = shift;
  my $offset = $self->{offset};
  my $scale  = $self->{scale} || $self->scale;
  my $pl     = $self->{pad_left};
  my $pr     = $self->{width} - $self->{pad_right};
  my $flip   = $self->{flip};
  my $length = $self->{length};
  my @result;
  foreach (@_) {
    my $val = $flip ? int (0.5 + $pr - ($length - ($_- 1)) * $scale) : int (0.5 + $pl + ($_-$offset-1) * $scale);
    $val = $pl-1 if $val < $pl;
    $val = $pr+1 if $val > $pr;
    push @result,$val;
  }
  @result;

}

sub map_no_trunc {

  my $self   = shift;
  my $offset = $self->{offset};
  my $scale  = $self->scale;
  my $pl     = $self->{pad_left};
  my $pr     = $self->{width} - $self->{pad_right};
  my $flip   = $self->{flip};
  my $length = $self->{length};
  my $end    = $offset+$length;
  my @result;
  foreach (@_) {
    my $val = $flip ? int (0.5 + $pl + ($end - ($_- 1)) * $scale) : int (0.5 + $pl + ($_-$offset-1) * $scale);
    push @result,$val;
  }
  @result;

}

sub scale {

  my $self = shift;
  $self->{scale} ||= ($self->{width}-$self->pad_left-$self->pad_right)/($self->length);

}

sub start {

 shift->{offset}+1

}

sub end {

 $_[0]->start + $_[0]->{length}-1

}

sub offset {

 shift->{offset}

}

sub width {

  my $self = shift;
  my $d = $self->{width};
  $self->{width} = shift if @_;
  $d;
#  $d + $self->pad_left + $self->pad_right;

}

sub left {

  my $self = shift;
  $self->pad_left;

}

sub right {

  my $self = shift;
  $self->width - $self->pad_right;

}

sub spacing {

  my $self = shift;
  my $d = $self->{spacing};
  $self->{spacing} = shift if @_;
  $d;

}

sub key_spacing {

  my $self = shift;
  my $d = $self->{key_spacing};
  $self->{key_spacing} = shift if @_;
  $d;

}

sub length {

  my $self = shift;
  my $d = $self->{length};
  if (@_) {
    my $l = shift;
    $l = $l->length if ref($l) && $l->can('length');
    $self->{length} = $l;
  }
  $d;

}

sub gridcolor {

shift->{gridcolor}

}

sub all_callbacks {

 shift->{all_callbacks}

}

sub add_track {

  my $self = shift;
  $self->_do_add_track(scalar(@{$self->{tracks}}),@_);

}

sub unshift_track {

  my $self = shift;
  $self->_do_add_track(0,@_);

}

sub insert_track {

  my $self = shift;
  my $position = shift;
  $self->_do_add_track($position,@_);

}

sub _do_add_track {

  my $self     = shift;
  my $position = shift;

  # due to indecision, we accept features
  # and/or glyph types in the first two arguments
  my ($features,$glyph_name) = ([],undef);
  while ( @_ && $_[0] !~ /^-/) {
    my $arg = shift;
    $features   = $arg and next if ref($arg);
    $glyph_name = $arg and next unless ref($arg);
  }

  my %args = @_;
  my ($map,$ss,%options);

  foreach (keys %args) {
    (my $canonical = lc $_) =~ s/^-//;
    if ($canonical eq 'glyph') {
      $map = $args{$_};
      delete $args{$_};
    } elsif ($canonical eq 'stylesheet') {
      $ss  = $args{$_};
      delete $args{$_};
    } else {
      $options{$canonical} = $args{$_};
    }
  }

  $glyph_name = $map if defined $map;
  $glyph_name ||= 'generic';

  local $^W = 0;  # uninitialized variable warnings under 5.00503

  my $panel_map =
    ref($map) eq 'CODE' ?  sub {
      my $feature = shift;
      return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'track' };
      return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'group' };
      return $map->($feature);
    }
   : ref($map) eq 'HASH' ? sub {
     my $feature = shift;
     return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'track' };
     return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'group' };
     return eval {$map->{$feature->primary_tag}} || 'generic';
   }
   : sub {
     my $feature = shift;
     return 'track' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'track' };
     return 'group' if eval { defined $feature->primary_tag && $feature->primary_tag  eq 'group' };
     return $glyph_name;
   };

  $self->_add_track($position,$features,-map=>$panel_map,-stylesheet=>$ss,-options=>\%options);

}

sub _add_track {

  my $self = shift;
  my ($position,$features,@options) = @_;

  # build the list of features into a Bio::Graphics::Feature object
  $features = [$features] unless ref $features eq 'ARRAY';

  # optional middle-level glyph is the group
  foreach my $f (grep {ref $_ eq 'ARRAY'} @$features) {
    next unless ref $f eq 'ARRAY';
    $f = Bio::Graphics::Feature->new(
				     -segments=>$f,
				     -type => 'group'
				    );
  }

  # top-level glyph is the track
  my $feature = Bio::Graphics::Feature->new(
					    -segments=>$features,
					    -start => $self->offset+1,
					    -stop  => $self->offset+$self->length,
					    -type => 'track'
					   );

  my $factory = Bio::Graphics::Glyph::Factory->new($self,@options);
  my $track   = $factory->make_glyph(-1,$feature);

  splice(@{$self->{tracks}},$position,0,$track);
  return $track;

}

sub height {

  my $self = shift;
  my $spacing           = $self->spacing;
  my $key_height        = $self->format_key;
  my $empty_track_style = $self->empty_track_style;
  my $key_style         = $self->key_style;
  my $bottom_key        = $key_style eq 'bottom';
  my $between_key       = $key_style eq 'between';
  my $draw_empty        = $empty_track_style =~ /^(line|dashed)$/;
  my $keyheight         = $self->{key_font}->height;
  my $height = 0;
  for my $track (@{$self->{tracks}}) {
    my $draw_between =  $between_key && $track->option('key');
    my $has_parts = $track->parts;
    next if !$has_parts && ($empty_track_style eq 'suppress'
		        or  $empty_track_style eq 'key' && $bottom_key);
    $height += $keyheight if $draw_between;
    $height += $self->spacing;
    $height += $track->layout_height;
  }

  # get rid of spacing under last track
  $height -= $self->spacing unless $bottom_key;
  return $height + $key_height + $self->pad_top + $self->pad_bottom;

}

sub gd {

  my $self        = shift;
  my $existing_gd = shift;

  local $^W = 0;  # can't track down the uninitialized variable warning

  return $self->{gd} if $self->{gd};

  my $width  = $self->width;
  my $height = $self->height;

  my $gd = $existing_gd || GD::Image->new($width,$height,
					  ($self->{truecolor} && GD::Image->can('isTrueColor') ? 1 : ())
					 );

  my %translation_table;
  for my $name ('white','black',keys %COLORS) {
    my $idx = $gd->colorAllocate(@{$COLORS{$name}});
    $translation_table{$name} = $idx;
  }

  $self->{translations} =\% translation_table;
  $self->{gd}           = $gd;
  if ($self->bgcolor) {
    $gd->fill(0,0,$self->bgcolor);
  } elsif (eval {$gd->isTrueColor}) {
    $gd->fill(0,0,$translation_table{'white'});
  }

  my $pl = $self->pad_left;
  my $pt = $self->pad_top;
  my $offset = $pt;
  my $keyheight   = $self->{key_font}->height;
  my $bottom_key  = $self->{key_style} eq 'bottom';
  my $between_key = $self->{key_style} eq 'between';
  my $left_key    = $self->{key_style} eq 'left';
  my $right_key   = $self->{key_style} eq 'right';
  my $empty_track_style = $self->empty_track_style;
  my $spacing = $self->spacing;

  # we draw in two steps, once for background of tracks, and once for
  # the contents.  This allows the grid to sit on top of the track background.
  for my $track (@{$self->{tracks}}) {
    my $draw_between = $between_key && $track->option('key');
    next if !$track->parts && ($empty_track_style eq 'suppress'
			   or  $empty_track_style eq 'key' && $bottom_key);
    $gd->filledRectangle($pl,
			 $offset,
			 $width-$self->pad_right,
			 $offset+$track->layout_height
			 + ($between_key ? $self->{key_font}->height : 0),
			 $track->tkcolor)
      if defined $track->tkcolor;
    $offset += $keyheight if $draw_between;
    $offset += $track->layout_height + $spacing;
  }

  $self->draw_grid($gd)  if $self->{grid};

  $offset = $pt;
  for my $track (@{$self->{tracks}}) {
    my $draw_between = $between_key && $track->option('key');
    my $has_parts = $track->parts;
    next if !$has_parts && ($empty_track_style eq 'suppress'
			or  $empty_track_style eq 'key' && $bottom_key);

    if ($draw_between) {
      $offset += $self->draw_between_key($gd,$track,$offset);
    }

    elsif ($self->{key_style} =~ /^(left|right)$/) {
      $self->draw_side_key($gd,$track,$offset,$self->{key_style});
    }

    $self->draw_empty($gd,$offset,$empty_track_style)
      if !$has_parts && $empty_track_style=~/^(line|dashed)$/;

    $track->draw($gd,0,$offset,0,1);
    $self->track_position($track,$offset);
    $offset += $track->layout_height + $spacing;
  }


  $self->draw_bottom_key($gd,$pl,$offset) if $self->{key_style} eq 'bottom';

  return $self->{gd} = $gd;

}

sub boxes {

  my $self = shift;
  my @boxes;
  my $offset = 0;

  my $pl = $self->pad_left;
  my $pt = $self->pad_top;
  my $between_key       = $self->{key_style} eq 'between';
  my $bottom_key        = $self->{key_style} eq 'bottom';
  my $empty_track_style = $self->empty_track_style;
  my $keyheight         = $self->{key_font}->height;
  my $spacing = $self->spacing;

  for my $track (@{$self->{tracks}}) {
    my $draw_between =  $between_key && $track->option('key');
    next if !$track->parts && ($empty_track_style eq 'suppress'
			    or  $empty_track_style eq 'key' && $bottom_key);
    $offset += $keyheight if $draw_between;
    my $boxes = $track->boxes(0,$offset+$pt);
    $self->track_position($track,$offset);
    push @boxes,@$boxes;
    $offset += $track->layout_height + $self->spacing;
  }
  return wantarray ? @boxes :\@ boxes;

}

sub track_position {

  my $self  = shift;
  my $track = shift;
  my $d = $self->{_track_position}{$track};
  $self->{_track_position}{$track} = shift if @_;
  $d;

}

sub draw_between_key {

  my $self   = shift;
  my ($gd,$track,$offset) = @_;
  my $key = $track->option('key') or return 0;
  my $x =   $self->{key_align} eq 'center' ? $self->width - (CORE::length($key) * $self->{key_font}->width)/2
          : $self->{key_align} eq 'right'  ? $self->width - CORE::length($key)
          : $self->pad_left;
  $gd->string($self->{key_font},$x,$offset,$key,1);
  return $self->{key_font}->height;

}

sub draw_side_key {

  my $self   = shift;
  my ($gd,$track,$offset,$side) = @_;
  my $key = $track->option('key') or return;
  my $pos = $side eq 'left' ? $self->pad_left - $self->{key_font}->width * CORE::length($key)-3
                            : $self->width - $self->pad_right+3;
  $gd->string($self->{key_font},$pos,$offset,$key,1);

}

sub draw_bottom_key {

  my $self = shift;
  my ($gd,$left,$top) = @_;
  my $key_glyphs = $self->{key_glyphs} or return;

  my $color = $self->translate_color($self->{key_color});
  $gd->filledRectangle($left,$top,$self->width - $self->pad_right,$self->height-$self->pad_bottom,$color);
  $gd->string($self->{key_font},$left,KEYPADTOP+$top,"KEY:",1);
  $top += $self->{key_font}->height + KEYPADTOP;

  $_->draw($gd,$left,$top) foreach @$key_glyphs;

}

sub format_key {

  my $self = shift;
  return 0 unless $self->key_style eq 'bottom';

  return $self->{key_height} if defined $self->{key_height};

  my $suppress = $self->{empty_track_style} eq 'suppress';
  my $between  = $self->{key_style}         eq 'between';

  if ($between) {
    my @key_tracks = $suppress
      ? grep {$_->option('key') && $_->parts} @{$self->{tracks}}
      : grep {$_->option('key')} @{$self->{tracks}};
    return $self->{key_height} = @key_tracks * $self->{key_font}->height;
  }

  elsif ($self->{key_style} eq 'bottom') {

    my ($height,$width) = (0,0);
    my %tracks;
    my @glyphs;

    # determine how many glyphs become part of the key
    # and their max size
    for my $track (@{$self->{tracks}}) {

      next unless $track->option('key');
      next if $suppress && !$track->parts;

      my $glyph;
      if (my @parts = $track->parts) {
	$glyph = $parts[0]->keyglyph;
      } else {
	my $t = Bio::Graphics::Feature->new(-segments=>
					    [Bio::Graphics::Feature->new(-start => $self->offset,
									 -stop  => $self->offset+$self->length)]);
	my $g = $track->factory->make_glyph(0,$t);
	$glyph = $g->keyglyph;
      }
      next unless $glyph;


      $tracks{$track} = $glyph;
      my ($h,$w) = ($glyph->layout_height,
		    $glyph->layout_width);
      $height = $h if $h > $height;
      $width  = $w if $w > $width;
      push @glyphs,$glyph;

    }

    $width += $self->key_spacing;

    # no key glyphs, no key
    return $self->{key_height} = 0 unless @glyphs;

    # now height and width hold the largest glyph, and $glyph_count
    # contains the number of glyphs.  We will format them into a
    # box that is roughly 3 height/4 width (golden mean)
    my $rows = 0;
    my $cols = 0;
    my $maxwidth = $self->width - $self->pad_left - $self->pad_right;
    while (++$rows) {
      $cols = @glyphs / $rows;
      $cols = int ($cols+1) if $cols =~ /\./;  # round upward for fractions
      my $total_width  = $cols * $width;
      my $total_height = $rows * $width;
      last if $total_width < $maxwidth;
    }

    # move glyphs into row-major format
    my $spacing = $self->key_spacing;
    my $i = 0;
    for (my $c = 0; $c < $cols; $c++) {
      for (my $r = 0; $r < $rows; $r++) {
	my $x = $c * ($width  + $spacing);
	my $y = $r * ($height + $spacing);
	next unless defined $glyphs[$i];
	$glyphs[$i]->move($x,$y);
	$i++;
      }
    }

    $self->{key_glyphs} =\@ glyphs;     # remember our key glyphs
    # remember our key height
    return $self->{key_height} =
      ($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP;
  }

  else {  # no known key style, neither "between" nor "bottom"
    return $self->{key_height} = 0;
  }

}

sub draw_empty {

  my $self  = shift;
  my ($gd,$offset,$style) = @_;
  $offset  += $self->spacing/2;
  my $left  = $self->pad_left;
  my $right = $self->width-$self->pad_right;
  my $color = $self->translate_color(MISSING_TRACK_COLOR);
  if ($style eq 'dashed') {
    $gd->setStyle($color,$color,gdTransparent,gdTransparent);
    $gd->line($left,$offset,$right,$offset,gdStyled);
  } else {
    $gd->line($left,$offset,$right,$offset,$color);
  }
  $offset;

}

sub draw_grid {

  my $self = shift;
  my $gd = shift;

  my $gridcolor = $self->translate_color($self->{gridcolor});
  my @positions;
  if (ref $self->{grid} eq 'ARRAY') {
    @positions = @{$self->{grid}};
  } else {
    my ($major,$minor) = $self->ticks;
    my $first_tick = $minor * int(0.5 + $self->start/$minor);
    for (my $i = $first_tick; $i < $self->end; $i += $minor) {
      push @positions,$i;
    }
  }
  my $pl = $self->pad_left;
  my $pt = $self->pad_top;
  my $pb = $self->height - $self->pad_bottom;
  local $self->{flip} = 0;
  for my $tick (@positions) {
    my ($pos) = $self->map_pt($tick);
    $gd->line($pos,$pt,$pos,$pb,$gridcolor);
  }

}

sub ticks {

  my $self = shift;
  my ($length,$minwidth) = @_;

  $length   = $self->{length}       unless defined $length;
  $minwidth = gdSmallFont->width*7  unless defined $minwidth;

  my ($major,$minor);

  # figure out tick mark scale
  # we want no more than 1 major tick mark every 40 pixels
  # and enough room for the labels
  my $scale = $self->scale;

  my $interval = 1;

  while (1) {
    my $pixels = $interval * $scale;
    last if $pixels >= $minwidth;
    $interval *= 10;
  }

  # to make sure a major tick shows up somewhere in the first half
  #
  $interval *= .5 if ($interval > 0.5*$length);

  return ($interval,$interval/10);

}

sub rgb {

  my $self = shift;
  my $idx  = shift;
  my $gd = $self->{gd} or return;
  return $gd->rgb($idx);

}

sub translate_color {

  my $self = shift;
  my @colors = @_;
  if (@colors == 3) {
    my $gd = $self->gd or return 1;
    return $self->colorClosest($gd,@colors);
  }
  elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
    my $gd = $self->gd or return 1;
    my ($r,$g,$b) = (hex($1),hex($2),hex($3));
    return $self->colorClosest($gd,$r,$g,$b);
  }
  else {
    my $color = $colors[0];
    my $table = $self->{translations} or return 1;
    return defined $table->{$color} ? $table->{$color} : 1;
  }

}

sub colorClosest {

  my ($self,$gd,@c) = @_;
  return $self->{closestcache}{"@c"} if exists $self->{closestcache}{"@c"};
  return $self->{closestcache}{"@c"} = $gd->colorClosest(@c) if $GD::VERSION < 2.04;
  my ($value,$index);
  for (keys %COLORS) {
    my ($r,$g,$b) = @{$COLORS{$_}};
    my $dist = ($r-$c[0])**2 + ($g-$c[1])**2 + ($b-$c[2])**2;
    ($value,$index) = ($dist,$_) if !defined($value) || $dist < $value;
  }
  return $self->{closestcache}{"@c"} = $self->{translations}{$index};

}

sub bgcolor {

   my $self = shift;
   return unless $self->{bgcolor};
   $self->translate_color($self->{bgcolor});

}

sub set_pen {

  my $self = shift;
  my ($linewidth,$color) = @_;
  return $self->{pens}{$linewidth,$color} if $self->{pens}{$linewidth,$color};

  my $pen = $self->{pens}{$linewidth} = GD::Image->new($linewidth,$linewidth);
  my @rgb = $self->rgb($color);
  my $bg = $pen->colorAllocate(255,255,255);
  my $fg = $pen->colorAllocate(@rgb);
  $pen->fill(0,0,$fg);
  $self->{gd}->setBrush($pen);
  return gdBrushed;

}

sub png {

  my $gd = shift->gd;
  $gd->png;

}

sub read_colors {

  my $class = shift;
  while (<DATA>) {
    chomp;
    last if /^__END__/;
    my ($name,$r,$g,$b) = split /\s+/;
    $COLORS{$name} = [hex $r,hex $g,hex $b];
  }

}

sub color_name_to_rgb {

  my $class = shift;
  my $color_name  = shift;
  $class->read_colors() unless %COLORS;
  return unless $COLORS{$color_name};
  return wantarray ? @{$COLORS{$color_name}}
                   : $COLORS{$color_name};

}

sub color_names {

    my $class = shift;
    $class->read_colors unless %COLORS;
    return wantarray ? keys %COLORS : [keys %COLORS];

}

General documentation

new() is the constructor for Bio::Graphics::Panel:
    The new() method creates a new panel object. The options are
a set of tag/value pairs as follows:

  Option      Value                                  Default
  ------      -----                                  -------

  -offset     Base pair to place at extreme left     none
	      of image, in zero-based coordinates

  -length     Length of sequence segment, in bp      none

  -start      Start of range, in 1-based             none
              coordinates.

  -stop       Stop of range, in 1-based              none
	      coordinates.

  -segment    A Bio::SeqI or Das::Segment            none
              object, used to derive sequence
	      range if not otherwise specified.

  -width      Desired width of image, in pixels      600

  -spacing    Spacing between tracks, in pixels      5

  -pad_top    Additional whitespace between top      0
	      of image and contents, in pixels

  -pad_bottom Additional whitespace between top      0
	      of image and bottom, in pixels

  -pad_left   Additional whitespace between left     0
	      of image and contents, in pixels

  -pad_right  Additional whitespace between right    0
	      of image and bottom, in pixels

  -bgcolor    Background color for the panel as a    white
	      whole

  -key_color  Background color for the key printed   wheat
              at bottom of panel (if any)

  -key_spacing Spacing between key glyphs in the     10
               key printed at bottom of panel
               (if any)

  -key_font    Font to use in printed key            gdMediumBoldFont
	       captions.

  -key_style   Whether to print key at bottom of     none
	       panel ("bottom"), between each
	       track ("between"), to the left of
               each track ("left"), to the right
               of each track ("right") or
               not at all ("none").

  -empty_tracks What to do when a track is empty.    suppress
              Options are to suppress the track
              completely ("suppress"), to show just
              the key in "between" mode ("key"),
              to draw a thin grey line ("line"),
              or to draw a dashed line ("dashed").

  -flip       flip the drawing coordinates left     false
              to right, so that lower coordinates
              are to the right.  This can be
              useful for drawing (-) strand
              features.

  -all_callbacks Whether to invoke callbacks on      false
               the automatic "track" and "group"
               glyphs.

  -grid        Whether to draw a vertical grid in    false
               the background.  Pass a scalar true
               value to have a grid drawn at
               regular intervals (corresponding
               to the minor ticks of the arrow
	       glyph).  Pass an array reference
               to draw the grid at the specified
               positions.

  -gridcolor   Color of the grid                     lightcyan

    Typically you will pass new() an object that implements the
Bio::RangeI interface, providing a length() method, from which the
panel will derive its scale.

  $panel = Bio::Graphics::Panel->new(-segment => $sequence,
				     -width   => 800);

    new() will return undef in case of an error.
    Note that if you use the "left" or "right" key styles, you are
responsible for allocating sufficient -pad_left or -pad_right room for
the labels to appear. The necessary width is the number of characters
in the longest key times the font width (gdMediumBoldFont by default)
plus 3 pixels of internal padding. The simplest way to calculate this
is to iterate over the possible track labels, find the largest one,
and then to compute its width using the formula:

  $width = gdMediumBoldFont->width * length($longest_key) +3;

    The add_track() method adds a new track to the image.
    Tracks are horizontal bands which span the entire width of the panel.
Each track contains a number of graphical elements called "glyphs",
corresponding to a sequence feature.
    There are a large number of glyph types. By default, each track will
be homogeneous on a single glyph type, but you can mix several glyph
types on the same track by providing a code reference to the -glyph
argument. Other options passed to add_track() control the color and
size of the glyphs, whether they are allowed to overlap, and other
formatting attributes. The height of a track is determined from its
contents and cannot be directly influenced.
    The first two arguments are the glyph name and an array reference
containing the list of features to display. The order of the
arguments is irrelevant, allowing either of these idioms:

  $panel->add_track(arrow => \@features);
  $panel->add_track(\@features => 'arrow');

    The glyph name indicates how each feature is to be rendered. A
variety of glyphs are available, and the number is growing. You may
omit the glyph name entirely by providing a -glyph argument among @options, as described below.
    Currently, the following glyphs are available:

  Name        Description
  ----        -----------

  anchored_arrow
              a span with vertical bases |---------|.  If one or
              the other end of the feature is off-screen, the base
              will be replaced by an arrow.

  arrow	      An arrow; can be unidirectional or bidirectional.
	      It is also capable of displaying a scale with
	      major and minor tickmarks, and can be oriented
	      horizontally or vertically.

  cds         Draws CDS features, using the phase information to
              show the reading frame usage.  At high magnifications
              draws the protein translation.

  crossbox    A box with a big "X" inside it.

  diamond     A diamond, useful for point features like SNPs.

  dna         At high magnification draws the DNA sequence.  At
              low magnifications draws the GC content.

  dot         A circle, useful for point features like SNPs, stop
              codons, or promoter elements.

  ellipse     An oval.

  extending_arrow
              Similar to arrow, but a dotted line indicates when the
              feature extends beyond the end of the canvas.

  generic     A filled rectangle, nondirectional.

  graded_segments
              Similar to segments, but the intensity of the color
              is proportional to the score of the feature.  This
              is used for showing the intensity of blast hits or
              other alignment features.

  group	      A group of related features connected by a dashed line.
	      This is used internally by Panel.

  heterogeneous_segments
              Like segments, but you can use the source field of the feature
              to change the color of each segment.

  line        A simple line.

  pinsertion  A triangle designed to look like an insertion location
              (e.g. a transposon insertion).

  processed_transcript  multi-purpose representation of a spliced mRNA, including
			positions of UTRs

  primers     Two inward pointing arrows connected by a line.
	      Used for STSs.

  redgreen_box A box that changes from green->yellow->red as the score
              of the feature increases from 0.0 to 1.0.  Useful for
              representing microarray results.

  rndrect     A round-cornered rectangle.

  segments    A set of filled rectangles connected by solid lines.
	      Used for interrupted features, such as gapped
	      alignments.

  ruler_arrow An arrow with major and minor tick marks and interval
              labels.

  toomany     Tries to show many features as a cloud.  Not very successful.

  track	      A group of related features not connected by a line.
	      This is used internally by Panel.

  transcript  Similar to segments, but the connecting line is
	      a "hat" shape, and the direction of transcription
	      is indicated by a small arrow.

  transcript2  Similar to transcript, but the direction of
              transcription is indicated by a terminal exon
              in the shape of an arrow.

  translation 1, 2 and 3-frame translations.  At low magnifications,
              can be configured to show start and stop codon locations.
              At high magnifications, shows the multi-frame protein
              translation.

  triangle    A triangle whose width and orientation can be altered.

  xyplot      Histograms and other graphs plotted against the genome.

    If the glyph name is omitted from add_track(), the "generic" glyph
will be used by default. To get more information about a glyph, run
perldoc on "Bio::Graphics::Glyph::glyphname", replacing "glyphname"
with the name of the glyph you are interested in.
    The @options array is a list of name/value pairs that control the
attributes of the track. Some options are interpretered directly by
the track. Others are passed down to the individual glyphs (see
"GLYPH OPTIONS"). The following options are track-specific:

  Option      Description                  Default
  ------      --