package Bio::Graphics::Glyph::rainbow_gene;
use strict;
use base qw(Bio::Graphics::Glyph::gene Bio::Graphics::Glyph::heat_map);
sub my_descripton {
return <<END;
This glyph is based on the gene glyph, expect that it inherits
methods from the heat_map glyph so that scored exons of transcript
features can have variable background colors. This is used to make
a score-based heat-map using the HSV color space. Either monochrome
gradients (for example the default white->red), or gradients progressing
through the colors of the rainbow (magenta->blue->green->yelloe->red)
can be created.
For example:
# a white->red heat map
start_color = white
stop_color = red
# a rainbow
start_color = magenta
stop_color = red
# green->yellow->red
start_color = green
stop_color = red
This glyph is a subclass of the gene and heat_maps glyphs, and
recognizes the same options.
END
}
sub my_options {
{
transcript_only => [
'boolean',
undef,
'If true, thes score of the transcript or mRNA feature will be '.
'will be used to calculate the background color. Otherwise the '.
'score of exon sub-features are used'
],
}
}
sub draw {
my $self = shift;
my @parts = $self->parts;
@parts = $self if !@parts && $self->level == 0;
return $self->SUPER::draw(@_) unless @parts;
my $top_score = $self->feature->score if $self->option('transcript_only');
$self->calculate_gradient(\@parts);
my $low_rgb = $self->low_rgb;
for my $part (@parts) {
my $score = $top_score || $part->feature->score;
unless (defined $score && $self->score_range ) {
$part->{partcolor} = $self->color_index(@$low_rgb);
}
else {
my @rgb = $self->calculate_color($score);
$part->{partcolor} = $self->color_index(@rgb);
}
}
return $self->SUPER::draw(@_);
}
sub extra_arrow_length {
my $self = shift;
return 0 unless $self->{level} == 1;
local $self->{level} = 0; # fake out superclass
return $self->SUPER::extra_arrow_length;
}
sub pad_left {
my $self = shift;
my $type = $self->feature->primary_tag;
return 0 unless $type =~ /gene|mRNA/;
$self->SUPER::pad_left;
}
sub pad_right {
my $self = shift;
return 0 unless $self->{level} < 2; # don't invoke this expensive call on exons
my $strand = $self->feature->strand;
$strand *= -1 if $self->{flip};
my $pad = $self->SUPER::pad_right;
return $pad unless defined($strand) && $strand > 0;
my $al = $self->arrow_length;
return $al > $pad ? $al : $pad;
}
sub pad_bottom {
my $self = shift;
return 0 unless $self->{level} < 2; # don't invoke this expensive call on exons
return $self->SUPER::pad_bottom;
}
sub pad_top {
my $self = shift;
return 0 unless $self->{level} < 2; # don't invoke this expensive call on exons
return $self->SUPER::pad_top;
}
sub bump {
my $self = shift;
return 1 # top level bumps, other levels don't unless specified in config
if $self->{level} == 0
&& lc $self->feature->primary_tag eq 'gene';
return $self->SUPER::bump;
}
sub label {
my $self = shift;
return unless $self->{level} < 2;
if ($self->label_transcripts && $self->{feature}->primary_tag =~ /RNA|pseudogene/i) {
return $self->_label;
} else {
return $self->SUPER::label;
}
}
sub label_position {
my $self = shift;
return 'top' if $self->{level} == 0;
return 'left';
}
sub label_transcripts {
my $self = shift;
return $self->{label_transcripts} if exists $self->{label_transcripts};
return $self->{label_transcripts} = $self->_label_transcripts;
}
sub _label_transcripts {
my $self = shift;
return $self->option('label_transcripts');
}
sub draw_connectors {
my $self = shift;
if ($self->feature->primary_tag eq 'gene') {
my @parts = $self->parts;
return if @parts && $parts[0] =~ /rna|transcript|pseudogene/i;
}
$self->SUPER::draw_connectors(@_);
}
sub maxdepth {
my $self = shift;
my $md = $self->Bio::Graphics::Glyph::maxdepth;
return $md if defined $md;
return 2;
}
sub _subfeat {
my $class = shift;
my $feature = shift;
if ($feature->primary_tag =~ /^gene/i) {
my @transcripts;
for my $t (qw/mRNA tRNA snRNA snoRNA miRNA ncRNA pseudogene/) {
push @transcripts, $feature->get_SeqFeatures($t);
}
return @transcripts if @transcripts;
return $feature->get_SeqFeatures; # no transcripts?! return whatever's there
}
elsif ($feature->primary_tag =~ /^CDS/i) {
my @parts = $feature->get_SeqFeatures();
return ($feature) if $class->{level} == 0 and !@parts;
return @parts;
}
my @subparts;
if ($class->option('sub_part')) {
@subparts = $feature->get_SeqFeatures($class->option('sub_part'));
}
elsif ($feature->primary_tag =~ /^mRNA/i) {
@subparts = $feature->get_SeqFeatures(qw(CDS five_prime_UTR three_prime_UTR UTR));
}
else {
@subparts = $feature->get_SeqFeatures('exon');
}
# The CDS and UTRs may be represented as a single feature with subparts or as several features
# that have different IDs. We handle both cases transparently.
my @result;
foreach (@subparts) {
if ($_->primary_tag =~ /CDS|UTR/i) {
my @cds_seg = $_->get_SeqFeatures;
if (@cds_seg > 0) { push @result,@cds_seg } else { push @result,$_ }
} else {
push @result,$_;
}
}
# fall back to drawing a solid box if no subparts and level 0
return ($feature) if $class->{level} == 0 && !@result;
return @result;
}
sub bgcolor {
my $self = shift;
return defined $self->{partcolor} ? $self->{partcolor} : $self->SUPER::bgcolor;
}
sub fgcolor {
my $self = shift;
return $self->option('vary_fg') ? $self->bgcolor : $self->SUPER::fgcolor;
}
1;
__END__
=head1 NAME
Bio::Graphics::Glyph::gene - A GFF3-compatible gene glyph
=head1 SYNOPSIS
See L<Bio::Graphics::Panel> and L<Bio::Graphics::Glyph>.
=head1 DESCRIPTION
This glyph is used for drawing genes that may have
alternatively-spliced transcripts. The various isoforms are stacked on
top of each other and given a single label and description that apply
to the entire stack. Each individual transcript's name is optionally
printed to the left of the transcript glyph.
Transcripts (splice isoforms) are drawn using the processed_transcript
glyph. CDS features are drawn in the background color, and the UTRs
are drawn in an alternate color selected by the utr_color option. In
addition, you can make the UTRs thinner than the CDS by setting the
"thin_utr" option.
This glyph is designed to work properly with GFF3-style three-tier
genes, in which the top level feature has the Sequence Ontology type
of "gene", the second level feature(s) have the SO type "mRNA", and
the third level feature(s) have the SO type "CDS", "five_prime_utr"
and "three_prime_utr." Subparts named "UTR" are also honored. The
feature can contain other subparts as well (e.g. exon, intron,
translation), but they are currently ignored unless the option
sub_part is supplied. If the sub_part option is used that feature
type will be used and CDS and UTR features will be excluded.
This could be used for specifying that exons be used instead,
for example.
This glyph is a subclass of processed_transcript, and recognizes the
same options.
=head2 OPTIONS
The following options are standard among all Glyphs. See
L<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 undef (false)
-connector_color
Connector color black
-label Whether to draw a label undef (false)
-description Whether to draw a description undef (false)
-strand_arrow Whether to indicate undef (false)
strandedness
-hilite Highlight color undef (no color)
In addition, the gene glyph recognizes the following glyph-specific
options:
Option Description Default
------ ----------- -------
-label_transcripts undef (false)
Flag. If true, then the
display name of each
transcript will be drawn
to the left of the transcript
glyph.
-thin_utr Flag. If true, UTRs will undef (false)
be drawn at 2/3 of the
height of CDS segments.
-utr_color Color of UTR segments. Gray #D0D0D0
-decorate_introns
Draw strand with little arrows undef (false)
on the intron.
The B<-adjust_exons> and B<-implied_utrs> options are inherited from
processed_transcript, but are quietly ignored. Please use the
processed_transcript glyph for this type of processing.
=head1 BUGS
The SO terms are hard-coded. They should be more flexible and should
recognize ISA relationships.
=head1 SEE ALSO
L<Bio::Graphics::Panel>,
L<Bio::Graphics::Glyph>,
L<Bio::Graphics::Glyph::arrow>,
L<Bio::Graphics::Glyph::cds>,
L<Bio::Graphics::Glyph::crossbox>,
L<Bio::Graphics::Glyph::diamond>,
L<Bio::Graphics::Glyph::dna>,
L<Bio::Graphics::Glyph::dot>,
L<Bio::Graphics::Glyph::ellipse>,
L<Bio::Graphics::Glyph::extending_arrow>,
L<Bio::Graphics::Glyph::generic>,
L<Bio::Graphics::Glyph::graded_segments>,
L<Bio::Graphics::Glyph::heterogeneous_segments>,
L<Bio::Graphics::Glyph::line>,
L<Bio::Graphics::Glyph::pinsertion>,
L<Bio::Graphics::Glyph::primers>,
L<Bio::Graphics::Glyph::rndrect>,
L<Bio::Graphics::Glyph::segments>,
L<Bio::Graphics::Glyph::ruler_arrow>,
L<Bio::Graphics::Glyph::toomany>,
L<Bio::Graphics::Glyph::transcript>,
L<Bio::Graphics::Glyph::transcript2>,
L<Bio::Graphics::Glyph::translation>,
L<Bio::Graphics::Glyph::triangle>,
L<Bio::DB::GFF>,
L<Bio::SeqI>,
L<Bio::SeqFeatureI>,
L<Bio::Das>,
L<GD>
=head1 AUTHOR
Lincoln Stein E<lt>lstein@cshl.orgE<gt>
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.
=cut