view release on metacpan or  search on metacpan

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

package Ace::Graphics::Glyph::segments;
# package to use for drawing anything that is interrupted
# (has the segment() method)

use strict;
use vars '@ISA';
use GD;
@ISA = 'Ace::Graphics::Glyph';

use constant GRAY  => 'lightgrey';
my %BRUSHES;

# override right to allow for label
sub calculate_right {
  my $self = shift;
  my $left = $self->left;
  my $val = $self->SUPER::calculate_right(@_);

  if ($self->option('label') && (my $description = $self->description)) {
    my $description_width = $self->font->width * length $self->description;
    $val = $left + $description_width if $left + $description_width > $val;
  }
  $val;
}

# override draw method
sub draw {
  my $self = shift;

  # bail out if this isn't the right kind of feature
  # handle both das-style and Bio::SeqFeatureI style,
  # which use different names for subparts.
  my @segments;
  my $f = $self->feature;
  if ($f->can('merged_segments')) {
    @segments = $f->merged_segments;

  } elsif ($f->can('segments')) {
    @segments = $f->segments;

  } elsif ($f->can('sub_SeqFeature')) {
    @segments = $f->sub_SeqFeature;

  } else {
    return $self->SUPER::draw(@_);
  }

  # get parameters
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
  my ($left,$top) = @_;

  my $gray = $self->color(GRAY);

  my (@boxes,@skips);
  my $stranded = $self->option('stranded');

  for (my $i=0; $i < @segments; $i++) {
    my ($start,$stop) = ($left + $self->map_pt($segments[$i]->start),
			 $left + $self->map_pt($segments[$i]->end));

    my $strand = 0;
    my $target;

    if ($stranded
	&& $segments[$i]->can('target') 
	&& ($target = $segments[$i]->target) 
	&& $target->can('start')) {
      $strand = $target->start < $target->end ? 1 : -1;
    }

    # probably unnecessary, but we do it out of paranaoia
    ($start,$stop) = ($stop,$start) if $start > $stop;

    push @boxes,[$start,$stop,$strand];

    if (my $next_segment = $segments[$i+1]) {
      my ($next_start,$next_stop) = ($left + $self->map_pt($next_segment->start),
				     $left + $self->map_pt($next_segment->end));
      # probably unnecessary, but we do it out of paranaoia
      ($next_start,$next_stop) = ($next_stop,$next_start) if $next_start > $next_stop;

      # fudge boxes that are within two pixels of each other
      if ($next_start - $stop < 2) {
	$boxes[-1][1] = $next_start;
      }