Bio-Graphics
view release on metacpan or search on metacpan
lib/Bio/Graphics/Panel.pm view on Meta::CPAN
my $g = $track->factory->make_glyph(0,$t);
$glyph = $g->keyglyph;
}
next unless $glyph;
$tracks{$track} = $glyph;
my ($h,$w) = ($glyph->layout_height,
$glyph->layout_width);
$height = $h if $h > $height;
$width = $w if $w > $width;
push @glyphs,$glyph;
}
$width += $self->key_spacing;
# no key glyphs, no key
return $self->{key_height} = 0 unless @glyphs;
# now height and width hold the largest glyph, and $glyph_count
# contains the number of glyphs. We will format them into a
# box that is roughly 3 height/4 width (golden mean)
my $rows = 0;
my $cols = 0;
my $maxwidth = $self->width - $self->pad_left - $self->pad_right;
while (++$rows) {
$cols = @glyphs / $rows;
$cols = int ($cols+1) if $cols =~ /\./; # round upward for fractions
my $total_width = $cols * $width;
my $total_height = $rows * $width;
last if $total_width < $maxwidth;
}
# move glyphs into row-major format
my $spacing = $self->key_spacing;
my $i = 0;
for (my $c = 0; $c < $cols; $c++) {
for (my $r = 0; $r < $rows; $r++) {
my $x = $c * ($width + $spacing);
my $y = $r * ($height + $spacing);
next unless defined $glyphs[$i];
$glyphs[$i]->move($x,$y);
$i++;
}
}
$self->{key_glyphs} = \@glyphs; # remember our key glyphs
# remember our key height
return $self->{key_height} =
($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP;
}
else { # no known key style, neither "between" nor "bottom"
return $self->{key_height} = 0;
}
}
sub add_key_box {
my $self = shift;
my ($track,$label,$x,$y, $is_legend) = @_;
my $value = [$label,$x,$y,$x+$self->{key_font}->width*CORE::length($label),$y+$self->{key_font}->height,$track];
push @{$self->{key_boxes}},$value;
}
sub key_boxes {
my $ref = shift->{key_boxes};
return wantarray ? @$ref : $ref;
}
sub add_category_labels {
my $self = shift;
my $d = $self->{add_category_labels};
$self->{add_category_labels} = shift if @_;
$d;
}
sub track2key {
my $self = shift;
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;
( run in 0.764 second using v1.01-cache-2.11-cpan-39bf76dae61 )