Summary

Bio::Graphics::Glyph::generic - The "generic" glyph

Package variables

Included modules

Inherit

Bio::Graphics::Glyph

Synopsis

  See Bio::Graphics::Panel and Bio::Graphics::Glyph.

Description

This is identical to the "box" glyph except that it will draw the
subparts of features that contain subfeatures. The subparts are not
connected -- use the "segments" glyph for that. "Generic" is the
default glyph used when not otherwise specified. The following options are standard among all Glyphs. See
Bio::Graphics::Glyph for a full explanation.

  Option      Description                      Default
  ------      -----------                      -------

  -fgcolor      Foreground color	       black

  -outlinecolor	Synonym for -fgcolor

  -bgcolor      Background color               turquoise

  -fillcolor    Synonym for -bgcolor

  -linewidth    Line width                     1

  -height       Height of glyph		       10

  -font         Glyph font		       gdSmallFont

  -connector    Connector type                 0 (false)

  -connector_color
                Connector color                black

  -pad_top      Top padding                    0

  -pad_bottom   Bottom padding                 0

  -label        Whether to draw a label	       0 (false)

  -description  Whether to draw a description  0 (false)

  -strand_arrow Whether to indicate            0 (false)
                 strandedness

  -hilite       Highlight color                undef (no color)

-pad_top and -pad_bottom allow you to insert some blank space between
the glyph's boundary and its contents. This is useful if you are
changing the glyph's height dynamically based on its feature's score.

Methods

Methods description

None available.

Methods code

sub pad_top {

  my $self = shift;
  my $top  = $self->option('pad_top');
  return $top if defined $top;
  my $pad = $self->SUPER::pad_top;
  $pad   += $self->labelheight if $self->label;
  $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 if $self->description;
  $pad;

}

sub pad_right {

  my $self = shift;
  my $pad = $self->SUPER::pad_right;
  my $label_width       = length($self->label||'') * $self->font->width;
  my $description_width = length($self->description||'') * $self->font->width;
  my $max = $label_width > $description_width ? $label_width : $description_width;
  my $right = $max - $self->width;
  return $pad > $right ? $pad : $right;

}

sub labelheight {

  my $self = shift;
  return $self->{labelheight} ||= $self->font->height;

}

sub label {

  my $self = shift;
  return if $self->{overbumped};  # set by the bumper when we have hit bump limit
  return unless $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->{level} == 0;
  return exists $self->{description} ? $self->{description}
                                     : ($self->{description} = $self->_description);

}

sub _label {

  my $self = shift;

  # allow caller to specify the label
  my $label = $self->option('label');
  return unless defined $label;
  return $label unless $label eq '1';
  return "1"    if $label eq '1 '; # 1 with a space


  # figure it out ourselves
  my $f = $self->feature;

  return $f->display_name if $f->can('display_name');
  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 $label unless $label eq '1';
  return "1"   if $label eq '1 ';

  return $self->{_description} if exists $self->{_description};
  return $self->{_description} = $self->get_description($self->feature);

}

sub get_description {

  my $self = shift;
  my $feature = shift;

  # common places where we can get descriptions
  return join '; ',$feature->notes if $feature->can('notes');
  return $feature->desc            if $feature->can('desc');

  my $tag = $feature->source_tag;
  return undef if $tag eq '';
  $tag;

}

sub draw {

  my $self = shift;
  $self->SUPER::draw(@_);
  $self->draw_label(@_)       if $self->option('label');
  $self->draw_description(@_) if $self->option('description');

}

sub draw_label {

  my $self = shift;
  my ($gd,$left,$top,$partno,$total_parts) = @_;
  my $label = $self->label or return;
  my $x = $self->left + $left;
  $x = $self->panel->left + 1 if $x <= $self->panel->left;
  my $font = $self->option('labelfont') || $self->font;
  $gd->string($font,
	      $x,
	      $self->top + $top,
	      $label,
	      $self->fontcolor);

}

sub draw_description {

  my $self = shift;
  my ($gd,$left,$top,$partno,$total_parts) = @_;
  my $label = $self->description or return;
  my $x = $self->left + $left;
  $x = $self->panel->left + 1 if $x <= $self->panel->left;
  $gd->string($self->font,
	      $x,
	      $self->bottom - $self->pad_bottom + $top,
	      $label,
	      $self->font2color);

}

sub dna_fits {

  my $self = shift;

  my $pixels_per_base = $self->scale;
  my $font            = $self->font;
  my $font_width      = $font->width;

  return $pixels_per_base >= $font_width;

}

sub arrowhead {

  my $self = shift;
  my $image = shift;
  my ($x,$y,$height,$orientation) = @_;

  my $fg = $self->set_pen;
  my $style = $self->option('arrowstyle') || 'regular';

  if ($style eq 'filled') {
    my $poly_pkg = $self->polygon_package;
    my $poly = $poly_pkg->new();
    if ($orientation >= 0) {
      $poly->addPt($x-$height,$y-$height);
      $poly->addPt($x,$y);
      $poly->addPt($x-$height,$y+$height,$y);
    } else {
      $poly->addPt($x+$height,$y-$height);
      $poly->addPt($x,$y);
      $poly->addPt($x+$height,$y+$height,$y);
    }
    $image->filledPolygon($poly,$fg);
  }
  else {
    if ($orientation >= 0) {
      $image->line($x,$y,$x-$height,$y-$height,$fg);
      $image->line($x,$y,$x-$height,$y+$height,$fg);
    } else {
      $image->line($x,$y,$x+$height,$y-$height,$fg);
      $image->line($x,$y,$x+$height,$y+$height,$fg);
    }
  }

}

sub arrow {

  my $self  = shift;
  my $image = shift;
  my ($x1,$x2,$y) = @_;

  my $fg     = $self->set_pen;
  my $height = $self->height/3;

  $image->line($x1,$y,$x2,$y,$fg);
  $self->arrowhead($image,$x2,$y,$height,+1) if $x1 < $x2;
  $self->arrowhead($image,$x2,$y,$height,-1) if $x2 < $x1;

}

sub reversec {

  $_[1]=~tr/gatcGATC/ctagCTAG/;
  return scalar reverse $_[1];

}

General documentation

Please report them.

Bio::Graphics::Panel,
Bio::Graphics::Glyph,
Bio::Graphics::Glyph::arrow,
Bio::Graphics::Glyph::cds,
Bio::Graphics::Glyph::crossbox,
Bio::Graphics::Glyph::diamond,
Bio::Graphics::Glyph::dna,
Bio::Graphics::Glyph::dot,
Bio::Graphics::Glyph::ellipse,
Bio::Graphics::Glyph::extending_arrow,
Bio::Graphics::Glyph::generic,
Bio::Graphics::Glyph::graded_segments,
Bio::Graphics::Glyph::heterogeneous_segments,
Bio::Graphics::Glyph::line,
Bio::Graphics::Glyph::pinsertion,
Bio::Graphics::Glyph::primers,
Bio::Graphics::Glyph::rndrect,
Bio::Graphics::Glyph::segments,
Bio::Graphics::Glyph::ruler_arrow,
Bio::Graphics::Glyph::toomany,
Bio::Graphics::Glyph::transcript,
Bio::Graphics::Glyph::transcript2,
Bio::Graphics::Glyph::translation,
Bio::Graphics::Glyph::triangle,
Bio::Graphics::Glyph::xyplot,
Bio::DB::GFF,
Bio::SeqI,
Bio::SeqFeatureI,
Bio::Das,
GD

Allen Day <day@cshl.org>.
Copyright (c) 2001 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.