Summary

Bio::Graphics::Glyph - Base class for Bio::Graphics::Glyph objects

Package variables

Included modules

Synopsis

See Bio::Graphics::Panel.

Description

Bio::Graphics::Glyph is the base class for all glyph objects. Each
glyph is a wrapper around an Bio:SeqFeatureI object, knows how to
render itself on an Bio::Graphics::Panel, and has a variety of
configuration variables.
End developers will not ordinarily work directly with
Bio::Graphics::Glyph objects, but with Bio::Graphics::Glyph::generic
and its subclasses. Similarly, most glyph developers will want to
subclass from Bio::Graphics::Glyph::generic because the latter
provides labeling and arrow-drawing facilities.

Methods

Methods description

None available.

Methods code

sub new {

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

  my $feature = $arg{-feature} or die "No feature";
  my $factory = $arg{-factory} || $class->default_factory;
  my $level   = $arg{-level} || 0;
  my $flip    = $arg{-flip};

  my $self = bless {},$class;
  $self->{feature} = $feature;
  $self->{factory} = $factory;
  $self->{level}   = $level;
  $self->{flip}++  if $flip;
  $self->{top} = 0;

  my @subglyphs;
  my @subfeatures = $self->subseq($feature);

  if (@subfeatures) {

    # dynamic glyph resolution
    @subglyphs = map { $_->[0] }
          sort { $a->[1] <=> $b->[1] }
             map { [$_, $_->left ] } 
    $factory->make_glyph($level+1,@subfeatures);

    $self->{parts}   =\@ subglyphs;
  }

  my ($start,$stop) = ($self->start, $self->stop);
  if (defined $start && defined $stop) {
    ($start,$stop) = ($stop,$start) if $start > $stop;  # sheer paranoia
    # the +1 here is critical for allowing features to meet nicely at nucleotide resolution
    my ($left,$right) = $factory->map_pt($start,$stop+1);
    $self->{left}    = $left;
    $self->{width}   = $right - $left + 1;
  }
  if (@subglyphs) {
      my $l            = $subglyphs[0]->left;
      $self->{left}    = $l if !defined($self->{left}) || $l < $self->{left};
      my $right        = (
			  sort { $b<=>$a } 
			  map {$_->right} @subglyphs)[0];
      my $w            = $right - $self->{left} + 1;
      $self->{width}   = $w if !defined($self->{width}) || $w > $self->{width};
  }

  $self->{point} = $arg{-point} ? $self->height : undef;
  #Handle glyphs that don't actually fill their space, but merely mark a point.
  #They need to have their collision bounds altered.  We will (for now)
  #hard code them to be in the center of their feature.
# note: this didn't actually seem to work properly, all features were aligned on
# their right edges.  It works to do it in individual point-like glyphs such as triangle.
#  if($self->option('point')){
#    my ($left,$right) = $factory->map_pt($self->start,$self->stop);
#    my $center = int(($left+$right)/2 + 0.5);

#    $self->{width} = $self->height;
#    $self->{left}  = $center - ($self->{width});
#    $self->{right} = $center + ($self->{width});
#  }

  return $self;

}

sub parts {

  my $self = shift;
  return unless $self->{parts};
  return wantarray ? @{$self->{parts}} : $self->{parts};

}

sub feature {

 shift->{feature}

}

sub factory {

 shift->{factory}

}

sub panel {

 shift->factory->panel

}

sub point {

 shift->{point}

}

sub scale {

 shift->factory->scale

}

sub start {

  my $self = shift;
  return $self->{start} if exists $self->{start};
  $self->{start} = $self->{flip} ? $self->panel->end + 1 - $self->{feature}->end : $self->{feature}->start;

  # handle the case of features whose endpoints are undef
  # (this happens with wormbase clones where one or more clone end is not defined)
  # in this case, we set the start to one minus the beginning of the panel
  $self->{start} = $self->panel->offset - 1 unless defined $self->{start};

  return $self->{start};

}

sub stop {

  my $self = shift;
  return $self->{stop} if exists $self->{stop};
  $self->{stop} = $self->{flip} ?  $self->panel->end + 1 - $self->{feature}->start : $self->{feature}->end;

  # handle the case of features whose endpoints are undef
  # (this happens with wormbase clones where one or more clone end is not defined)
  # in this case, we set the start to one plus the end of the panel
  $self->{stop} = $self->panel->offset + $self->panel->length + 1 unless defined $self->{stop};

  return $self->{stop}

}

sub end {

 shift->stop

}

sub length {

 my $self = shift; $self->stop - $self->start };

}

sub score {

    my $self = shift;
    return $self->{score} if exists $self->{score};
    return $self->{score} = ($self->{feature}->score || 0);

}

sub strand {

    my $self = shift;
    return $self->{strand} if exists $self->{strand};
    return $self->{strand} = ($self->{feature}->strand || 0);

}

sub map_pt {

 shift->{factory}->map_pt(@_)

}

sub map_no_trunc {

 shift->{factory}->map_no_trunc(@_)

}

sub add_feature {

  my $self       = shift;
  my $factory    = $self->factory;
  for my $feature (@_) {
    if (ref $feature eq 'ARRAY') {
      $self->add_group(@$feature);
    } else {
      push @{$self->{parts}},$factory->make_glyph(0,$feature);
    }
  }

}

sub add_group {

  my $self = shift;
  my @features = ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_;
  my $f    = Bio::Graphics::Feature->new(
					 -segments=>\@features,
					 -type => 'group'
					);
  $self->add_feature($f);

}

sub top {

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

}

sub left {

  my $self = shift;
  return $self->{left} - $self->pad_left;

}

sub right {

  my $self = shift;
  return $self->left + $self->layout_width - 1;

}

sub bottom {

  my $self = shift;
  $self->top + $self->layout_height - 1;

}

sub height {

  my $self = shift;
  return $self->{height} if exists $self->{height};
  my $baseheight = $self->option('height');  # what the factory says
  return $self->{height} = $baseheight;

}

sub width {

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

}

sub layout_height {

  my $self = shift;
  return $self->layout;

}

sub layout_width {

  my $self = shift;
  return $self->width + $self->pad_left + $self->pad_right;

}

sub calculate_boundaries {

return shift->bounds(@_);

}

sub bounds {

  my $self = shift;
  my ($dx,$dy) = @_;
  $dx += 0; $dy += 0;
  ($dx + $self->{left},
   $dy + $self->top    + $self->pad_top,
   $dx + $self->{left} + $self->{width} - 1,
   $dy + $self->bottom - $self->pad_bottom);

}

sub box {

  my $self = shift;
  return ($self->left,$self->top,$self->right,$self->bottom);

}

sub unfilled_box {

  my $self = shift;
  my $gd   = shift;
  my ($x1,$y1,$x2,$y2,$fg,$bg) = @_;

  my $linewidth = $self->option('linewidth') || 1;

  unless ($fg) {
      $fg ||= $self->fgcolor;
  $fg = $self->set_pen($linewidth,$fg) if $linewidth > 1;
  }

  unless ($bg) {
      $bg ||= $self->bgcolor;
      $bg = $self->set_pen($linewidth,$bg) if $linewidth > 1;
  }

  # draw a box
  $gd->rectangle($x1,$y1,$x2,$y2,$fg);

  # if the left end is off the end, then cover over
  # the leftmost line
  my ($width) = $gd->getBounds;

  $gd->line($x1,$y1+$linewidth,$x1,$y2-$linewidth,$bg)
    if $x1 < $self->panel->pad_left;

  $gd->line($x2,$y1+$linewidth,$x2,$y2-$linewidth,$bg)
    if $x2 > $width - $self->panel->pad_right;

}

sub boxes {

  my $self = shift;
  my ($left,$top) = @_;
  $top  += 0; $left += 0;
  my @result;

  $self->layout;
  my @parts = $self->parts;
  @parts    = $self if !@parts && $self->option('box_subparts') && $self->level>0;

  for my $part ($self->parts) {
    if (eval{$part->feature->primary_tag} eq 'group' or
	($part->level == 0 && $self->option('box_subparts'))) {
      push @result,$part->boxes($left+$self->left+$self->pad_left,$top+$self->top+$self->pad_top);
    } else {
      my ($x1,$y1,$x2,$y2) = $part->box;
      push @result,[$part->feature,$x1,$top+$self->top+$self->pad_top+$y1,
		                   $x2,$top+$self->top+$self->pad_top+$y2];
    }
  }
  return wantarray ? @result :\@ result;

}

sub pad_top {

  my $self = shift;
  return 0;

}

sub pad_bottom {

  my $self = shift;
  return 0;

}

sub pad_left {

  my $self = shift;
  return 0;

}

sub pad_right {

  my $self = shift;
# this shouldn't be necessary
  my @parts = $self->parts or return 0;
  my $max = 0;
  foreach (@parts) {
    my $pr = $_->pad_right;
    $max = $pr if $max < $pr;
  }
  $max;

}

sub move {

  my $self = shift;
  my ($dx,$dy) = @_;
  $self->{left} += $dx;
  $self->{top}  += $dy;

  # because the feature parts use *absolute* not relative addressing
  # we need to move each of the parts horizontally, but not vertically
  $_->move($dx,0) foreach $self->parts;

}

sub option {

  my $self = shift;
  my $option_name = shift;
  my $factory = $self->factory;
  return unless $factory;
  $factory->option($self,$option_name,@{$self}{qw(partno total_parts)});

}

sub configure {

  my $self = shift;
  my $factory = $self->factory;
  my $option_map = $factory->option_map;
  while (@_) {
    my $option_name  = shift;
    my $option_value = shift;
    ($option_name = lc $option_name) =~ s/^-//;
    $option_map->{$option_name} = $option_value;
  }

}

sub color {

  my $self = shift;
  my $color = shift;
  my $index = $self->option($color);
  # turn into a color index
  return $self->factory->translate_color($index) if defined $index;
  return 0;

}

sub connector {

  return shift->option('connector',@_);

}

sub bump {

  my $self = shift;
  return $self->option('bump');

}

sub fgcolor {

  my $self = shift;
  my $color = $self->option('fgcolor');
  my $index = defined $color ? $color : $self->option('color');
  $index = 'black' unless defined $index;
  $self->factory->translate_color($index);

}

sub fillcolor {

    my $self = shift;
    return $self->bgcolor;

}

sub bgcolor {

  my $self = shift;
  my $bgcolor = $self->option('bgcolor');
  my $index = defined $bgcolor ? $bgcolor : $self->option('fillcolor');
  $index = 'white' unless defined $index;
  $self->factory->translate_color($index);

}

sub font {

  my $self = shift;
  my $font = $self->option('font');
  unless (UNIVERSAL::isa($font,'GD::Font')) {
    my $ref    = {
		  gdTinyFont  => gdTinyFont,
		  gdSmallFont => gdSmallFont,
		  gdMediumBoldFont => gdMediumBoldFont,
		  gdLargeFont => gdLargeFont,
		  gdGiantFont => gdGiantFont};
    my $gdfont = $ref->{$font} || $font;
    $self->configure(font=>$gdfont);
    return $gdfont;
  }
  return $font;

}

sub fontcolor {

  my $self = shift;
  my $fontcolor = $self->color('fontcolor');
  return defined $fontcolor ? $fontcolor : $self->fgcolor;

}

sub font2color {

  my $self = shift;
  my $font2color = $self->color('font2color');
  return defined $font2color ? $font2color : $self->fgcolor;

}

sub tkcolor {

 # "track color"  my $self = shift;
  $self->option('tkcolor') or return;
  return $self->color('tkcolor')

}

sub connector_color {

  my $self = shift;
  $self->color('connector_color') || $self->fgcolor;

}

sub layout_sort {

    my $self = shift;
    my $sortfunc;

    my $opt = $self->option("sort_order");
    if (!$opt) {
       $sortfunc = eval 'sub { $a->left <=> $b->left }';
    } elsif (ref $opt eq 'CODE') {
       $sortfunc = $opt;
    } elsif ($opt =~ /^sub\s+\{/o) {
       $sortfunc = eval $opt;
    } else {
       # build $sortfunc for ourselves:
       my @sortbys = split(/\s*\|\s*/o, $opt);
       $sortfunc = 'sub { ';
       my $sawleft = 0;

       # not sure I can make this schwartzian transfored
       for my $sortby (@sortbys) {
	 if ($sortby eq "left" || $sortby eq "default") {
	   $sortfunc .= '($a->left <=> $b->left) || ';
	   $sawleft++;
	 } elsif ($sortby eq "right") {
	   $sortfunc .= '($a->right <=> $b->right) || ';
	 } elsif ($sortby eq "low_score") {
	   $sortfunc .= '($a->score <=> $b->score) || ';
	 } elsif ($sortby eq "high_score") {
	   $sortfunc .= '($b->score <=> $a->score) || ';
	 } elsif ($sortby eq "longest") {
	   $sortfunc .= '(($b->length) <=> ($a->length)) || ';
	 } elsif ($sortby eq "shortest") {
	   $sortfunc .= '(($a->length) <=> ($b->length)) || ';
	 } elsif ($sortby eq "strand") {
	   $sortfunc .= '($b->strand <=> $a->strand) || ';
	 } elsif ($sortby eq "name") {
	   $sortfunc .= '($a->feature->display_name cmp $b->feature->display_name) || ';
	 }
       }
       unless ($sawleft) {
           $sortfunc .= ' ($a->left <=> $b->left) ';
       } else {
           $sortfunc .= ' 0';
       }
       $sortfunc .= '}';
       $sortfunc = eval $sortfunc;
    }

    # cache this
    # $self->factory->set_option(sort_order => $sortfunc);

    return sort $sortfunc @_;

}

sub layout {

  my $self = shift;
  return $self->{layout_height} if exists $self->{layout_height};

  my @parts = $self->parts;
  return $self->{layout_height}
    = $self->height + $self->pad_top + $self->pad_bottom unless @parts;

  my $bump_direction = $self->bump;
  my $bump_limit = $self->option('bump_limit') || -1;

  $_->layout foreach @parts;  # recursively lay out

  # no bumping requested, or only one part here
  if (@parts == 1 || !$bump_direction) {
    my $highest = 0;
    foreach (@parts) {
      my $height = $_->layout_height;
      $highest   = $height > $highest ? $height : $highest;
    }
    return $self->{layout_height} = $highest + $self->pad_top + $self->pad_bottom;
  }

  my (%bin1,%bin2);
  for my $g ($self->layout_sort(@parts)) {

    my $pos = 0;
    my $bumplevel = 0;
    my $left   = $g->left;
    my $right  = $g->right;
    my $height = $g->{layout_height};

    while (1) {

      # stop bumping if we've gone too far down
      if ($bump_limit > 0 && $bumplevel++ >= $bump_limit) {
	$g->{overbumped}++;  # this flag can be used to suppress label and description
	foreach ($g->parts) {
	  $_->{overbumped}++;
	}
	last;
      }

      # look for collisions
      my $bottom = $pos + $height;
      $self->collides(\%bin1,CM1,CM2,$left,$pos,$right,$bottom) or last;
      my $collision = $self->collides(\%bin2,CM3,CM4,$left,$pos,$right,$bottom) or last;

      if ($bump_direction > 0) {
	$pos += $collision->[3]-$collision->[1] + BUMP_SPACING;    # collision, so bump

      } else {
	$pos -= BUMP_SPACING;
      }

    }

    $g->move(0,$pos);
    $self->add_collision(\%bin1,CM1,CM2,$left,$g->top,$right,$g->bottom);
    $self->add_collision(\%bin2,CM3,CM4,$left,$g->top,$right,$g->bottom);
  }

  # If -1 bumping was allowed, then normalize so that the top glyph is at zero
  if ($bump_direction < 0) {
    my $topmost;
    foreach (@parts) {
      my $top  = $_->top;
      $topmost = $top if !defined($topmost) or $top < $topmost;
    }
    my $offset = - $topmost;
    $_->move(0,$offset) foreach @parts;
  }

  # find new height
  my $bottom = 0;
  foreach (@parts) {
    $bottom = $_->bottom if $_->bottom > $bottom;
  }
  return $self->{layout_height} = $self->pad_bottom + $self->pad_top + $bottom - $self->top  + 1;

}

sub collides {

  my $self = shift;
  my ($occupied,$cm1,$cm2,$left,$top,$right,$bottom) = @_;
  my @keys = $self->_collision_keys($cm1,$cm2,$left,$top,$right,$bottom);
  my $collides = 0;
  for my $k (@keys) {
    next unless exists $occupied->{$k};
    for my $bounds (@{$occupied->{$k}}) {
      my ($l,$t,$r,$b) = @$bounds;
      next unless $right >= $l and $left <= $r and $bottom >= $t and $top <= $b;
      $collides = $bounds;
      last;
    }
  }
  $collides;

}

sub add_collision {

  my $self = shift;
  my ($occupied,$cm1,$cm2,$left,$top,$right,$bottom) = @_;
  my $value = [$left,$top,$right+2,$bottom];
  my @keys = $self->_collision_keys($cm1,$cm2,@$value);
  push @{$occupied->{$_}},$value foreach @keys;

}

sub _collision_keys {

  my $self = shift;
  my ($binx,$biny,$left,$top,$right,$bottom) = @_;
  my @keys;
  my $bin_left   = int($left/$binx);
  my $bin_right  = int($right/$binx);
  my $bin_top    = int($top/$biny);
  my $bin_bottom = int($bottom/$biny);
  for (my $x=$bin_left;$x<=$bin_right; $x++) {
    for (my $y=$bin_top;$y<=$bin_bottom; $y++) {
      push @keys,join(',',$x,$y);
    }
  }
  @keys;

}

sub draw {

  my $self = shift;
  my $gd = shift;
  my ($left,$top,$partno,$total_parts) = @_;

  local($self->{partno},$self->{total_parts});
  @{$self}{qw(partno total_parts)} = ($partno,$total_parts);

  my $connector =  $self->connector;
  if (my @parts = $self->parts) {

    # invoke sorter if use wants to sort always and we haven't already sorted
    # during bumping.
    @parts = $self->layout_sort(@parts) if !$self->bump && $self->option('always_sort');

    my $x = $left;
    my $y = $top  + $self->top + $self->pad_top;
    $self->draw_connectors($gd,$x,$y) if $connector && $connector ne 'none';

    my $last_x;
    for (my $i=0; $i<@parts; $i++) {
      # lie just a little bit to avoid lines overlapping and
      # make the picture prettier
      my $fake_x = $x;
      $fake_x-- if defined $last_x && $parts[$i]->left - $last_x == 1;
      $parts[$i]->draw($gd,$fake_x,$y,$i,scalar(@parts));
      $last_x = $parts[$i]->right;
    }
  }

  else {  # no part
    $self->draw_connectors($gd,$left,$top)
      if $connector && $connector ne 'none' && $self->{level} == 0;
    $self->draw_component($gd,$left,$top);
  }

}

sub level {

  shift->{level};

}

sub draw_connectors {

  my $self = shift;
  return if $self->{overbumped};
  my $gd = shift;
  my ($dx,$dy) = @_;
  my @parts = sort { $a->left <=> $b->left } $self->parts;
  for (my $i = 0; $i < @parts-1; $i++) {
    $self->_connector($gd,$dx,$dy,$parts[$i]->bounds,$parts[$i+1]->bounds);
  }

  # extra connectors going off ends
  if (@parts) {
    my($x1,$y1,$x2,$y2) = $self->bounds(0,0);
    my($xl,$xt,$xr,$xb) = $parts[0]->bounds;
    $self->_connector($gd,$dx,$dy,$x1,$xt,$x1,$xb,$xl,$xt,$xr,$xb)      if $x1 < $xl;
    my ($xl2,$xt2,$xr2,$xb2) = $parts[-1]->bounds;
    $self->_connector($gd,$dx,$dy,$parts[-1]->bounds,$x2,$xt2,$x2,$xb2) if $x2 > $xr;
  }

}

sub _connector {

  my $self = shift;
  my ($gd,
      $dx,$dy,
      $xl,$xt,$xr,$xb,
      $yl,$yt,$yr,$yb) = @_;
  my $left   = $dx + $xr;
  my $right  = $dx + $yl;
  my $top1     = $dy + $xt;
  my $bottom1  = $dy + $xb;
  my $top2     = $dy + $yt;
  my $bottom2  = $dy + $yb;
  # restore this comment if you don't like the group dash working
  # its way backwards.
  return if $right-$left < 1 && !$self->isa('Bio::Graphics::Glyph::group');

  $self->draw_connector($gd,
			$top1,$bottom1,$left,
			$top2,$bottom2,$right,
		       );

}

sub draw_connector {

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

  my $color          = $self->connector_color;
  my $connector_type = $self->connector or return;

  if ($connector_type eq 'hat') {
    $self->draw_hat_connector($gd,$color,@_);
  } elsif ($connector_type eq 'solid') {
    $self->draw_solid_connector($gd,$color,@_);
  } elsif ($connector_type eq 'dashed') {
    $self->draw_dashed_connector($gd,$color,@_);
  } elsif ($connector_type eq 'quill') {
    $self->draw_quill_connector($gd,$color,@_);
  } else {
    ; # draw nothing
  }

}

sub draw_hat_connector {

  my $self = shift;
  my $gd   = shift;
  my $color = shift;
  my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;

  my $center1  = ($top1 + $bottom1)/2;
  my $quarter1 = $top1 + ($bottom1-$top1)/4;
  my $center2  = ($top2 + $bottom2)/2;
  my $quarter2 = $top2 + ($bottom2-$top2)/4;

  if ($center1 != $center2) {
    $self->draw_solid_connector($gd,$color,@_);
    return;
  }

  if ($right - $left > 4) {  # room for the inverted "V"
      my $middle = $left + int(($right - $left)/2);
      $gd->line($left,$center1,$middle,$top1,$color);
      $gd->line($middle,$top1,$right-1,$center1,$color);
    } elsif ($right-$left > 1) { # no room, just connect
      $gd->line($left,$quarter1,$right-1,$quarter1,$color);
    }

}

sub draw_solid_connector {

  my $self = shift;
  my $gd   = shift;
  my $color = shift;
  my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;

  my $center1  = ($top1 + $bottom1)/2;
  my $center2  = ($top2 + $bottom2)/2;

  $gd->line($left,$center1,$right,$center2,$color);

}

sub draw_dashed_connector {

  my $self = shift;
  my $gd   = shift;
  my $color = shift;
  my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;

  my $center1  = ($top1 + $bottom1)/2;
  my $center2  = ($top2 + $bottom2)/2;

  $gd->setStyle($color,$color,gdTransparent,gdTransparent,);
  $gd->line($left,$center1,$right,$center2,gdStyled);

}

sub draw_quill_connector {

  my $self = shift;
  my $gd   = shift;
  my $color = shift;
  my ($top1,$bottom1,$left,$top2,$bottom2,$right) = @_;

  my $center1  = ($top1 + $bottom1)/2;
  my $center2  = ($top2 + $bottom2)/2;

  $gd->line($left,$center1,$right,$center2,$color);
  my $direction = $self->feature->strand;
  return unless $direction;

  if ($direction > 0) {
    my $start = $left+4;
    my $end   = $right-1;
    for (my $position=$start; $position <= $end; $position += QUILL_INTERVAL) {
      $gd->line($position,$center1,$position-2,$center1-2,$color);
      $gd->line($position,$center1,$position-2,$center1+2,$color);
    }
  } else {
    my $start = $left+1;
    my $end   = $right-4;
    for (my $position=$start; $position <= $end; $position += QUILL_INTERVAL) {
      $gd->line($position,$center1,$position+2,$center1-2,$color);
      $gd->line($position,$center1,$position+2,$center1+2,$color);
    }
  }

}

sub filled_box {

  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2,$bg,$fg) = @_;

  $bg ||= $self->bgcolor;
  $fg ||= $self->fgcolor;
  my $linewidth = $self->option('linewidth') || 1;

  $gd->filledRectangle($x1,$y1,$x2,$y2,$bg);

  $fg = $self->set_pen($linewidth,$fg) if $linewidth > 1;

  # draw a box
  $gd->rectangle($x1,$y1,$x2,$y2,$fg);

  # if the left end is off the end, then cover over
  # the leftmost line
  my ($width) = $gd->getBounds;

  $bg = $self->set_pen($linewidth,$bg) if $linewidth > 1;

  $gd->line($x1,$y1+$linewidth,$x1,$y2-$linewidth,$bg)
    if $x1 < $self->panel->pad_left;

  $gd->line($x2,$y1+$linewidth,$x2,$y2-$linewidth,$bg)
    if $x2 > $width - $self->panel->pad_right;

}

sub filled_oval {

  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2,$bg,$fg) = @_;
  my $cx = ($x1+$x2)/2;
  my $cy = ($y1+$y2)/2;

  $fg ||= $self->fgcolor;
  $bg ||= $self->bgcolor;
  my $linewidth = $self->linewidth;

  $fg = $self->set_pen($linewidth) if $linewidth > 1;
  $gd->arc($cx,$cy,$x2-$x1,$y2-$y1,0,360,$fg);

  # and fill it