view release on metacpan or  search on metacpan

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

  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') {
    return $code->($f);
  }
  my $info = eval {$f->info};
  return $info if $info;
  return $f->seqname if $f->can('seqname');
  return $f->primary_tag;
}

# return array containing the left,top,right,bottom
sub box {
  my $self = shift;
  return ($self->left,$self->top,$self->right,$self->bottom);
}

# these are the sequence boundaries, exclusive of labels and doodads
sub calculate_boundaries {
  my $self = shift;
  my ($left,$top) = @_;

  my $x1 = $left + $self->map_pt($self->{start} - 1);
  $x1 = 0 if $x1 < 0;

  my $x2 = $left + $self->map_pt($self->{end} - 1);
  $x2 = 0 if $x2 < 0;

  my $y1 = $top + $self->{top};
  $y1 += $self->labelheight if $self->option('label');
  my $y2 = $y1 + $self->factory->height;

  $x2 = $x1 if $x2-$x1 < 1;
  $y2 = $y1 if $y2-$y1 < 1;

  return ($x1,$y1,$x2,$y2);
}

sub filled_box {
  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2,$color) = @_;

  my $fc = defined($color) ? $color : $self->fillcolor;

  my $linewidth = $self->option('linewidth') || 1;
  $gd->filledRectangle($x1,$y1,$x2,$y2,$fc);
  $gd->rectangle($x1,$y1,$x2,$y2,$self->fgcolor);

  # and fill it
#  $self->fill($gd,$x1,$y1,$x2,$y2);

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

  $gd->line($x2,$y1,$x2,$y2,$fc)
    if $x2 > $width;
}

sub filled_oval {
  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = @_;