view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph.pm  view on Meta::CPAN

       my @sortbys = split(/\s*\|\s*/o, $opt);
       $sortfunc = 'sub { ';
       my $sawleft = 0;

       # not sure I can make this schwartzian transformed
       for my $sortby (@sortbys) {
	 if ($sortby eq "left" || $sortby eq "default") {
	   $sortfunc .= '($a->start <=> $b->start) || ';
	   $sawleft++;
	 } elsif ($sortby eq "right") {
	   $sortfunc .= '($a->end <=> $b->end) || ';
	 } elsif ($sortby eq "low_score") {
	   $sortfunc .= '($a->score <=> $b->score) || ';
	 } elsif ($sortby eq "high_score") {
	   $sortfunc .= '($b->score <=> $a->score) || ';
	 } elsif ($sortby eq "longest") {
	   $sortfunc .= '(($b->length) <=> ($a->length)) || ';
	 } elsif ($sortby eq "shortest") {
	   $sortfunc .= '(($a->length) <=> ($b->length)) || ';
	 } elsif ($sortby eq "strand") {
	   $sortfunc .= '($b->strand <=> $a->strand) || ';
	 } elsif ($sortby eq "name") {
	   $sortfunc .= '($a->feature->display_name cmp $b->feature->display_name) || ';
	 }
       }
       unless ($sawleft) {
           $sortfunc .= ' ($a->left <=> $b->left) ';
       } else {
           $sortfunc .= ' 0';
       }
       $sortfunc .= '}';
       $sortfunc = eval $sortfunc;
    }

    # cache this
    # $self->factory->set_option(sort_order => $sortfunc);
    my @things = sort $sortfunc @_;
    return @things;
}

# handle collision detection
sub layout {
  my $self = shift;

  return $self->{layout_height} if exists $self->{layout_height};

  my @parts = $self->parts;
  return $self->{layout_height} = 
      $self->height + $self->pad_top + $self->pad_bottom unless @parts;

  my $bump_direction = $self->bump;
  my $bump_limit     = $self->bump_limit || -1;

  $bump_direction = 'fast' if 
      $bump_direction && 
      $bump_direction == 1 && 
      !$self->code_option('sort_order');

  $_->layout foreach @parts;  # recursively lay out

  # no bumping requested, or only one part here, or the tracks are supposed to be overlay
  if (@parts == 1 || !$bump_direction || ($bump_direction eq 'fast' and $self->code_option('overlay') == 1)) {
    my $highest = 0;
    foreach (@parts) {
      my $height = $_->layout_height;
      $highest   = $height > $highest ? $height : $highest;
    }
    return $self->{layout_height} = $highest + $self->pad_top + $self->pad_bottom;
  }

  if ($bump_direction eq 'fast' or $bump_direction == 3) {
      return $self->{layout_height} = $self->optimized_layout(\@parts)
	  + $self->pad_bottom + $self->pad_top -1;# - $self->top  + 1;
  }

  my (%bin1,%bin2);
  my $limit          = 0;
  my $recent_pos     = 0;
  my $max_pos        = 0;

  # strand bumping turns on bumping for features that are in opposite strands!
  # features in the same strand are allowed to overlap
  my $strand_bumping;
  if ($bump_direction eq 'overlap') {
      $bump_direction    = 1;
      $strand_bumping++;
  }

  for my $g ($self->layout_sort(@parts)) {

    my $height = $g->{layout_height};

    # Simple +/- 2 bumping.  Every feature gets its very own line
    if (abs($bump_direction) >= 2) {
      $g->move(0,$limit);
      $limit += $height + BUMP_SPACING if $bump_direction > 0;
      $limit -= $height + BUMP_SPACING if $bump_direction < 0;
      next;
    }

    # we get here for +/- 1 bumping
    my $pos       = 0;
    my $bumplevel = 0;
    my $left   = $g->left;
    my $right  = $g->right;
    my $strand = $g->strand || 0;

    my $search_mode = 'down';

    while (1) {

	# stop bumping if we've gone too far down
	if ($bump_limit > 0 && $bumplevel++ >= $bump_limit) {
	    $g->{overbumped}++;  # this flag can be used to suppress label and description
	    foreach ($g->parts) {
		$_->{overbumped}++;
	    }
	    last;
	}

	# look for collisions
	my $bottom      = $pos + $height;

lib/Bio/Graphics/Glyph.pm  view on Meta::CPAN

The B<-strand_arrow> option, if true, requests that the glyph indicate
which strand it is on, usually by drawing an arrowhead.  Not all
glyphs will respond to this request.  For historical reasons,
B<-stranded> is a synonym for this option. Multisegmented features
will draw an arrowhead on each component unless you specify a value of
"ends" to -strand_arrow, in which case only the rightmost component
(for + strand features) or the leftmost component (for - strand
features) will have arrowheads.

B<sort_order>: By default, features are drawn with a layout based only on the
position of the feature, assuring a maximal "packing" of the glyphs
when bumped.  In some cases, however, it makes sense to display the
glyphs sorted by score or some other comparison, e.g. such that more
"important" features are nearer the top of the display, stacked above
less important features.  The -sort_order option allows a few
different built-in values for changing the default sort order (which
is by "left" position): "low_score" (or "high_score") will cause
features to be sorted from lowest to highest score (or vice versa).
"left" (or "default") and "right" values will cause features to be
sorted by their position in the sequence.  "longest" (or "shortest")
will cause the longest (or shortest) features to be sorted first, and
"strand" will cause the features to be sorted by strand: "+1"
(forward) then "0" (unknown, or NA) then "-1" (reverse).  Finally,
"name" will sort by the display_name of the features.

In all cases, the "left" position will be used to break any ties.  To
break ties using another field, options may be strung together using a
"|" character; e.g. "strand|low_score|right" would cause the features
to be sorted first by strand, then score (lowest to highest), then by
"right" position in the sequence.

Finally, a subroutine coderef with a $$ prototype can be provided.  It
will receive two B<glyph> as arguments and should return -1, 0 or 1
(see Perl's sort() function for more information).  For example, to
sort a set of database search hits by bits (stored in the features'
"score" fields), scaled by the log of the alignment length (with
"start" position breaking any ties):

  sort_order = sub ($$) {
    my ($glyph1,$glyph2) = @_;
    my $a = $glyph1->feature;
    my $b = $glyph2->feature;
    ( $b->score/log($b->length)
          <=>
      $a->score/log($a->length) )
          ||
    ( $a->start <=> $b->start )
  }

It is important to remember to use the $$ prototype as shown in the
example.  Otherwise Bio::Graphics will quit with an exception. The
arguments are subclasses of Bio::Graphics::Glyph, not the features
themselves.  While glyphs implement some, but not all, of the feature
methods, to be safe call the two glyphs' feature() methods in order to
convert them into the actual features.

The '-always_sort' option, if true, will sort features even if bumping
is turned off.  This is useful if you would like overlapping features
to stack in a particular order.  Features towards the end of the list
will overlay those towards the beginning of the sort order.

The B<-hilite> option draws a colored box behind each feature using the
indicated color. Typically you will pass it a code ref that returns a
color name.  For example:

  -hilite => sub { my $name = shift->display_name; 
                   return 'yellow' if $name =~ /XYZ/ }

The B<-no_subparts> option will prevent the glyph from searching its
feature for subfeatures. This may enhance performance if you know in
advance that none of your features contain subfeatures.

=head1 SUBCLASSING Bio::Graphics::Glyph

By convention, subclasses are all lower-case.  Begin each subclass
with a preamble like this one:

 package Bio::Graphics::Glyph::crossbox;

 use strict;
 use base qw(Bio::Graphics::Glyph);

Then override the methods you need to.  Typically, just the draw()
method will need to be overridden.  However, if you need additional
room in the glyph, you may override calculate_height(),
calculate_left() and calculate_right().  Do not directly override
height(), left() and right(), as their purpose is to cache the values
returned by their calculating cousins in order to avoid time-consuming
recalculation.

A simple draw() method looks like this:

 sub draw {
  my $self = shift;
  $self->SUPER::draw(@_);
  my $gd = shift;

  # and draw a cross through the box
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
  my $fg = $self->fgcolor;
  $gd->line($x1,$y1,$x2,$y2,$fg);
  $gd->line($x1,$y2,$x2,$y1,$fg);
 }

This subclass draws a simple box with two lines criss-crossed through
it.  We first call our inherited draw() method to generate the filled
box and label.  We then call calculate_boundaries() to return the
coordinates of the glyph, disregarding any extra space taken by
labels.  We call fgcolor() to return the desired foreground color, and
then call $gd-E<gt>line() twice to generate the criss-cross.

For more complex draw() methods, see Bio::Graphics::Glyph::transcript
and Bio::Graphics::Glyph::segments.

Please avoid using a specific image class (via "use GD" for example)
within your glyph package. Instead, rely on the image package passed
to the draw() method. This approach allows for future expansion of
supported image classes without requiring glyph redesign. If you need
access to the specific image classes such as Polygon, Image, or Font,
generate them like such: