[Bioperl-l] Clickable Glyphs...

[Jonathan Greenwood]

Hi, I've submitted my code with the email, what I'm trying to do is to 
render a Genbank file as a png file, I need to make each glyph clickable(I'm 
also displaying this page online)...any help with the new changes to 
Bio::Graphics::Panel would be appreciated...many thanks...

Sincerely,

Jonathan Greenwood
email: jonathon at mgcheo.med.uottawa.ca

code:
#! /usr/local/bin/perl -wT

use strict;
use Bio::Graphics;
use Bio::SeqIO;
use Bio::SeqFeature::Generic;
use CGI;
use CGI::Pretty;

my $file = 'x65306.gb';
my $io = Bio::SeqIO->new(-file=>$file);
my $seq = $io->next_seq;
my $wholeseq = Bio::SeqFeature::Generic->new(-start=>1,
                                                                     
-end=>$seq->length);
my @features = $seq->all_SeqFeatures;
my $q = new CGI;

# sort features by their primary tags
my %sorted_features;
for my $f (@features) {
  my $tag = $f->primary_tag;
  push @{$sorted_features{$tag}},$f;
}

print $q->header( 'text/html' );
print $q->start_html('A Vector Rendering');

my $panel = Bio::Graphics::Panel->new(-length      => $seq->length,
				      -width       => 1000,
				      -pad_left    => 10,
				      -pad_right   => 10,
				      -key_color   => 'white',
				      -key_spacing => 15,
				      -key_style   => 'bottom',
				      -spacing     => -0.25,
				      -box_subparts => 'true'
				      );

my ($url,$map,$mapname) = $panel->image_and_map(-root => 
'/webfiles/cgi-bin',
						-url  => '/tmpimages',
					       );

$panel->add_track($wholeseq,
		  -glyph  => 'arrow',
		  -bump   => +1,
		  -double => 1,
		  -tick   => 2
	          );

$panel->add_track($wholeseq,
		  -glyph   => 'generic',
		  -bgcolor => 'purple',
		  -height  => 12,
		  -key     => 'Whole Sequence',
		  -title   => 'Whole Sequence'
		  );

# special feature
if ($sorted_features{CDS}) {
  $panel->add_track($sorted_features{CDS},
		    -glyph          => 'transcript2',
		    -bgcolor        => 'orange',
		    -bump           =>  +1,
		    -height         => 12,
		    -key            => 'CDS',
		    -label          => \&gene_label,
		    -title          => 'CDS',
		    -link           => 'feature1.html#CDS'
		    );
  delete $sorted_features{'CDS'};
}

#general case
my @colors = qw(wheat blue yellow green cyan chartreuse magenta gray);
my $idx    = 0;
for my $tag (sort keys %sorted_features) {
my $features = $sorted_features{$tag};
$panel->add_track($features,
		  -glyph        =>  'generic',
		  -bgcolor      =>  $colors[$idx++ % @colors],
		  -fgcolor      =>  'black',
		  -font2color   => 'red',
		  -key          => "${tag}s",
		  -bump         => +1,
		  -height       => 12,
                  -label        => \&gene_label,
		  -description  => \&generic_description,
		  -title        => \&gene_label,
		  -link         => 'feature1.html#$tag',
		  );
}

print $q->img({-src=>$url,-usemap=>"#$mapname"});
print $q->$map;
print $q->($panel->png);

print $q->exit_html;

exit;

  sub gene_label {
     my $feature = shift;
     my @notes;
     foreach (qw(product gene)) {
       next unless $feature->has_tag($_);
       @notes = $feature->each_tag_value($_);
       last;
    }
    $notes[0];
  }

  sub generic_description {
    my $feature = shift;
    my $description;
    foreach ($feature->all_tags) {
      my @values = $feature->each_tag_value($_);
      $description .= $_ eq 'note' ? "@values" : "$_=@values; ";
    }
    $description =~ s/; $//; # get rid of last
    $description;
  }

_________________________________________________________________
The new MSN 8: smart spam protection and 2 months FREE*  
http://join.msn.com/?page=features/junkmail  
http://join.msn.com/?page=dept/bcomm&pgmarket=en-ca&RU=http%3a%2f%2fjoin.msn.com%2f%3fpage%3dmisc%2fspecialoffers%26pgmarket%3den-ca