view release on metacpan or  search on metacpan

lib/Bio/Graphics/Panel.pm  view on Meta::CPAN

  my $track = shift;
  return $track->make_key_name();
}

sub draw_empty {
  my $self  = shift;
  my ($gd,$offset,$style) = @_;
  $offset  += $self->spacing/2;
  my $left  = $self->pad_left;
  my $right = $self->width-$self->pad_right;
  my $color = $self->translate_color(MISSING_TRACK_COLOR);
  my $ic    = $self->image_class;
  if ($style eq 'dashed') {
    $gd->setStyle($color,$color,$ic->gdTransparent(),$ic->gdTransparent());
    $gd->line($left,$offset,$right,$offset,$ic->gdStyled());
  } else {
    $gd->line($left,$offset,$right,$offset,$color);
  }
  $offset;
}

# draw a grid
sub draw_grid {
  my $self = shift;
  my $gd = shift;

  my $gridcolor      = $self->translate_color($self->{gridcolor});
  my $gridmajorcolor = $self->translate_color($self->{gridmajorcolor});
  my @positions;
  my ($major,$minor);
  if (ref $self->{grid} eq 'ARRAY') {
    @positions = @{$self->{grid}};
  } else {
    ($major,$minor) = $self->ticks;
    my $first_tick = $minor * int($self->start/$minor);
    for (my $i = $first_tick; $i <= $self->end+1; $i += $minor) {
      push @positions,$i;
    }
  }
  my $pl = $self->pad_left;
  my $pt = $self->extend_grid ? 0 : $self->pad_top;
  my $pr = $self->right;
  my $pb = $self->extend_grid ? $self->height : $self->height - $self->pad_bottom;
  my $offset = $self->{offset}+$self->{length}+1;
  for my $tick (@positions) {
    my ($pos) = $self->map_pt($self->{flip} ? $offset - $tick
                                            : $tick);
    my $color = (defined $major && $tick % $major == 0) ? $gridmajorcolor : $gridcolor;
    $gd->line($pl+$pos,$pt,$pl+$pos,$pb,$color);
  }
}

# draw an image (or invoke a drawing routine)
sub draw_background {
  my $self = shift;
  my ($gd,$image_or_routine) = @_;
  if (ref $image_or_routine eq 'CODE') {
    return $image_or_routine->($gd,$self);
  }
  if (-f $image_or_routine) { # a file to draw
    my $method = $image_or_routine =~ /\.png$/i   ? 'newFromPng'
               : $image_or_routine =~ /\.jpe?g$/i ? 'newFromJpeg'
               : $image_or_routine =~ /\.gd$/i    ? 'newFromGd'
               : $image_or_routine =~ /\.gif$/i   ? 'newFromGif'
               : $image_or_routine =~ /\.xbm$/i   ? 'newFromXbm'
	       : '';
    return unless $method;
    my $image = eval {$self->image_package->$method($image_or_routine)};
    unless ($image) {
      warn $@;
      return;
    }
    my ($src_width,$src_height) = $image->getBounds;
    my ($dst_width,$dst_height) = $gd->getBounds;
    # tile the thing on
    for (my $x = 0; $x < $dst_width; $x += $src_width) {
      for (my $y = 0; $y < $dst_height; $y += $src_height) {
	$gd->copy($image,$x,$y,0,0,$src_width,$src_height);
      }
    }
  }
}

# calculate major and minor ticks, given a start position
sub ticks {
  my $self = shift;
  my ($length,$minwidth) = @_;

  my $img = $self->image_class;
  $length   = $self->{length}             unless defined $length;
  $minwidth = $img->gdSmallFont->width*7  unless defined $minwidth;

  my ($major,$minor);

  # figure out tick mark scale
  # we want no more than 1 major tick mark every 40 pixels
  # and enough room for the labels
  my $scale = $self->scale;

  my $interval = 10;

  while (1) {
    my $pixels = $interval * $scale;
    last if $pixels >= $minwidth;
    $interval *= 10;
  }

  # to make sure a major tick shows up somewhere in the first half
  #
  # $interval *= .5 if ($interval > 0.5*$length);

  return ($interval,$interval/10);
}

# reverse of translate(); given index, return rgb triplet
sub rgb {
  my $self = shift;
  my $idx  = shift;
  my $gd = $self->{gd} or return;
  return $gd->rgb($idx);
}