view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph/xyplot.pm  view on Meta::CPAN

  my @parts = $self->parts;

  return $self->SUPER::draw(@_) unless @parts > 0;

  $self->panel->startGroup($gd);

  my ($min_score,$max_score) = $self->minmax(\@parts);

  my $side = $self->_determine_side();

  # if a scale is called for, then we adjust the max and min to be even
  # multiples of a power of 10.
  if ($side) {
    $max_score = max10($max_score);
    $min_score = min10($min_score);
  }

  my $height = $bottom - $top;
  my $scale  = $max_score > $min_score ? $height/($max_score-$min_score)
                                       : 1;
  my $x = $left;
  my $y = $top + $self->pad_top;

  # position of "0" on the scale
  my $y_origin = $min_score <= 0 ? $bottom - (0 - $min_score) * $scale : $bottom;
  $y_origin    = $top if $max_score < 0;

  my $clip_ok = $self->option('clip');
  $self->{_clip_ok}   = $clip_ok;
  $self->{_scale}     = $scale;
  $self->{_min_score} = $min_score;
  $self->{_max_score} = $max_score;
  $self->{_top}       = $top;
  $self->{_bottom}    = $bottom;

  # now seed all the parts with the information they need to draw their positions
  foreach (@parts) {
    my $s = $_->score;
    $_->{_y_position}   = $self->score2position($s);
    warn "y_position = $_->{_y_position}" if DEBUG;
  }
  my $type           = $self->option('graph_type') || $self->option('graphtype') || 'boxes';
  my (@draw_methods) = $self->lookup_draw_method($type);
  $self->throw("Invalid graph type '$type'") unless @draw_methods;

  $self->panel->startGroup($gd);
  $self->_draw_grid($gd,$scale,$min_score,$max_score,$dx,$dy,$y_origin);

  $self->panel->endGroup($gd);

  for my $draw_method (@draw_methods) {
    $self->$draw_method($gd,$dx,$dy,$y_origin);
  }

  $self->panel->startGroup($gd);
  $self->_draw_scale($gd,$scale,$min_score,$max_score,$dx,$dy,$y_origin);
  $self->panel->endGroup($gd);
  
  $self->draw_label(@_)       if $self->option('label') or $self->record_label_positions;
  $self->draw_description(@_) if $self->option('description');
  $self->draw_legend(@_)      if $self->option('overlay');

  $self->panel->endGroup($gd);
}

sub lookup_draw_method {
  my $self = shift;
  my $type = shift;

  return '_draw_boxes'                if $type eq 'histogram';  # same thing
  return '_draw_boxes'                if $type eq 'boxes';
  return qw(_draw_line _draw_points)  if $type eq 'linepoints';
  return '_draw_line'                 if $type eq 'line';
  return '_draw_points'               if $type eq 'points';
  return;
}

sub normalize_track {
    my $self  = shift;
    my @glyphs_in_track = @_;
    my ($global_min,$global_max);
    for my $g (@glyphs_in_track) {
	my ($min_score,$max_score) = $g->minmax($g->get_parts);
	$global_min = $min_score if !defined $global_min || $min_score < $global_min;
	$global_max = $max_score if !defined $global_max || $max_score > $global_max;
    }
    # note that configure applies to the whole track
    $glyphs_in_track[0]->configure(-min_score => $global_min);
    $glyphs_in_track[0]->configure(-max_score => $global_max);
}

sub get_parts {
    my $self = shift;
    my @parts = $self->parts;
    return \@parts;
}

sub score {
  my $self    = shift;
  my $s       = $self->option('score');
  return $s   if defined $s;
  return eval { $self->feature->score };
}

sub score2position {
  my $self  = shift;
  my $score = shift;

  return undef unless defined $score;

  if ($self->{_clip_ok} && $score < $self->{_min_score}) {
    return $self->{_bottom};
  }

  elsif ($self->{_clip_ok} && $score > $self->{_max_score}) {
    return $self->{_top};
  }

  else {
    warn "score = $score, _top = $self->{_top}, _bottom = $self->{_bottom}, max = $self->{_max_score}, min=$self->{_min_score}" if DEBUG;
    my $position      = ($score-$self->{_min_score}) * $self->{_scale};