[Bioperl-l] Clickable Glyphs...

Lincoln Stein lstein at cshl.edu
Thu Feb 19 05:08:43 EST 2004


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Get the latest CVS version of bioperl-live and read the section of the 
Bio::Graphics::Panel manual page labeled "Creating Imagemaps."  
Essentially what you need to do is to replace the section after you 
create the panel with this:

	my ($url,$map,$mapname) - $panel->image_and_map(
						-root => '/var/www/html',
						-url   => '/tmpimages');
	print $q->header(),$q->start_html('A Bitmap Rendering');
	print $q->img({-src=>$url,-usemap=>"#$mapname");
	print $map;
	print $q->end_html;

I'm frankly more fond of the function-oriented CGI calls, so I would 
bring in the standard functions and then:

	print header(),
		start_html('A Bitmap Rendering'),
		img({-src=>$url,-usemap=>"#$mapname"),
		$map,
		end_html();

Lincoln

On Wednesday 18 February 2004 05:53 pm, Jonathan Greenwood wrote:
> 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%2
>fjoin.msn.com%2f%3fpage%3dmisc%2fspecialoffers%26pgmarket%3den-ca
>
> _______________________________________________
> Bioperl-l mailing list
> Bioperl-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-l

- -- 
Lincoln D. Stein
Cold Spring Harbor Laboratory
1 Bungtown Road
Cold Spring Harbor, NY 11724
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.1 (GNU/Linux)

iD8DBQFANIss0CIvUP7P+AkRAmh/AJ9SaY4MIZPS5vW5gE5xzaw7AzrjaQCdHJdE
S+2+MS2vScLrVTd+C3V4mME=
=MBei
-----END PGP SIGNATURE-----


More information about the Bioperl-l mailing list