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 )