[Bioperl-l] RE: Passing extra arguments to method references inBio::Graphics::Panel::add_track

[Crabtree, Jonathan]

Hi Mick-

>So I'm drawing images of genes.  I don't want "bumped" images, and what
>this means is that the labels begin to overwrite one another and it
>looks awful.  So what I want to do is ONLY draw a label and a
>description if the glyph is the FIRST glyph in a particular track.
>Maybe I'm being stupid, but I can't figure out how to do it - I can't
>see how I can make each new glyph figure out if a glyph has been drawn
>before it on the same track.

I can think of a few ways to do something like this, and I've included some sample code (see below) that illustrates two of them.  You may also be able to achieve a similar effect by enclosing your gene glyphs in some kind of "invisible" parent feature that prints a label and description but nothing else.

>On a different note, I want an overall title for each track (not each
>glyph in a track, a title for the entire track) - and I don't want to
>have a key.  Is that possible?

Have you tried setting -key_style=>'between' in the call to Panel->new()?  This will place each track title next to the relevant track, instead of at the bottom of the image.

Jonathan


#!/usr/bin/perl

use Bio::Graphics::Panel;
use Bio::SeqFeature::Generic;

my $panel = Bio::Graphics::Panel->new(-length=> 1000, -width=> 600, -key_style=> 'between');

# 3 features
my $f1 = Bio::SeqFeature::Generic->new(-start=>200, -end=>300, 
-primary_tag=>'misc', -label=>'l1', -display_name=>'d1');
my $f2 = Bio::SeqFeature::Generic->new(-start=>400, -end=>600, 
-primary_tag=>'misc', -label=>'l2', -display_name=>'d2');
my $f3 = Bio::SeqFeature::Generic->new(-start=>50, -end=>150, 
-primary_tag=>'misc', -label=>'l3', -display_name=>'d3');

# APPROACH #1: decide in advance which of the features will be lucky 
# enough to get a label & description; we'll call it $specialFeat
my $specialFeat = $f2;
my $descrFn1 = sub {
    my $feat = shift;
    # returning ' ' instead of undef or '' to maintain vertical spacing
    return ' ' unless ($feat eq $specialFeat);
    return $feat->primary_tag();
};
my $labelFn1 = sub {
    my $feat = shift;
    # returning ' ' instead of undef or '' to maintain vertical spacing
    return ' ' unless ($feat eq $specialFeat); 
    return 1; # use default label
};

my $track1 = $panel->add_track([$f1,$f2,$f3],
			       -glyph       => 'generic',
			       -label       => $labelFn1,
			       -description => $descrFn1,
			       -fontcolor   => 'red',
			       -font2color  => 'blue',
			       -bgcolor     => 'blue',
			       -key         => 'track1',
			       );

# APPROACH #2: Write functions that will return a label/description 
# only for the "first" feature drawn in a given track (i.e., the
# first time they are called.)

# Note that this approach is more "dangerous" because it relies on the
# fact that Bioperl doesn't make any superfluous calls to $descrFn2 or
# $labelFn2.  Note also that the labels appear on $f3, not $f1 (at
# least on my machine), because Bioperl does not necessarily draw the
# features in the order that they are presented to the add_track
# method [$f1,$f2,$f3].
my $descrCallCount = 0;
my $descrFn2 = sub {
    my $feat = shift;
    ++$descrCallCount;
    # returning ' ' instead of undef or '' to maintain vertical spacing
    return ' ' unless ($descrCallCount == 1);
    return $feat->primary_tag();
};
my $labelCallCount = 0;
my $labelFn2 = sub {
    my $feat = shift;
    ++$labelCallCount;
    # returning ' ' instead of undef or '' to maintain vertical spacing
    return ' ' unless ($labelCallCount == 1);
    return 1; # use default label
};

my $track2 = $panel->add_track([$f1,$f2,$f3],
			       -glyph       => 'generic',
			       -label       => $labelFn2,
			       -description => $descrFn2,
			       -fontcolor   => 'red',
			       -font2color  => 'blue',
			       -bgcolor     => 'blue',
			       -key         => 'track2',
			      );

# note that if you want to call png() again (or any other method that results
# in $labelFn2 or $descrFn2 being called) then you'll first want to reset 
# $descrCallCount and $labelCallCount to their original values

print $panel->png();