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 )