Bio-Graphics

 view release on metacpan or  search on metacpan

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


  my @bases = split '',$seq;
  for (my $i=0;$i<@bases;$i++) {
    my $x = $strand >= 0 ? $start + $i * $pixels_per_base
                         : $stop  - $i * $pixels_per_base;
    next unless ($x >= $x1 && $x <= $x2);
    $x -= $fontwidth + 1 if $self->{flip}; # align right when flipped
    if ($strand >= 0) {
      last if $x + $fontwidth > $right;
    } else {
      next if $x >= $right;
      last if $x < $left;
    }
    my $base = $self->{flip} ? $complement{$bases[$i]} : $bases[$i];
    $base    = $complement{$base} if $canonical && $strand < 0;
    $gd->char($font,$x+$x_fudge,$y,$base,$color);
  }
}

sub min { $_[0] <= $_[1] ? $_[0] : $_[1] }
sub max { $_[0] >= $_[1] ? $_[0] : $_[1] }

sub draw_label {
  my $self = shift;
  my ($gd,$left,$top,$partno,$total_parts) = @_;

  my $label = $self->label or return;
  local $self->{default_opacity} = 1;

  my $x    = $self->left + $left; # valid for both "top" and "left" because the left-hand side is defined by pad_left
  my $font = $self->labelfont;
  if ($self->label_position eq 'top') {
    $x += $self->pad_left;  # offset to beginning of the drawn part of the feature
    $x = $self->panel->left + 1 if $x <= $self->panel->left;
    $self->render_label($gd,
			$font,
			$x,
			$self->top + $top - 1,
			$label);
  } elsif ($self->label_position eq 'left') {
#      my $y = $top + $self->{top} + ($self->height - $self->string_height($font))/2;
      my $y = $top + $self->{top} - 1;
      $self->render_label($gd,
			  $font,
			  $x,
			  $y,
			  $label);
      # used for alignments, doesn't account for padding, viewer discretion is advised...
  } elsif ($self->label_position eq 'alignment_left') {
      my $y = $self->{top} + ($self->height - $font->height)/2 + $top;
      $self->render_label($gd,
			  $font,
			  1,
			  $y,
			  $label);
  }
}

sub render_label {
    my $self = shift;
    my ($gd,$font,$x,$y,$label,$is_legend) = @_;
    my $rlp = $self->record_label_positions;
    unless ($rlp || $is_legend)
    {
	$gd->string($font,$x,$y,$label,$self->labelcolor);
    }
    $self->panel->add_key_box($self,$label,$x,$y)
	if $rlp
}

sub draw_description {
  my $self = shift;
  my ($gd,$dx,$dy,$partno,$total_parts) = @_;
  my $label = $self->description or return;

  local $self->{default_opacity} = 1;
  my ($left,$top,$right,$bottom) = $self->bounds($dx,$dy);
  $bottom  += $self->pad_bottom;
  $bottom  -= $self->labelheight;
  $bottom  -= $self->labelheight if $self->part_labels && $self->label_position eq 'top';

  $gd->string($self->descfont,
	      $left,
	      $bottom-3,
	      $label,
	      $self->descriptioncolor);
}

sub draw_part_labels {
  my $self = shift;
  my ($gd,$left,$top,$partno,$total_parts) = @_;
  return unless $self->{level} == 0;
  my @p = $self->parts or return;

  local $self->{default_opacity} = 1;

  @p > 1 or return;
  @p = reverse @p if $self->flip;

  my $font  = $self->font;
  my $width = $font->width;
  my $color = $self->labelcolor;

  my $y     = $top + $self->bottom - $self->pad_bottom;
  my $merge_em = $self->part_label_merge;

  my @parts;
  my $previous;

  if ($merge_em) {
    my $current_contig = [];

    for my $part (@p) {
      if (!$previous || $part->feature->start - $previous->feature->end <= 1) {
	push @$current_contig,$part;
      } else {
	push @parts,$current_contig;
	$current_contig = [$part];
      }
      $previous = $part;
    }
    push @parts,$current_contig;
  }



( run in 0.702 second using v1.01-cache-2.11-cpan-39bf76dae61 )