Bio-Graphics
view release on metacpan or search on metacpan
lib/Bio/Graphics/Glyph/generic.pm view on Meta::CPAN
my $pad = $self->SUPER::pad_top;
$pad += $self->labelheight if $self->label && $self->label_position eq 'top';
$pad;
}
sub pad_bottom {
my $self = shift;
my $bottom = $self->option('pad_bottom');
return $bottom if defined $bottom;
my $pad = $self->SUPER::pad_bottom;
$pad += $self->labelheight+6 if $self->description;
$pad += $self->labelheight+6 if $self->part_labels && $self->label_position eq 'top';
$pad;
}
sub pad_right {
my $self = shift;
my $pad = $self->SUPER::pad_right;
return $pad unless $self->label;
my $label_width = $self->label_position eq 'top' ? $self->labelwidth : 0;
my $description_width = $self->descriptionwidth;
my $max = $label_width > $description_width ? $label_width : $description_width;
my $right = $max - $self->width;
return $pad > $right ? $pad : $right;
}
sub pad_left {
my $self = shift;
my $pad = $self->SUPER::pad_left;
return $pad unless $self->label_position eq 'left' && $self->label;
$pad += $self->labelwidth + 3;
$pad;
}
sub labelfont {
my $self = shift;
my $font = $self->getfont('label_font',$self->font);
$font = GD->gdTinyFont if $self->string_height($font) > $self->height && $self->label_position eq 'left';
return $font;
}
sub descfont {
my $self = shift;
return $self->getfont('desc_font',$self->font);
}
sub labelwidth {
my $self = shift;
return $self->{labelwidth} ||= $self->string_width($self->label||'',$self->labelfont);
}
sub descriptionwidth {
my $self = shift;
return $self->{descriptionwidth} ||= $self->string_width($self->description||'',$self->descfont);
}
sub labelheight {
my $self = shift;
return $self->{labelheight} ||= $self->string_height($self->labelfont);
}
sub label_position {
my $self = shift;
return $self->{labelposition} ||= $self->option('label_position') || 'top';
}
sub label {
my $self = shift;
return if $self->{overbumped}; # set by the bumper when we have hit bump limit
return unless $self->subpart_callbacks; # returns true if this is level 0 or if subpart callbacks allowed
return $self->_label if $self->{level} >= 0;
return exists $self->{label} ? $self->{label}
: ($self->{label} = $self->_label);
}
sub description {
my $self = shift;
return if $self->{overbumped}; # set by the bumper when we have hit bump limit
return unless $self->subpart_callbacks; # returns true if this is level 0 or if subpart callbacks allowed
return $self->_description if $self->{level} > 0;
return exists $self->{description} ? $self->{description}
: ($self->{description} = $self->_description);
}
sub part_labels {
my $self = shift;
my @parts = $self->parts;
return ($self->{level} == 0) && @parts && @parts>1 && $self->option('part_labels');
}
sub part_label_merge {
shift->option('part_label_merge');
}
sub maxdepth {
my $self = shift;
my $maxdepth = $self->option('maxdepth');
return $maxdepth if defined $maxdepth;
return 1;
}
sub _label {
my $self = shift;
# allow caller to specify the label
my $label = $self->option('label');
return unless defined $label;
return "1" if $label eq '1 '; # 1 with a space
return $label unless $label eq '1';
# figure it out ourselves
my $f = $self->feature;
if ($f->can('display_name') && (my $name = $f->display_name)) {
return $name;
}
if ($f->can('attributes') && (my @aliases = $f->attributes('Alias'))) {
return $aliases[0];
}
return $f->info if $f->can('info'); # deprecated API
return $f->seq_id if $f->can('seq_id');
return eval{$f->primary_tag};
}
sub _description {
my $self = shift;
# allow caller to specify the long label
my $label = $self->option('description');
return unless defined $label;
return "1" if $label eq '1 ';
return $label unless $label eq '1';
return $self->{_description} if exists $self->{_description};
return $self->{_description} = $self->get_description($self->feature);
}
sub get_description {
( run in 1.564 second using v1.01-cache-2.11-cpan-39bf76dae61 )