view release on metacpan or  search on metacpan

Ace/Graphics/Glyph.pm  view on Meta::CPAN

package Ace::Graphics::Glyph;

use strict;
use GD;

# simple glyph class
# args:  -feature => $feature_object
# args:  -factory => $factory_object
sub new {
  my $class = shift;
  my %arg = @_;
  my $feature = $arg{-feature};
  my ($start,$end) = ($feature->start,$feature->end);
  ($start,$end) = ($end,$start) if $start > $end;
  return bless {
		@_,
		top   => 0,
		left  => 0,
		right => 0,
		start => $start,
		end   => $end
	       },$class;
}

# delegates
# any of these can be overridden safely
sub factory   {  shift->{-factory}            }
sub feature   {  shift->{-feature}            }
sub fgcolor   {  shift->factory->fgcolor      }
sub bgcolor   {  shift->factory->bgcolor   }
sub fontcolor {  shift->factory->fontcolor      }
sub fillcolor {  shift->factory->fillcolor }
sub scale     {  shift->factory->scale     }
sub width     {  shift->factory->width     }
sub font      {  shift->factory->font      }
sub option    {  shift->factory->option(shift) }
sub color     {
  my $self    = shift;
  my $factory = $self->factory;
  my $color   = $factory->option(shift) or return $self->fgcolor;
  $factory->translate($color);
}

sub start     { shift->{start}                 }
sub end       { shift->{end}                   }
sub offset    { shift->factory->offset      }
sub length    { shift->factory->length      }

# this is a very important routine that dictates the
# height of the bounding box.  We start with the height
# dictated by the factory, and then adjust if needed
sub height   {
  my $self = shift;
  $self->{cache_height} = $self->calculate_height unless exists $self->{cache_height};
  return $self->{cache_height};
}

sub calculate_height {
  my $self = shift;
  my $val = $self->factory->height;
  $val += $self->labelheight if $self->option('label');
  $val;
}

# change our offset
sub move {
  my $self = shift;
  my ($dx,$dy) = @_;
  $self->{left} += $dx;
  $self->{top}  += $dy;
}

# positions, in pixel coordinates
sub top    { shift->{top}                 }
sub bottom { my $s = shift; $s->top + $s->height   }