Bio::Tk Hitdisplay
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvs
Summary
Bio::Tk::HitDisplay - Frame-based widget for displaying Fasta or
Blast hits/HSPs with optional text annotation
Package variables
No package variables defined.
Included modules
Carp
Tk::Canvas
Tk::Frame
Inherit
Tk::Frame
Synopsis
 use Bio::Tk::HitDisplay;
...
$hds = $parent->HitDisplay(?options?);
Description
HitDisplay is a Frame-based widget which contains a Canvas. When
provided with a list of data structures, each representing a hit of a
query sequence to a database, it draws:
    * A scale
    This is marked in residues (aa for a protein query, nt for a nucleic
acid query)
    * The query sequence
    Represented as a single green line
    * Database hits
    A line for each Fasta hit, or a group of lines for each Blast hit (one
per HSP)
The coordinates of the hits/HSPs on the subject sequence (i.e. the
sequence in the database) are indicated below the ends of each line.
The HitDisplay delegates all standard options to the Canvas contained
within it. The non-standard options for HitDisplay are:
    B<-hitdata> => \@hitdata
    The structure of each element of this list is quite complex. They are
normally generated from object(s) representing Blast or Fasta hits e.g.
 Bio::PSU::IO::Blast::Hit
Bio::PSU::IO::Fasta::Hit
    by their respective adapters
 Bio::PSU::IO::Blast::HitAdapter
Bio::PSU::IO::Fasta::HitAdapter
    This is normally hidden, unless you want to go and look.
    Each element is a reference to a hash containing the following keys
and values:
          { q_id     => 'query id',
s_id => 'subject id',
expect => 'expect value',
score => 'percentage identity',
overlap => 'length of hit',
q_len => 'query length',
s_len => 'subject length',
data => \@data,
text => "Some text",
callback => $callback }
    @data is a list of references to lists, each of which contains the
coordinates of a single Fasta hit or Blast HSP on both the query and
subject sequences. Each innermost list contains 4 values; the start
and end coordinates on the query sequence (indices 0 and 1) and the
start and end coordinates on the subject sequence (indices 2 and 3). A
Blast hit with 3 HSPs will look like this:
          [ [ q_start1, q_end1, s_start1, s_end1 ],
[ q_start2, q_end2, s_start2, s_end2 ],
[ q_start3, q_end3, s_start3, s_end3 ] ]
    The text field may contain any text which should be associated with
that hit e.g. a more detailed account of the result or of the subject
sequence. The display of this text is bound to a right mouse button
click on the subject id in the canvas window. The text will appear
just below the hit with one click and a subsequent click will hide it
again.
    The callback is a code reference which, if defined, will be bound to a
left mouse button click on the subject id in the canvas window.
    B<-hitcolours> => \%colourhash
    The hits or HSPs will be colour-coded according to percentage identity
according to the key->value pairs in the colourhash. The default
values are:
          { 90 => 'red',
80 => 'orange',
60 => 'gold',
40 => 'yellow' }
    This indicates that hits where the query is >= 90% identical to the
subject will be red, >= 80% will be orange etc. The hash supplied to
-hitcolours will override the defaults.
    B<-interval> =E<gt> integer >= 10
    This defines the vertical spacing between hit lines on the canvas. The
minimum (and default) value is 10.
Mouse bindings provided:
    * Vertical scrolling
    Wheel-mouse support is provided by binding buttons 4 and 5 to vertical
scrolling (standard Z-axis mapping under XFree86 on Linux).
    * Panning
    Holding down the middle mouse button while dragging will pan the
canvas in all directions
    * Display/hide all text annotations
    Double-clicking the left mouse button within the canvas will display
all text annotations, while double-clicking with the right button will
hide them. This is slow at the moment, with more than about 20 hits.
Possible improvements:
    * Speed up opening/closing all text annotations at once
    * Items other than text between the hits
    * Make more of the canvas configurable
    Mouse bindings should be made configurable. Perhaps the canvas items
making up each hit should be given a unique tag
Methods
PopulateDescriptionCode
draw_alignDescriptionCode
h_lineDescriptionCode
draw_scaleDescriptionCode
deannotate_hitDescriptionCode
annotate_hitDescriptionCode
open_all
No description
Code
close_all
No description
Code
scroll_mark
No description
Code
scroll_drag
No description
Code
Methods description
Populatecode    nextTop
 Title   : Populate
Usage : N/A
Function: Standard composite Frame-based widget setup.
: See 'man Tk::composite' for details
Returns : Nothing
Args : Hash reference
draw_aligncodeprevnextTop
 Title   : draw_align
Usage : N/A
Function: Draws hit text, line and coords for the hits
Returns : Nothing
Args : Canvas, hitdata hash reference, left margin for text,
: x coord for lines, y coord for lines, interval between
: sets of lines (representing 1 Fasta hit or 1+ Blast
: HSPs), hitcolours hash reference
h_linecodeprevnextTop
 Title   : h_line
Usage : N/A
Function: Draws a single hit/HSP line with the subject coords
: below it
Returns : Nothing
Args : Canvas, hit hash reference, x coord for line,
: y coord for line, line width, line colour
draw_scalecodeprevnextTop
 Title   : draw_scale
Usage : N/A
Function: Draws scale alongside line representing query
: sequence
Returns : Nothing
Args : Canvas, hit hash reference, left margin for text
: x coord for line, y coord for line
deannotate_hitcodeprevnextTop
 Title   : deannotate_hit
Usage : N/A
Function: Reverses the effect of annotate_hit
Returns : Nothing
Args : Canvas, text item (subject id), text to be inserted
: in gap, interval between hits
annotate_hitcodeprevnextTop
 Title   : annotate_hit
Usage : N/A
Function: Displays hit annotation below a hit line by shuffling
: all canvas elements down the canvas and placing the
: annotation text in the gap
Returns : Nothing
Args : Canvas, text item (subject id), text to be inserted
: in gap, interval between hits
Methods code
PopulatedescriptionprevnextTop
sub Populate {
    my ($self, $args) = @_;

    my $hitdata    = delete $args->{-hitdata};
    my $interval   = delete $args->{-interval};
    my $hitcolours = delete $args->{-hitcolours};

    my $defaultcolours = { 90 => 'red',
			   80 => 'orange',
			   60 => 'gold',
			   40 => 'yellow' };

    # A hash for storing callbacks, passed by reference to subs
my $callbackbox = { annotate => [], deannotate => [] }; my $hititems = []; # Check colour option passed in by user
if (defined $hitcolours) { unless (ref($hitcolours) eq 'HASH') { carp "Value passed to -hitcolours was not a hash reference; using defaults"; $hitcolours = $defaultcolours; } } else { $hitcolours = $defaultcolours } # Check interval option passed in by user; default is 10
unless (defined $interval and $interval >= 10) { carp "Value passed to -interval was too small; using minimum (10)"; $interval = 10; } $self->SUPER::Populate($args); $self->fontCreate('hv-n-tiny', -family => 'helvetica', -size => 8, -weight => 'normal'); $self->fontCreate('hv-n-small', -family => 'helvetica', -size => 10, -weight => 'normal'); $self->fontCreate('hv-b-small', -family => 'helvetica', -size => 10, -weight => 'bold'); $self->fontCreate('hv-n-med', -family => 'helvetica', -size => 12, -weight => 'normal'); my $cv = $self->Canvas->pack(-anchor => 'w', -side => 'top', -fill => 'both'); # Bindings to allow dragging movement
$cv->CanvasBind('<Button-2>',\& scroll_mark); $cv->CanvasBind('<Button2-Motion>', [\&scroll_drag, 4]); # Open/close all
$cv->CanvasBind('<Double-Button-1>', [\&open_all, $callbackbox]); $cv->CanvasBind('<Double-Button-3>', [\&close_all, $callbackbox]); # Binding to allow wheel-mouse scrolling
$cv->CanvasBind('<Button-4>', sub { $cv->yviewScroll(-1, 'units') }); $cv->CanvasBind('<Button-5>', sub { $cv->yviewScroll( 1, 'units') }); if (defined $hitdata) { $self->draw_scale($cv, $hitdata, 10, 100, 10); $self->draw_align($cv, $hitdata, 10, 100, 70, $interval, $hitcolours, $callbackbox); } $cv->configure(-scrollregion => [$cv->bbox("all")]); # All configuration options get passed to the canvas
$self->Advertise('Canvas' => $cv); $self->ConfigSpecs(DEFAULT => [$cv]); $self->Delegates(DEFAULT => $cv);
}
draw_aligndescriptionprevnextTop
sub draw_align {
    my ($self, $cv, $hitdata, $lmargin, $x, $y, $interval, $hitcolours, $callbackbox) = @_;

    # Each element represents a hit (Fasta hit or collections of Blast HSPs)
foreach (@$hitdata) { my $q_id = $_->{q_id}; my $s_id = $_->{s_id}; my $pc = $_->{score}; my $expect = $_->{expect}; my $overlap = $_->{overlap}; my $q_len = $_->{q_len}; my $s_len = $_->{s_len}; my $data = $_->{data}; my $text = $_->{text}; my $callback = $_->{callback}; my $width = 4; my $colour = 'black'; $q_id = "<query>" unless defined $q_id; $s_id = "<subject>" unless defined $s_id; $text = "" unless defined $text; # Set colour according to % identity
foreach (sort keys %$hitcolours) { if ($pc >= $_) { $colour = $hitcolours->{$_} } } # Truncate over-long subject names
if (length($s_id) > 10) { $s_id = substr($s_id, 0, 9) . "..." } # Create subject name labels
my $t = $cv->createText($lmargin, $y, -text => "$s_id", -anchor => 'w', -justify => 'left', -font => 'hv-n-small', -fill => 'blue'); # @$data is a list of list references to data of the form:
# [$q_start, $q_end, $s_start, $s_end]
# Here we sort by subject start position (index 2)
my @sorted = sort { $a->[2] <=> $b->[2] } @$data; # Mark in HSP/Hit lines, alternating HSPs up & down for clarity
my $down = 0; foreach (@sorted) { h_line($cv, $_, $x, $y, $width, $colour); if ($down) { $y -= 15; $down = 0} else { $y += 15; $down = 1} } # Do we need more space after HSPs?
my $spacer = 0; if (scalar @$data > 1) { $y += 20; $spacer = 15; # Correct HSP alternation
if ($down) { $y -= 15 } } $y += $interval; my $annotate = sub { annotate_hit($cv, $t, $text, $interval + $spacer, $callbackbox) }; push(@{$callbackbox->{annotate}}, $annotate); # Bind action to subject name labels
$cv->bind($t, '<Button-3>', $annotate); # Bind cursor change as a visual cue to click on the labels
$cv->bind($t, '<Enter>', sub { $cv->configure(-cursor => 'hand2') }); $cv->bind($t, '<Leave>', sub { $cv->configure(-cursor => 'left_ptr') }); # Bind user supplied callback to subject name labels
$cv->bind($t, '<Button-1>', $callback) if defined $callback; }
}
h_linedescriptionprevnextTop
sub h_line {
    my ($cv, $ref, $x, $y, $width, $colour) = @_;

    # Text indicates subject coordinates
$cv->createText($ref->[0] + $x, $y + 7, -text => $ref->[2], -justify => 'left', -font => 'hv-n-tiny'); $cv->createText($ref->[1] + $x, $y + 7, -text => $ref->[3], -justify => 'right', -font => 'hv-n-tiny'); $cv->createLine($ref->[0] + $x, $y, $ref->[1] + $x, $y, -width => $width, -fill => $colour);
}
draw_scaledescriptionprevnextTop
sub draw_scale {
    my ($self, $cv, $hitdata, $lmargin, $x, $y) = @_;

    # Draw subject line
my $q_id = $hitdata->[0]->{q_id}; my $len = $hitdata->[0]->{q_len}; # Truncate over-long query names
if (length($q_id) > 10) { $q_id = substr($q_id, 0, 9) . "..." } # Scale ticks are marked every $div residues
my $div = 50; my $ticks = sprintf("%d", $len / $div);
$ticks++ if $len % $div; # Blank scale line
$cv->createLine($x, $y, $x + $ticks * $div, $y, -width => 1, -fill => 'black'); # Ticks and labels
for (my $i = 0; $i <= $ticks; $i++) { $cv->createLine($x + $i * $div, $y, $x + $i * $div, $y + 5, -width => 1, -fill => 'black'); $cv->createText($x + $i * $div, $y + 10, -text => $i * $div + 1, -anchor => 'w', -justify => 'right', -font => 'hv-n-small'); } # Subject name
$cv->createText($lmargin, $y + 30, -text => "$q_id", -anchor => 'w', -justify => 'left', -font => 'hv-b-small'); # Subject line
$cv->createLine($x, $y + 30, $x + $len, $y + 30, -width => 4, -fill => 'green');
}
deannotate_hitdescriptionprevnextTop
sub deannotate_hit {
    my ($cv, $t, $text, $interval, $td, $td_ht) = @_;

    # Do nothing if the hit is already closed
return if ! grep /open/, $cv->gettags($t); # Delete the hit details and remove the 'open' tags
$cv->delete($td); my ($tx, $ty) = $cv->coords($t); $cv->dtag($t, 'open'); # Shuffle up canvas items below the hit title
foreach ($cv->find('all')) { my ($x, $y) = $cv->coords($_); $cv->move($_, 0, - $td_ht) if $y > $ty + $interval; } # Change the binding and colour of the closed hit
$cv->bind($t, '<Button-3>', [\&annotate_hit, $t, $text, $interval]); $cv->itemconfigure($t, -fill => 'blue'); $cv->configure(-scrollregion => [$cv->bbox('all')]);
}
annotate_hitdescriptionprevnextTop
sub annotate_hit {
    my ($cv, $t, $text, $interval, $callbackbox) = @_;

    # Do nothing if the hit is already open
return if grep /open/, $cv->gettags($t); # Mark this hit title as open
my ($tx, $ty) = $cv->coords($t); $cv->addtag('open', 'withtag', $t); # Insert hit details in the gap created
my $td = $cv->createText($tx + 100, $ty + $interval, -text => $text, -justify => 'left', -anchor => 'nw', -font => 'hv-n-small', -tags => 'working'); # Calculate the height of the newly added text. Movement
# is calculated with reference to the interval between hits
# plus this height
my @tdbox = $cv->bbox($td); my $td_ht = $tdbox[3] - $tdbox[1]; # Shuffle down any canvas items below the title but
# not the newly added text
foreach ($cv->find('withtag', '!working')) { my ($x, $y) = $cv->coords($_); $cv->move($_, 0, $td_ht) if $y > ($ty + $interval); } # Finished working on the added text
$cv->dtag($td, 'working'); my $deannotate = sub { deannotate_hit($cv, $t, $text, $interval, $td, $td_ht) }; push(@{$callbackbox->{deannotate}}, $deannotate); # Change the binding and colour of the open hit
$cv->bind($t, '<Button-3>', $deannotate); $cv->itemconfigure($t, -fill => 'black'); $cv->configure(-scrollregion => [$cv->bbox('all')]);
}
open_alldescriptionprevnextTop
sub open_all {
    my ($cv, $callbackbox) = @_;
    my $callbacks = $callbackbox->{annotate};

    foreach (@$callbacks) { &$_ }
}
close_alldescriptionprevnextTop
sub close_all {
    my ($cv, $callbackbox) = @_;
    my $callbacks = $callbackbox->{deannotate};

    foreach (@$callbacks) { &$_ }
}
scroll_markdescriptionprevnextTop
sub scroll_mark {
    my ($cv) = @_;
    my $e = $cv->XEvent;

    $cv->scanMark($e->x, $e->y);
}
scroll_dragdescriptionprevnextTop
sub scroll_drag {
    my ($cv, $sensit) = @_;
    my $e = $cv->XEvent;

    $cv->scanDragto($e->x, $e->y, $sensit);
}
General documentation
AUTHORTop
Keith James (kdj@sanger.ac.uk)
ACKNOWLEDGEMENTSTop
See Bio::PSU.pod
COPYRIGHTTop
Copyright (C) 2000 Keith James. All Rights Reserved.
DISCLAIMERTop
This module is provided "as is" without warranty of any kind. It
may redistributed under the same conditions as Perl itself.