/usr/share/doc/bioperl/examples/tk/hitdisplay.pl is in bioperl 1.6.901-2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | #!/usr/local/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;
|