Permalink
Switch branches/tags
tag-ensembl-stable-061 start snapshot-at-head-of-07-branch release-ensembl-06 release-06 release-06-2 release-1_01 release-1-7-2 release-1-7-1 release-1-7-0 release-1-7-0-RC6 release-1-7-0-RC5 release-1-7-0-RC4 release-1-6-zenodo release-1-6-924 release-1-6-923 release-1-6-922 release-1-6-921 release-1-6-920 release-1-6-910 release-0-9-3 release-0-9-2 release-0-9-0 release-0-7-2 release-0-7-1 release-0-7-0 release-0-05 release-0-05-1 release-0-04-4 release-0-04-3 release-0-04-2 release-0-04-1 prerelease-06 ontology-overhaul-start ontology-overhaul-end ontology-fix1 lightweight_feature join-0-04-to-0-05 gbrowse_1_65 for_gmod_0_003 bioperl-run-release-1-2-0 bioperl-release-1-6 bioperl-release-1-6-901 bioperl-release-1-6-9 bioperl-release-1-6-1 bioperl-release-1-5-2 bioperl-release-1-5-2-patch2 bioperl-release-1-5-2-patch1 bioperl-release-1-5-1 bioperl-release-1-5-1-rc4 bioperl-release-1-5-0 bioperl-release-1-5-0-rc2 bioperl-release-1-5-0-rc1 bioperl-release-1-4-0 bioperl-release-1-2-3 bioperl-release-1-2-2 bioperl-release-1-2-1 bioperl-release-1-2-0 bioperl-release-1-1-0 bioperl-release-1-0-2 bioperl-release-1-0-1 bioperl-release-1-0-0 bioperl-devel-1-3-04 bioperl-devel-1-3-03 bioperl-devel-1-3-02 bioperl-devel-1-3-01 bioperl-devel-1-1-1 bioperl-061-pre1 bioperl-06-1 bioperl-1-6-RC4 bioperl-1-6-RC3_15392 bioperl-1-6-RC3 bioperl-1-6-RC2_15306 bioperl-1-6-RC2 bioperl-1-6-RC1 bioperl-1-6-0_006 bioperl-1-6-0_005 bioperl-1-6-0_004 bioperl-1-6-0_003 bioperl-1-6-0_002 bioperl-1-6-0_001 bioperl-1-2-1-rc1 bioperl-1-0-alpha2-rc bioperl-1-0-alpha bioperl-1-0-0 before-05-to-06-trunk before-05-to-06-merge after004 after-05-06-merge after-05-06-merge-2
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 143 lines (121 sloc) 3.3 KB
#!/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;