#!/usr/bin/perl # # PROGRAM : hitdisplay.pl # PURPOSE : Demonstrate Bio::Tk::HitDisplay # AUTHOR : Keith James kdj@sanger.ac.uk # CREATED : Nov 1 2000 # # Requires Bio::Tk::HitDisplay # # To use, just pipe Blast output into this script. Try clicking on # the blue Subject ids with the left button to activate a callback # or with the right button to show text describing the hit. # use strict; use Text::Wrap qw(wrap $columns); use Bio::Tools::BPlite; BEGIN { print STDERR "This example uses deprecated BioPerl code; feel free to refactor as needed\n"; exit; eval { require 'Tk.pm'; require 'Bio/Tk/HitDisplay.pm'; }; if( $@ ) { print STDERR "Must have bioperl-gui and Tk installed to run this test, see bioperl website www.bioperl.org for instructions on how to installed bioperl-gui modules\n"; exit; } } use Tk; $columns = 80; my $report = Bio::Tools::BPlite->new(-fh => \*STDIN); # Normally the code ref below is in a separate package and I do # something like: # # my $adapter = Bio::PSU::IO::Blast::HitAdapter->new; # # while (my $hit = $result->next_hit) # { # my $text = " ... "; # my $callback = sub { ... }; # push(@hits, $adapter->($sbjct, $text, $callback)); # } # # It's easy to roll your own for Fasta, or whatever. my $adapter = sub { my ($sbjct, $text, $callback) = @_; my (@data, $expect, $percent, $length); my ($q_id, $s_id, $q_len, $s_len); while (my $hsp = $sbjct->nextHSP) { $q_id ||= $hsp->query->seqname; $s_id ||= $hsp->subject->seqname; $q_len ||= $hsp->query->seqlength; $s_len ||= $hsp->subject->seqlength; my $q_x1 = $hsp->query->start; my $q_x2 = $hsp->query->end; my $s_x1 = $hsp->subject->start; my $s_x2 = $hsp->subject->end; push(@data, [$q_x1, $q_x2, $s_x1, $s_x2]); if (defined $expect) { if ($hsp->P < $expect) { $expect = $hsp->P; $percent = $hsp->percent; $length = $hsp->length; } } else { $expect = $hsp->P; $percent = $hsp->percent; $length = $hsp->length; } } return { q_id => $q_id, s_id => $s_id, expect => $expect, score => $percent, overlap => $length, q_len => $q_len, s_len => $s_len, data => \@data, text => $text, callback => $callback } }; my @hits; while (my $sbjct = $report->nextSbjct) { # Make some text to show when the left button is clicked my $text = wrap("", "", "Blast hit to: ", $sbjct->name, "\n"); # Make a callback to actiavte when the right button is clicked my $callback = sub { print "Blast hit to ", $sbjct->name, "\n" }; # Convert Subjct, text and callback into hash push(@hits, $adapter->($sbjct, $text, $callback)); } # Create the main window and HitDisplay my $mw = MainWindow->new; my $hds = $mw->Scrolled('HitDisplay', -borderwidth => 5, -scrollbars => 'ose', -width => 600, -height => 300, -background => 'white', -hitcolours => { 10 => 'pink', 20 => 'purple', 40 => 'yellow', 60 => 'gold', 70 => 'orange', 90 => 'red' }, -interval => 15, -hitdata => \@hits); $hds->pack(-side => 'top', -fill => 'both', -expand => 1); $hds->waitVisibility; $hds->configure(-height => 900); $hds->configure(-scrollregion => [$hds->bbox("all")]); MainLoop;