view release on metacpan or  search on metacpan

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

sub _subfeat {
  my $class   = shift;
  my $feature = shift;

  return $feature->segments     if $feature->can('segments');

  my @split = eval { my $id   = $feature->location->seq_id;
		     my @subs = $feature->location->sub_Location;
		     grep {$id eq $_->seq_id} @subs;
		   };

  return @split if @split;

  # Either the APIs have changed, or I got confused at some point...
  return $feature->get_SeqFeatures         if $feature->can('get_SeqFeatures');
  return $feature->sub_SeqFeature          if $feature->can('sub_SeqFeature');
  return;
}

# synthesize a key glyph
sub keyglyph {
  my $self = shift;
  my $feature = $self->make_key_feature;
  my $factory = $self->factory->clone;
  $factory->set_option(label       => 1);
  $factory->set_option(description => 0);
  $factory->set_option(bump  => 0);
  $factory->set_option(connector  => 'solid');
  return $factory->make_glyph(0,$feature);
}

# synthesize a key glyph
sub make_key_feature {
  my $self = shift;

  my $scale = 1/$self->scale;  # base pairs/pixel

  # one segments, at pixels 0->80
  my $offset = $self->panel->offset;

  my $feature =
    Bio::Graphics::Feature->new(-start =>0 * $scale +$offset,
				-end   =>80*$scale+$offset,
				-name => $self->make_key_name(),
				-strand => '+1');
  return $feature;
}

sub make_key_name {
  my $self = shift;

  # breaking encapsulation - this should be handled by the panel
  my $key      = $self->option('key') || '';
  return $key unless $self->panel->add_category_labels;

  my $category = $self->option('category');
  my $name     = defined $category ? "$key ($category)" : $key;
  return $name;
}

sub all_callbacks {
  my $self = shift;
  return $self->{all_callbacks} if exists $self->{all_callbacks}; # memoize
  return $self->{all_callbacks} = $self->_all_callbacks;
}

sub _all_callbacks {
  my $self = shift;
  my $track_level = $self->option('all_callbacks');
  return $track_level if defined $track_level;
  return $self->panel->all_callbacks;
}

sub subpart_callbacks {
  my $self = shift;
  return $self->{subpart_callbacks} if exists $self->{subpart_callbacks}; # memoize
  return $self->{subpart_callbacks} = $self->_subpart_callbacks;
}

sub _subpart_callbacks {
  my $self = shift;
  return 1 if $self->all_callbacks;
  my $do_subparts = $self->option('subpart_callbacks');
  return $self->{level} == 0 || ($self->{level} > 0 && $do_subparts);
}

sub default_factory {
  croak "no default factory implemented";
}

sub finished {
  my $self = shift;
  delete $self->{factory};
  foreach (@{$self->{parts} || []}) {
    $_->finished;
  }
  delete $self->{parts};
}


############################################################
# autogeneration of options documentation
############################################################

sub options {
    my $self      = shift;
    my $seenit    = shift || {};
    no strict 'refs';
    my $class  = ref $self || $self;
    my $isa    = "$class\:\:ISA";

    $seenit->{$class}++;
    my $options = $self->my_options
                 if defined &{"$class\:\:my_options"};

    my @inherited_options;

    for my $base (@$isa) {
	next if $seenit->{$base}++;
	$base->can('options') or next;
	my $o = $base->options($seenit);
	push @inherited_options,%$o;
    }
    return wantarray ? ($options,{@inherited_options})
	             : {@inherited_options,%$options};
}


sub options_usage {
    my $self  = shift;
    my ($read,$write);
    pipe($read,$write);
    my $child = fork();
    unless ($child) {
	close $read;
	print $write $self->options_pod;
	exit 0;
    }
    close $write;
    eval "use Pod::Usage";
    pod2usage({-input  =>$read,
	       -verbose=>2,
	      });

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

configuration variables.

End developers will not ordinarily work directly with
Bio::Graphics::Glyph objects, but with Bio::Graphics::Glyph::generic
and its subclasses.  Similarly, most glyph developers will want to
subclass from Bio::Graphics::Glyph::generic because the latter
provides labeling and arrow-drawing facilities.

=head1 METHODS

This section describes the class and object methods for
Bio::Graphics::Glyph.

=head2 CONSTRUCTORS

Bio::Graphics::Glyph objects are constructed automatically by an
Bio::Graphics::Glyph::Factory, and are not usually created by
end-developer code.

=over 4

=item $glyph = Bio::Graphics::Glyph-E<gt>new(-feature=E<gt>$feature,-factory=E<gt>$factory)

Given a sequence feature, creates an Bio::Graphics::Glyph object to
display it.  The B<-feature> argument points to the Bio:SeqFeatureI
object to display, and B<-factory> indicates an
Bio::Graphics::Glyph::Factory object from which the glyph will fetch
all its run-time configuration information.  Factories are created and
manipulated by the Bio::Graphics::Panel object.

A standard set of options are recognized.  See L<OPTIONS>.

=back

=head2 OBJECT METHODS

Once a glyph is created, it responds to a large number of methods.  In
this section, these methods are grouped into related categories.

Retrieving glyph context:

=over 4

=item $factory = $glyph-E<gt>factory

Get the Bio::Graphics::Glyph::Factory associated with this object.
This cannot be changed once it is set.

=item $panel = $glyph-E<gt>panel

Get the Bio::Graphics::Panel associated with this object.  This cannot
be changed once it is set.

=item $feature = $glyph-E<gt>feature

Get the sequence feature associated with this object.  This cannot be
changed once it is set.

=item $feature = $glyph-E<gt>parent_feature()

Within callbacks only, the parent_feature() method returns the parent
of the current feature, if there is one. Called with a numeric
argument, ascends the parentage tree: parent_feature(1) will return
the parent, parent_feature(2) will return the grandparent, etc. If
there is no parent, returns undef.

=item $feature = $glyph-E<gt>add_feature(@features)

Add the list of features to the glyph, creating subparts.  This is
most common done with the track glyph returned by
Bio::Graphics::Panel-E<gt>add_track().

If the Bio::Graphics::Panel was initialized with B<-feature_limit> set
to a non-zero value, then calls to a track glyph's add_feature()
method will maintain a count of features added to the track.  Once the
feature count exceeds the value set in -feature_limit, additional
features will displace existing ones in a way that effects a uniform
sampling of the total feature set. This is useful to protect against
excessively large tracks. The total number of features added can be
retrieved by calling the glyph's feature_count() method.

=item $feature = $glyph-E<gt>add_group(@features)

This is similar to add_feature(), but the list of features is treated
as a group and can be configured as a set.

=item $glyph-E<gt>finished

When you are finished with a glyph, you can call its finished() method
in order to break cycles that would otherwise cause memory leaks.
finished() is typically only used by the Panel object.

=item $subglyph = $glyph-E<gt>make_subglyph($level,@sub_features)

This method is called to create subglyphs from a list of
subfeatures. The $level indicates the current level of the glyph
(top-level glyphs are level 0, subglyphs are level 1, etc).

Ordinarily this method simply calls
$self-E<gt>factory-E<gt>make_subglyph($level,@sub_features). Override
it in subclasses to create subglyphs of a particular type. For
example:

 sub make_subglyph {
    my $self = shift;
    my $level = shift;
    my $factory = $self->factory;
    $factory->make_glyph($factory,'arrow',@_);
 }

=item $count = $glyph-E<gt>feature_count()

Return the number of features added to this glyph via add_feature().

=item $flag = $glyph->features_clipped()

If the panel was initialized with -feature_limit set to a non-zero
value, then calls to add_features() will limit the number of glyphs to
the indicated value. If this value was exceeded, then
features_clipped() will return true.