view release on metacpan or  search on metacpan

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

# 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   }
sub left {
  my $self = shift;
  $self->{cache_left} = $self->calculate_left unless exists $self->{cache_left};
  return $self->{left} + $self->{cache_left};
}
sub right {
  my $self = shift;
  $self->{cache_right} = $self->calculate_right unless exists $self->{cache_right};
  return $self->{left} + $self->{cache_right};
}

sub calculate_left {
  my $self = shift;
  my $val = $self->{left} + $self->map_pt($self->{start} - 1);
  $val > 0 ? $val : 0;
}

sub calculate_right {
  my $self = shift;
  my $val = $self->{left} + $self->map_pt($self->{end} - 1);
  $val = 0 if $val < 0;
  $val = $self->width if $val > $self->width;
  if ($self->option('label') && (my $label = $self->label)) {
    my $left = $self->left;
    my $label_width = $self->font->width * CORE::length $label;
    my $label_end   = $left + $label_width;
    $val = $label_end if $label_end > $val;
  }
  $val;
}

sub map_pt {
  my $self = shift;
  my $point = shift;
  $point -= $self->offset;
  my $val = $self->{left} + $self->scale * $point;
  my $right = $self->{left} + $self->width;
  $val = -1 if $val < 0;
  $val = $self->width if $right && $val > $right;
  return int $val;
}

sub labelheight {
  my $self = shift;
  return $self->{labelheight} ||= $self->font->height;
}

sub label {
  my $f = (my $self = shift)->feature;
  if (ref (my $code = $self->option('label')) eq 'CODE') {

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

}

1;

=head1 NAME

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

=head1 SYNOPSIS

See L<Ace::Graphics::Panel>.

=head1 DESCRIPTION

Ace::Graphics::Glyph is the base class for all glyph objects.  Each
glyph is a wrapper around an Ace::Sequence::Feature object, knows how
to render itself on an Ace::Graphics::Panel, and has a variety of
configuration variables.

End developers will not ordinarily work directly with
Ace::Graphics::Glyph, but may want to subclass it for customized
displays.

=head1 METHODS

This section describes the class and object methods for
Ace::Graphics::Glyph.

=head2 CONSTRUCTORS

Ace::Graphics::Glyph objects are constructed automatically by an
Ace::Graphics::GlyphFactory, and are not usually created by
end-developer code.

=over 4

=item $glyph = Ace::Graphics::Glyph->new(-feature=>$feature,-factory=>$factory)

Given a sequence feature, creates an Ace::Graphics::Glyph object to
display it.  The -feature argument points to the
Ace::Sequence::Feature object to display.  -factory indicates an
Ace::Graphics::GlyphFactory object from which the glyph will fetch all
its run-time configuration information.

A standard set of options are recognized.  See L<OPTIONS>.

=back

=head2 OBJECT METHODS

Once a glyph is created, it responds to a large number of methods.  In
this section, these methods are grouped into related categories.

Retrieving glyph context:

=over 4

=item $factory = $glyph->factory

Get the Ace::Graphics::GlyphFactory associated with this object.  This
cannot be changed once it is set.

=item $feature = $glyph->feature

Get the sequence feature associated with this object.  This cannot be
changed once it is set.

=back

Retrieving glyph options:

=over 4

=item $fgcolor = $glyph->fgcolor

=item $bgcolor = $glyph->bgcolor

=item $fontcolor = $glyph->fontcolor

=item $fillcolor = $glyph->fillcolor

These methods return the configured foreground, background, font and
fill colors for the glyph in the form of a GD::Image color index.

=item $width = $glyph->width

Return the maximum width allowed for the glyph.  Most glyphs will be
smaller than this.

=item $font = $glyph->font

Return the font for the glyph.

=item $option = $glyph->option($option)

Return the value of the indicated option.

=item $index = $glyph->color($color)

Given a symbolic or #RRGGBB-form color name, returns its GD index.

=back


Retrieving information about the sequence:

=over 4

=item $start = $glyph->start

=item $end   = $glyph->end

These methods return the start and end of the glyph in base pair
units.

=item $offset = $glyph->offset

Returns the offset of the segment (the base pair at the far left of
the image).

=item $length = $glyph->length

Returns the length of the sequence segment.

=back