Toolbar

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. It 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

-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 _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 _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 arrow {

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

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

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

}

sub arrowhead {

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

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

  if ($style eq 'filled') {
    my $poly = new GD::Polygon;
    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);
    }
    $gd->filledPolygon($poly,$fg);
  } else {
    if ($orientation >= 0) {
      $gd->line($x-$height,$y-$height,$x,$y,$fg);
      $gd->line($x,$y,$x-$height,$y+$height,$fg);
    } else {
      $gd->line($x+$height,$y-$height,$x,$y,$fg);
      $gd->line($x,$y,$x+$height,$y+$height,$fg);
    }
  }

}

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 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 draw {

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

}

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 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 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 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 labelheight {

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

}

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 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 reversec {

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

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::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.