Bio-Graphics
view release on metacpan or search on metacpan
lib/Bio/Graphics/Panel.pm view on Meta::CPAN
: $image_or_routine =~ /\.gd$/i ? 'newFromGd'
: $image_or_routine =~ /\.gif$/i ? 'newFromGif'
: $image_or_routine =~ /\.xbm$/i ? 'newFromXbm'
: '';
return unless $method;
my $image = eval {$self->image_package->$method($image_or_routine)};
unless ($image) {
warn $@;
return;
}
my ($src_width,$src_height) = $image->getBounds;
my ($dst_width,$dst_height) = $gd->getBounds;
# tile the thing on
for (my $x = 0; $x < $dst_width; $x += $src_width) {
for (my $y = 0; $y < $dst_height; $y += $src_height) {
$gd->copy($image,$x,$y,0,0,$src_width,$src_height);
}
}
}
}
# calculate major and minor ticks, given a start position
sub ticks {
my $self = shift;
my ($length,$minwidth) = @_;
my $img = $self->image_class;
$length = $self->{length} unless defined $length;
$minwidth = $img->gdSmallFont->width*7 unless defined $minwidth;
my ($major,$minor);
# figure out tick mark scale
# we want no more than 1 major tick mark every 40 pixels
# and enough room for the labels
my $scale = $self->scale;
my $interval = 10;
while (1) {
my $pixels = $interval * $scale;
last if $pixels >= $minwidth;
$interval *= 10;
}
# to make sure a major tick shows up somewhere in the first half
#
# $interval *= .5 if ($interval > 0.5*$length);
return ($interval,$interval/10);
}
# reverse of translate(); given index, return rgb triplet
sub rgb {
my $self = shift;
my $idx = shift;
my $gd = $self->{gd} or return;
return $gd->rgb($idx);
}
sub transparent_color {
my $self = shift;
my ($opacity,@colors) = @_;
return $self->_translate_color($opacity,@colors);
}
sub translate_color {
my $self = shift;
my @colors = @_;
return $self->_translate_color(1.0,@colors);
}
sub _translate_color {
my $self = shift;
my ($opacity,@colors) = @_;
$opacity = '1.0' if $opacity == 1;
my $default_alpha = $self->adjust_alpha($opacity);
$default_alpha ||= 0;
my $ckey = "@{colors}_${default_alpha}";
return $self->{closestcache}{$ckey} if exists $self->{closestcache}{$ckey};
my $index;
my $gd = $self->gd or return 1;
my $table = $self->{translations} or return 1;
if (@colors == 3) {
$index = $gd->colorAllocateAlpha(@colors,$default_alpha);
}
elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
my ($r,$g,$b,$alpha) = (hex($1),hex($2),hex($3),hex($4));
$index = $gd->colorAllocateAlpha($r,$g,$b,$alpha);
}
elsif ($colors[0] =~ /^\#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})$/i) {
my ($r,$g,$b) = (hex($1),hex($2),hex($3));
$index = $gd->colorAllocateAlpha($r,$g,$b,$default_alpha);
}
elsif ($colors[0] =~ /^(\d+),(\d+),(\d+),([\d.]+)$/i ||
$colors[0] =~ /^rgba\((\d+),(\d+),(\d+),([\d.]+)\)$/) {
my $alpha = $self->adjust_alpha($4);
my (@rgb) = map {/(\d+)%/ ? int(255 * $1 / 100) : $_} ($1,$2,$3);
$index = $gd->colorAllocateAlpha(@rgb,$4);
}
elsif ($colors[0] =~ /^(\d+),(\d+),(\d+)$/i ||
$colors[0] =~ /^rgb\((\d+),(\d+),(\d+)\)$/i
) {
my (@rgb) = map {/(\d+)%/ ? int(255 * $1 / 100) : $_} ($1,$2,$3);
$index = $gd->colorAllocateAlpha(@rgb,$default_alpha);
}
elsif ($colors[0] eq 'transparent') {
$index = $gd->colorAllocateAlpha(255,255,255,127);
}
elsif ($colors[0] =~ /^(\w+):([\d.]+)/) { # color:alpha
my @rgb = $self->color_name_to_rgb($1);
@rgb = (0,0,0) unless @rgb;
my $alpha = $self->adjust_alpha($2);
$index = $gd->colorAllocateAlpha(@rgb,$alpha);
}
elsif ($default_alpha < 127) {
my @rgb = $self->color_name_to_rgb($colors[0]);
@rgb = (0,0,0) unless @rgb;
$index = $gd->colorAllocateAlpha(@rgb,$default_alpha);
}
else {
$index = defined $table->{$colors[0]} ? $table->{$colors[0]} : 1;
}
return $self->{closestcache}{$ckey} = $index;
}
# change CSS opacity values (0-1.0) into GD opacity values (127-0)
sub adjust_alpha {
my $self = shift;
my $value = shift;
my $alpha = $value =~ /\./ # floating point
? int(127-($value*127)+0.5)
: $value;
$alpha = 0 if $alpha < 0;
$alpha = 127 if $alpha > 127;
return $alpha;
}
# workaround for bad GD
sub colorClosest {
my ($self,$gd,@c) = @_;
return $gd->colorResolve(@c) if $GD::VERSION < 2.04;
my $index = $gd->colorResolve(@c);
return $index if $index >= 0;
my $value;
for (keys %COLORS) {
my ($r,$g,$b) = @{$COLORS{$_}};
my $dist = ($r-$c[0])**2 + ($g-$c[1])**2 + ($b-$c[2])**2;
($value,$index) = ($dist,$_) if !defined($value) || $dist < $value;
}
return $self->{translations}{$index};
}
sub bgcolor {
my $self = shift;
return unless $self->{bgcolor};
return $self->translate_color($self->{bgcolor});
}
sub set_pen {
my $self = shift;
my ($linewidth,$color) = @_;
return $self->{pens}{$linewidth,$color} if $self->{pens}{$linewidth,$color};
my $gd = $self->{gd};
my $pkg = $self->image_package;
lib/Bio/Graphics/Panel.pm view on Meta::CPAN
description
-bump Bump direction 0
-sort_order Specify layout sort order "default"
-feature_limit
Maximum number of features undef (unlimited)
to display
-bump_limit Maximum number of levels undef (unlimited)
to bump
-hbumppad Additional horizontal 0
padding between bumped
features
-strand_arrow Whether to indicate undef (false)
strandedness
-stranded Synonym for -strand_arrow undef (false)
-part_labels Whether to label individual undef (false)
subparts.
-part_label_merge Whether to merge undef (false)
adjacent subparts when
labeling.
-connector Type of connector to none
use to connect related
features. Options are
"solid," "hat", "dashed",
"quill" and "none".
-all_callbacks Whether to invoke undef
callbacks for autogenerated
"track" and "group" glyphs
-subpart_callbacks Whether to invoke false
callbacks for subparts of
the glyph.
-box_subparts Return boxes around feature 0
subparts rather than around the
feature itself.
-link, -title, -target
These options are used when creating imagemaps
for display on the web. See L</"Creating Imagemaps">.
-filter Select which features to
display. Must be a CODE reference.
B<Specifying colors:> Colors can be expressed in either of two ways:
as symbolic names such as "cyan", as HTML-style #RRGGBB triples, and
r,g,b comma-separated numbers. The symbolic names are the 140 colors
defined in the Netscape/Internet Explorer color cube, and can be
retrieved using the Bio::Graphics::Panel-E<gt>color_names() method.
Transparent and semi-transparent colors can be specified using the
following syntax:
#RRGGBBAA - red, green, blue and alpha
r,g,b,a - red, green, blue, alpha
blue:alpha - symbolic name and alpha
rgb(r,g,b) - CSS style rgb values
rgba(r,g,b,a) - CSS style rgba values
Alpha values can be specified as GD style integers ranging from 0
(opaque) to 127 (transparent), or as CSS-style floating point numbers
ranging from 0.0 (transparent) through 1.0 (opaque). As a special
case, a completely transparent color can be specified using the color
named "transparent". In the rgb() and rgba() forms, red, green, blue
values can be specified as percentages, as in rgb(100%,0%,50%);
otherwise, the values are integers from 0 to 255.
In addition, the -fgcolor and -bgcolor options accept the special
color names "featureScore" and "featureRGB". In the first case,
Bio::Graphics will examine each feature in the track for a defined
"score" tag (or the presence of a score() method) with a numeric value
ranging from 0-1000. It will draw a grayscale color ranging from
lightest (0) to darkest (1000). If the color is named "featureRGB",
then Bio::Graphics will look for a tag named "RGB" and will use that
as the color.
B<Foreground color:> The -fgcolor option controls the foreground
color, including the edges of boxes and the like.
B<Background color:> The -bgcolor option controls the background used
for filled boxes and other "solid" glyphs. The foreground color
controls the color of lines and strings. The -tkcolor argument
controls the background color of the entire track.
B<Default opacity:>For truecolor images, you can apply a default opacity
value to both foreground and background colors by supplying a B<-opacity>
argument. This is specified as a CSS-style floating point number from
0.0 to 1.0. If the color has an explicit alpha, then the default is
ignored.
B<Track color:> The -tkcolor option used to specify the background of
the entire track.
B<Font:> The -font option controls which font will be used. If the
Panel was created without passing a true value to -truecolor, then
only GD bitmapped fonts are available to you. These include
'gdTinyFont', 'gdSmallFont', 'gdLargeFont', 'gdMediumBoldFont', and
'gdGiantFont'. If the Panel was creaed using a truevalue for
-truecolor, then you can pass the name of any truetype font installed
on the server system. Any of these formats will work:
-font => 'Times New Roman', # Times font, let the system pick size
-font => 'Times New Roman-12' # Times font, 12 points
-font => 'Times New Roman-12:Italic' # Times font, 12 points italic
-font => 'Times New Roman-12:Bold' # Times font, 12 points bold
B<Font color:> The -fontcolor option controls the color of primary
text, such as labels
B<Secondary Font color:> The -font2color option controls the color of
secondary text, such as descriptions.
B<Labels:> The -label argument controls whether or not the ID of the
feature should be printed next to the feature. It is accepted by all
glyphs. By default, the label is printed just above the glyph and
left aligned with it.
-label can be a constant string or a code reference. Values can be
any of:
-label value Description
------------ -----------
0 Don't draw a label
( run in 0.510 second using v1.01-cache-2.11-cpan-39bf76dae61 )