[Bioperl-l] Clickable Glyphs...

[Josh Lauricha]

Not entirely sure what you are trying to do, but the way I've been
doing the same sort of thing was with two scripts. The first generates
the HTML, the second generates the PNG. To do this you create a panel
as if you were going to make an image in both. But for the HTML you do:
    @boxes = $panel->boxes()
rather than $panel->png().

You could do boxes() and png() on the same object if you don't mind
having temp images laying around (typically insecure). Or have a switch
argument passed via GET telling it to do the HTMl or the PNG:

My scripts are for a webbased tree displayer (kind of like forester),
a sequence displayer that highlights the glyph you click on in the
sequence (changes the text color) and a blast results image with
clickable HSPs. All done basically the same way (well, the tree is done
with graphics modules not yet in bioperl).

On Wed 02/18/04 10:53, 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%2fjoin.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
> 

-- 

----------------------------
| Josh Lauricha            |
| laurichj at bioinfo.ucr.edu |
| Bioinformatics, UCR      |
|--------------------------|