# $Id: SeqCanvas.pm,v 1.9 2001/03/02 19:20:54 dblock Exp $ 
=head2 NAME

Bio::Tk::SeqCanvas.pm - Graphical display of SeqI compliant objects


=head2 AUTHORS

Mark Wilkinson (mwilkinson@gene.pbi.nrc.ca), David Block (dblock@gene.pbi.nrc.ca)
Plant Biotechnology Institute, National Research Council of Canada.
Copyright (c) National Research Council of Canada, October, 2000.

=head2 DISCLAIMER

Anyone who intends to use and uses this software and code acknowledges and
agrees to the following: The National Research Council of Canada (herein "NRC")
disclaims any warranties, expressed, implied, or statutory, of any kind or
nature with respect to the software, including without limitation any warranty
or merchantability or fitness for a particular purpose.  NRC shall not be liable
in any event for any damages, whether direct or indirect,
consequential or incidental, arising from the use of the software.

=head2 SYNOPSIS

 # To create a BioSeq map and return a handle to the map object:

 use Tk;
 Begin();
 MainLoop;

 sub Begin {

	# set up the Tk Windows
 	   my $MW = MainWindow = MainWindow->new (-title => "Map Of BioSeq Object");
 	   my $Frame = $MW->Frame()->pack(-side => 'top');
 	   my $lblSysMess = $MW->Label()->pack(-side => 'bottom', -fill => 'both');

 	# create a BioSeq object
 	   my $SIO = Bio::SeqIO->new(-file=> 'genbankfile.gb', -format => 'GenBank');
 	   my $SeqObj = $SIO->next_seq();

 	   my $axis_length = 800;  # how large I want the final map to be

 	# Draw the Map

 	   $MapObj = SeqCanvas->new(
			$axis_length,
			$Frame,
			$lblSysMess,
			$SeqObj,
			-orientation => 'vertical'
			label => 'primary_id');

 	# SeqCanvas returns object reference for success
 	# returns -1 for failed initiation - no $SeqObj supplied
 	# returns -2 for bad sequence object
 	# returns -3 sequence has length 0
 	# returns -4 if orientation is uninterpretable
 	# returns -5 if supplied frame object is not a TK::frame

 }


=head2 DESCRIPTION and ACKNOWLEDGEMENTS

Creates an interactive scalable/zoomable map of all features and
subfeatures of a Bio::SeqI compliant object. Basic functionality for
selecting single and multiple map objects is inherent in the object
itself: left-mouse click to select, SHIFT-left-mouse to select
multiple. All other Tk Events are passed back up to the MainWindow
object and can be trapped/bound by the user as they see fit.  Colors
and axis-offsets of mapped objects are assigned based on the "source"
tag of the feature object. These are assigned "on the fly" based on
whatever is contained in the BioSeq object provided.

This module requires an updated version of Gregg Helt's original
BioTkPerl modules(version 0.81) which are available from BioPerl.  The
original BioTkPerl (version 0.80) is Copyright (c) Gregg Helt, 1995;
Version 0.81 was generated by Mark Wilkinson, PBI-NRC, Oct., 2000.

Zooming routines/events in this module are conceptually based on the
Zoom routines from Genotator (Copyright (c) 1996, The Regents of the
University of California.  Harris, N.L. (1997), Genome Research
7(7):754-762)

=head2 CONTACT

Mark Wilkinson (mwilkinson@gene.pbi.nrc.ca) and Dave Block (dblock@gene.pbi.nrc.ca)

=head2 APPENDIX

Description of Object tags, SeqCanvas Methods, and trapping Mouse events.

=head2 Object Tags:

Each map-widget has several "reliable" tags attached to it. These tags
are FIDxxxx, Source and Strand, Type, and Canvas, where:

=over

=item *

FIDxxxx is the unique identifier for that particular map-widget over all maps (even in multiple windows)

=item *

Source is derived from the "source" tag of the SeqFeature object this widget represents

=item *

Strand is derived from the "strand" tag of the SeqFeature object, converted into the GFF standard of +/-/. to represent the three possible strand values.

=item *

Type isthe feature type, derived from the primary_tag of the SeqFeature object

=item *

Map is either 'draft' or 'finished' to represent an object on the white or blue maps respectively

=back

So for example, a map widget might have the tags :

	FID22354 (no space)
	Source GeneMarkHMM (single space separated)
	Strand + (single space separated)
	Type exon ( " )
	Canvas draft ( " )

If your BioSeq Features are being derived from an external database,
it is possible to also include the unique index number of that
database entry as a fourth tag on the associated map-widget. To do so,
create your SeqFeature objects with an additional tag "id", where the
unique databse index number is the value of this tag. This index
number is then attached to the widget as a fourth tag with the form:

	DB_ID xxxxx (x's represent the unique index value)

The values of these three/four tags can be retrieved for any selected
object using the getSelectedTags function (see below) in order to
relate mapped objects back to their original database entries.  Using
the selectWithTag or recolorWithTag routines (see below) requires that
you pass the **full tag** as the desired selection (eg. pass "Source
GeneMarkHMM" not just "GeneMarkHMM")

=cut


package Bio::Tk::SeqCanvas;
use strict;
use Tk;
use Carp;
use Bio::Tk::AnnotMap;
use Tk::widgets qw(ColorEditor);
use Bio::SeqI;
use vars qw(@ISA $AUTOLOAD);
require Bio::Tk::BioTkPerl8_1;        # requires version 0.81 of Gregg Helt's Bio::TkPerl (can be obtained from BioPerl website)
				      # note that this is NOT the version available directly from Berkeley!!

Tk::Widget->Construct('SeqCanvas');


@ISA=qw(Bio::Tk::AnnotMap Bio::SeqI);

$Bio::Tk::SeqCanvas::VERSION='1.0';

{
	#Encapsulated class data
#Encapsulated class data for a SeqCanvas
	my %colordef = (
		magenta => '#ee00ee',
		fuschia => '#ff00cc',
		red => '#ff1100',
		pink => '#ffdddd',
		orange => '#ffaa00',
		yellow => '#eed007',
		purple => '#bb00ff',
		darkblue => '#3300ee',
		lightblue => '#99bbee',
		turquoise => '#00ddcc',
		green => '#11dd11',
		chartreuse => '#aacc00',
		yellowgreen => '#669900',
		black => '#000000',
		brown => '#994444',
		dkgreen => '#00aa00',
		ltgreen => '#ddffdd',
	 );
	 my @colorlist = qw(darkblue magenta dkgreen fuschia orange purple chartreuse lightblue yellowgreen turquoise green yellow brown ltgreen);
	
	
	#___________________________________________________________
	#ATTRIBUTES
    my %_attr_data = #     				DEFAULT    	ACCESSIBILITY
                  (	xa			=>  [0,           	'read/write'],
                  	ya  		=>  [0,           	'read/write'],
            	  	xb  		=>  [0,         	'read/write'],
            	  	yb  		=>  [0,         	'read/write'],
                  	-axis_loc  	=>  [0,           'read/write'],	
			-labelfont 	=> 	['TimesNewRoman 10 normal',		'read/write'],
			-range		=>  [undef,			'read/write'],
			label		=>  [undef, 		'read/write'],       # if this is defined then this is the Feature tag used to write labels on mapped objects
			ScrollBar   =>  [undef, 		'read/write'],
			ZoomBar     =>  [undef, 		'read/write'],
			FinishedMap	=> 	[undef,			'read/write'],
			DraftMap 	=> 	[undef,			'read/write'],
			MapSeq		=>	[undef,			'read/write'],
			MapFrame	=>	[undef,			'read/write'],
			ZoomFrame	=>	[undef,			'read/write'],
			ScrollFrame =>  [undef, 		'read/write'],
			DraftCanvas	=>	[undef,			'read/write'],
			FinishedCanvas	=>	[undef,			'read/write'],
			AnnotTextFrame  =>  [undef, 		'read/write'],  # as below
			AnnotTextCanvas =>  [undef, 		'read/write'],	# this is not used directly in SeqCanvas, but can be used by external routines to generate a third frame containing textual information beside the annotatinos (a la AceDB)
			AnnotTextMap    =>  [undef, 		'read/write'],  # as above
			DraftLabelCanvas	=>	[undef,			'read/write'],
			FinishedLabelCanvas	=>	[undef,			'read/write'],
			#colors =>	[undef,            'read/write'],  # the colors for each feature type; key = source, value = color from colors hash
			#offsets =>	[undef,            'read/write'],  # the offset for each feature type; key = source, value = offset from axis
			FinishedSources =>	[undef,            'read/write'],  # the list of genefinder sources to be mapped (one per row)
			DraftSources =>	[undef,            'read/write'],  # the list of genefinder sources to be mapped (one per row)
			colordefs =>	[\%colordef,        'read'],
            		colorlist => 	[\@colorlist, 		'read'],
            		zoom_triggers =>[{},			'read/write'],
            		min_zoom	 =>[1,			'read/write'],
            		max_zoom	 =>[2,			'read/write'],
            		zoom_ratio =>[1,			'read/write'],
            		zoom_level =>[0,			'read/write'],
            		current_loc =>[1,			'read/write'],
            		finished_total_offset =>[undef,			'read/write'],   #the largest offset for the finished map
            		draft_total_offset =>[undef,			'read/write'],   # the largest offset for the draft map
            		actual_total_offset=>[undef,			'read/write'],   # the larger of the two above (becomes the width of both maps)
            		-orientation =>  ['horizontal',			'read/write'],
            		FeatureID	=>  [0,           	'read/write'],    # this is a simple incremental counter to assign each on-map object its index within the list of $feature objects in $self->IndexedFeatureList
            		whitespace => [20, 				'read'],           # whitespace is the distance between the axis and the first widget; the default never changes
                  	IndexedFeatureList => [[],			'read/write'],    # to compensate for Tk:;Canvas not being able to have a $reference as a tag element we put all $features into a list, and have the list index as a widget tag to associate widgets and their corresponding feature objects
                  	SysMess => [undef, 				'read/write'],        # this is an (optional) handle back out to a label on the top level window to send system messages
                  	dragx1  => [undef, 				'read/write'],
                  	dragy1  => [undef, 				'read/write'],
                  	dragx2  => [undef, 				'read/write'],
                  	dragy2  => [undef, 				'read/write'],
                  );

	my $_nextid=0;
	my $_nextoffset = 2;
    my %offsets;
    my %colors;
    my $_color_pos = 0;
    #_____________________________________________________________
    #METHODS, to operate on encapsulated class data

    # Is a specified object attribute accessible in a given mode
    sub _accessible  {
	my ($self, $attr, $mode) = @_;
	$_attr_data{$attr}[1] =~ /$mode/
    }

    # Classwide default value for a specified object attribute
    sub _default_for {
	my ($self, $attr) = @_;
	$_attr_data{$attr}[0];
    }

    # List of names of all specified object attributes
    sub _standard_keys {
	keys %_attr_data;
    }

    sub colorlist {
    	return @colorlist
    }
    sub colordef {
    	return %colordef
    }

    sub MapArgs {
    	my ($self) = @_;
    	my %_map_args;
    	foreach my $key ($self->_standard_keys) {
    		
    		if ($key =~ /^-/) {
    			#print $key . "\n";
    			$_map_args{$key} = $self->{$key};
    		}
    	}
    	return %_map_args;
    }

    sub next_id {
		return $_nextid++;
    }
    sub next_offset {
    	return $_nextoffset++;     # in this case increment it
    }
    sub offset_pointer {
    	return $_nextoffset;       # in this case just send it as it is
    }
    sub current_offsets {
    	return \%offsets;
    }
    sub current_colors {
    	return \%colors;
    }
    sub next_colorpos {
        my $pos = $_color_pos;
        ++$_color_pos;
        if (!$colorlist[$_color_pos]){$_color_pos = 0}    # if we are beyond the end of the colorlist then return the pointer to zero
        return $pos;
    }


}

sub subseq {
    my ($self,@args)=@_;
    return $self->MapSeq->subseq(@args);
}

sub start {return $_[0]->MapSeq->start; }
sub end   {return $_[0]->MapSeq->end;   }

sub DESTROY {}

sub AUTOLOAD {
    no strict "refs";
    my ($self, $newval) = @_;

    $AUTOLOAD =~ /.*::(\w+)/;

    my $attr=$1;
    if ($self->_accessible($attr,'write')) {

	*{$AUTOLOAD} = sub {
	    if ($_[1]) { $_[0]->{$attr} = $_[1] }
	    return $_[0]->{$attr};
	};    ### end of created subroutine

###  this is called first time only
	if ($newval) {
	    $self->{$attr} = $newval
	}
	return $self->{$attr};

    } elsif ($self->_accessible($attr,'read')) {

	*{$AUTOLOAD} = sub {
	    return $_[0]->{$attr} }; ### end of created subroutine
	return $self->{$attr}  }


    # Must have been a mistake then...
    croak "No such method: $AUTOLOAD";
}


#__________________________________________________________________________________
# Object Methods
#__________________________________________________________________________________

=pod

=head2 METHODS

=head2 new

 Title    : new
 Usage    : $MapObj= SeqCanvas->new(
				$axis_length,
				$Frame,
				[$lblSysMess | undef],
				$SeqObj,
				-orientation => ['horizontal'|'vertical']
				[, label => $tag])
				
 Function : create a map from the Feature object provided
 Returns  : Handle to the Map object
 Args     :
	    axis_length in pixels,
	    a Tk::Frame object,
	    a Tk::Label or undef,
	    a BioSeqI compliant object,
	    the orientation for the map,
	    optionally the SeqFeature tag you wish to 
               use as the label

=cut

sub new {
    # returns object reference for success	
    # returns -1 for failed initiation - no $SeqObj supplied
    # returns -2 for wrong object type - must be (ISA) SeqI Sequence object
    # returns -3 sequence  has length 0
    # returns -4 if orientation is uninterpretable
    # returns -5 if supplied frame object is not a TK::frame

    # the reference to TOP in the next line is the top-level TK window.
    # if this is passed as 'defined' then a Tk::Label object with the name
    # lblSysMess ***MUST*** exist in this window to receive output
    # messages from this module.  If $TOP is undefined this feature is disabled.
    my ($caller, $window_length, $frame, $TOP, $SeqObj, %args) = @_;


    my $caller_is_obj = ref($caller);
    my $class = $caller_is_obj || $caller;

    # check incoming data for validity
    if (!$SeqObj){return -1}
    if (!$SeqObj->isa("Bio::SeqI")) {return -2}
    if ($SeqObj->length == 0) {return -3}
    if (!$frame->isa("Tk::Frame")){return -5}

    #Create Object
    my $self = bless {}, $class;

    foreach (keys %args) {
        foreach my $attrname ( $self->_standard_keys ) {
	    if (exists $args{$attrname}) {
		$self->{$attrname} = $args{$attrname} }
	    elsif ($caller_is_obj) {
		$self->{$attrname} = $caller->{$attrname} }
	    else {
		$self->{$attrname} = $self->_default_for($attrname) }
        }
    }


    if ($args{-orientation}) {
	if ($args{-orientation} =~ /h/i) {$self->{-orientation} = "horizontal"}
	elsif ($args{-orientation} =~ /v/i) {$self->{-orientation} = "vertical"}
	else {return -4}
    }

    $self->SysMess($TOP);	# a handle out to the top-level window system for passing messages

    # the sub-frame to hold the zoom-bar
    $self->ZoomFrame($frame->Frame->pack(-side => 'bottom', -fill => 'x'));
    if ($self->{-orientation} eq "horizontal"){
    	$self->ScrollFrame($frame->Frame->pack(-side => 'bottom', -fill => 'x'));
    } else {
    	$self->ScrollFrame($frame->Frame->pack(-side => 'right', -fill => 'y'));
    }
    $self->MapFrame($frame->Frame->pack(-side => 'top')); # the sub-frame to hold the two maps

    # assign some additional values required by the Canvas and AnnotMap
    # ***************** TEMPORARY HACK
    # this should be changed later to make SeqCanvas a real Sequence object
    $self->MapSeq($SeqObj);  
    # *******************************
    # - This line ensures that the sequences fills the allocated space.
    $self->{-range} = [0, ($SeqObj->length)];   	

    # - This line sets the "width" (relative to H/V orientation) of the map 
    # and is dependant on the number of different feature types

    _prepareSeqFeatures($self);



    # within this routine the features are counted and assigned
    # colors and offsets from the map axis.  the width of each is
    # thus double (plus strand and minus strand) the largest axis
    # offset of a feature the largest offset value is stored in
    # $self->total_offset
    # ************************************************************
    # ***********************************************************

    #print $SeqObj->length;												
    # Create the MapCanvases with correct dimensions

    # to make things clearer in the next routine here we figure
    # out which of the two maps is the "wider" and make the
    # default width for both maps equal to this value the "width"
    # of a map depends on how many rows of different features are
    # displayed - i.e. its total offset

    my $map_width = ($self->draft_total_offset > 
		     $self->finished_total_offset) ? $self->draft_total_offset : 
			 $self->finished_total_offset;

    $self->actual_total_offset($map_width); # set this for use in the _boxSelectedExon routine

    if ($self->{-orientation} eq "horizontal") {
	my $DLF = $self->MapFrame->Frame->pack(-side => 'top');	# frame for Draft map and labels
	my $FLF = $self->MapFrame->Frame->pack(-side => 'top');	# frame for Finished map and labels
	$self->DraftLabelCanvas($DLF->Canvas(-width => 100, -height => $map_width, -background => "#ffffff")->pack(-side => 'left', -fill => 'both'));
	$self->FinishedLabelCanvas($FLF->Canvas(-width => 100, -height => $map_width, -background => "#eeeeff")->pack(-side => 'left', -fill => 'both'));
	$self->DraftCanvas($DLF->Canvas(-width => $window_length, -height => $map_width, -background => "#ffffff")->pack(-side => 'left', -fill => 'both'));
	$self->FinishedCanvas($FLF->Canvas(-width => $window_length, -height => $map_width, -background => "#eeeeff")->pack(-side => 'left', -fill => 'both'));


# it would be nice to have the option to clear all selections by
# clicking elsewhere on the canvas, but because of the binding order
# (and the fact that the canvas itself responds to a click event on a
# widget) # the act of selecting a widget would cause this event to
# also be triggered...

	#$self->FinishedCanvas->Tk::bind("<Button-1>", sub {clearSelections($self)});
	#$self->DraftCanvas->Tk::bind("<Button-1>", sub {clearSelections($self)});

	$self->yb($map_width);  # each map is half of the height of a horizontal
	$self->{-axis_loc} = (($self->yb)/2); #/   # axis goes half-way through the map on the Y axis
	$self->xb($window_length); # height is unchanged

	my $s = $self->ScrollFrame->Scrollbar('-orient' => 'horizontal', '-command' => sub {$self->FinishedCanvas->xview(@_); $self->DraftCanvas->xview(@_)});
    	$self->DraftCanvas->configure('-xscrollcommand' => ['set' => $s] ); # since they are identical only one canvas needs to feed-back to the scroll bar to show it's extents
     	$s->pack('-side'=>'bottom', '-fill'=>'x', '-expand' => 'x');
        $self->ScrollBar($s);
    } else {			# vertical
	my $DLF = $self->MapFrame->Frame->pack(-side => 'left'); # frame for Draft map and labels
	my $FLF = $self->MapFrame->Frame->pack(-side => 'left'); # frame for Finished map and labels
	$self->DraftLabelCanvas($DLF->Canvas(-width => $map_width, -height => 100, -background => "#ffffff")->pack(-side => 'top', -fill => 'both'));
	$self->FinishedLabelCanvas($FLF->Canvas(-width => $map_width, -height => 100, -background => "#eeeeff")->pack(-side => 'top', -fill => 'both'));
	$self->DraftCanvas($DLF->Canvas(-width => $map_width, -height => $window_length, -background => "#ffffff")->pack(-side => 'top', -fill => 'both'));
	$self->FinishedCanvas($FLF->Canvas(-width => $map_width, -height => $window_length, -background => "#eeeeff")->pack(-side => 'top', -fill => 'both'));
	$self->xb($map_width);  # each map is half of the width of a vertical
	$self->{-axis_loc} = (($self->xb)/2); #/   # axis goes half-way through the map on the X axis
	$self->yb($window_length); # height is unchanged

	my $s = $self->ScrollFrame->Scrollbar('-orient' => 'vertical', '-command' => sub {$self->FinishedCanvas->yview(@_); $self->DraftCanvas->yview(@_)});
    	$self->DraftCanvas->configure('-yscrollcommand' => ['set' => $s] );
    	$s->pack('-side'=>'right', '-fill'=>'y', '-expand' => 'y');
    	$self->ScrollBar($s);
    }		

    $self->DraftCanvas->Tk::bind('<Enter>', sub { $self->DraftCanvas->Tk::focus; } ); # set focus on the appropriate map when mouse enters
    $self->FinishedCanvas->Tk::bind('<Enter>', sub { $self->FinishedCanvas->Tk::focus; } ); # the space

    # and now create the maps
    $self->FinishedMap($self->FinishedCanvas->AnnotMap($self->xa, $self->ya, $self->xb, $self->yb, $self->MapArgs));
    $self->DraftMap($self->DraftCanvas->AnnotMap($self->xa, $self->ya, $self->xb, $self->yb, $self->MapArgs));

    _setupAxes($self);		# draw the axis on the two maps


    # now we have to deal with the elements of the ZOOM
    my $zoomlabel = $self->ZoomFrame->Label(-text => "Zoom")->pack(-side => 'left');

    $self->min_zoom($self->DraftMap->{scale_factor}); # the original maps display the entire sequence, therefore this is the minimum level of zoom
    $self->max_zoom(2);		# this is somewhat arbitrary...
    my $min_scroll = 0;
    my $max_scroll = 100;
    $self->zoom_ratio( ($self->max_zoom - $self->min_zoom)/($max_scroll - $min_scroll)); #/

    my $zoom_scale_length = ($self->{-orientation} eq 'horizontal')?$window_length:$map_width; # the zoom-scale spans the horizontal bottom of the window,
    # the length of which depends on the orientation of the map
    my $zoomscale = $self->ZoomFrame->Scale(-orient => 'horizontal',
					    -sliderlength => 25,
					    -length => $zoom_scale_length - 80,	# the 80 pixels compensates for the "Zoom" label beside the widget
					    -width => 10,
					    -from => 0,
					    -to => 100,
					    -showvalue => 0,
					    -variable => \$self->{zoom_level},
					    -command => sub {$self->DoZoom()} );
    $zoomscale->pack(-side => 'left', -expand => 'yes', -fill => 'x', -anchor => 'e');    	
    $self->ZoomBar($zoomscale);

    # now that everything is setup, go ahead and draw the features
    _drawTopLevelFeatures($self);
    _drawSubFeatures($self);
    _bindMultiSelection($self);

    return $self;		# return the handle

}

sub _bindMultiSelection {

    my ($self) = @_;
    # the line below converts the x/y coordinates of the event into the canvas coordinates
    $self->DraftCanvas->Tk::bind("<ButtonPress-1>" => 
				 [ sub { shift;
					 $self->dragx1($self->DraftCanvas->canvasx(shift)); 
					 $self->dragy1($self->DraftCanvas->canvasy(shift))}, 
				   Ev('x'), Ev('y')]);   
    $self->DraftCanvas->Tk::bind("<B1-Motion>" => 
				 [sub {	shift; 
					my $tx2 = shift; my $ty2 = shift;
                                        # the x1/y1 are stored during the button-press event above
					my ($x1, $y1) = ($self->dragx1, $self->dragy1);	
                                        # convert the global x/y coordinate to the canvas x/y coords
					my $x2 = $self->DraftCanvas->canvasx($tx2); 
					my $y2 = $self->DraftCanvas->canvasy($ty2);
                                        # delete existing boxse
					$self->DraftCanvas->delete("withtag", "multi_box"); 
					$self->FinishedCanvas->delete("withtag", "multi_box"); #  "
                                        # create a new one
					$self->DraftCanvas->createRectangle($x1, $y1, $x2, $y2, 
									    -tags => "multi_box"); 
				    },
                                  # as parameters send the global x/y coordinates of the event
				  Ev('x'), Ev('y')] 
				 );

    $self->DraftCanvas->Tk::bind("<ButtonRelease-1>" => 
				 [sub {	shift; 
					$self->dragx2($self->DraftCanvas->canvasx(shift)); 
					$self->dragy2($self->DraftCanvas->canvasy(shift));
					my ($x1, $x2, $y1, $y2) = ($self->dragx1, 
								   $self->dragx2, 
								   $self->dragy1, $self->dragy2);
					if ($x1 > $x2){($x1, $x2) = ($x2, $x1)}
					if ($y1 > $y2){($y1, $y2) = ($y2, $y1)}
					if (($x2-$x1 < 10 )||($y2 - $y1 < 10)) { # set sensitivity
                                            # delete existing boxes
					    $self->DraftCanvas->delete("withtag", "multi_box");	
					    $self->FinishedCanvas->delete("withtag", "multi_box"); #  "
					    return;
					}
					$self->clearSelections;
					$self->DraftCanvas->delete("withtag", "multi_box");
					$self->FinishedCanvas->delete("withtag", "multi_box");
					$self->DraftCanvas->addtag("group_select", "overlapping", 
								   $x1, $y1, $x2, $y2);
					$self->selectWithTag(["group_select"], 'draft');
					$self->DraftCanvas->dtag("all", "group_select");	
				    },
				  Ev('x'), Ev('y')]
				 );

    $self->FinishedCanvas->Tk::bind("<ButtonPress-1>" => 
				    [sub { shift;
					   $self->dragx1($self->DraftCanvas->canvasx(shift)); 
					   $self->dragy1($self->DraftCanvas->canvasy(shift))},
				     Ev('x'), Ev('y')]);

    $self->FinishedCanvas->Tk::bind("<B1-Motion>" => 
				    [sub { shift; 
					   my $tx2 = shift; my $ty2 = shift;
					   my ($x1, $y1) = ($self->dragx1, $self->dragy1);
					   my $x2 = $self->FinishedCanvas->canvasx($tx2);
					   my $y2 = $self->FinishedCanvas->canvasy($ty2);
					   $self->DraftCanvas->delete("withtag", "multi_box");
					   $self->FinishedCanvas->delete("withtag", "multi_box");
					   $self->FinishedCanvas->createRectangle($x1, $y1,$x2, 
										  $y2, -tags => "multi_box");
				       },
				     Ev('x'), Ev('y')]
				    );

    $self->FinishedCanvas->Tk::bind("<ButtonRelease-1>" => 
				    [sub {shift; 
					  $self->dragx2($self->FinishedCanvas->canvasx(shift)), 
					  $self->dragy2($self->FinishedCanvas->canvasy(shift));
					  my ($x1, $x2, $y1, $y2) = ($self->dragx1, 
								     $self->dragx2, $self->dragy1, 
								     $self->dragy2);
					  if ($x1 > $x2){($x1, $x2) = ($x2, $x1)}
					  if ($y1 > $y2){($y1, $y2) = ($y2, $y1)}
					  if (($x2-$x1 < 10 )||($y2 - $y1 < 10)) { # set sensitivity
                                              # delete existing boxes
					      $self->DraftCanvas->delete("withtag", "multi_box"); 
					      $self->FinishedCanvas->delete("withtag", "multi_box"); #  "
					      return;
					  }
					  $self->clearSelections;
					  $self->DraftCanvas->delete("withtag", "multi_box");
					  $self->FinishedCanvas->delete("withtag", "multi_box");
					  $self->FinishedCanvas->addtag("group_select", 
									"overlapping", $x1, $y1, 
									$x2, $y2);
					  $self->selectWithTag(["group_select"], 'finished');
					  $self->FinishedCanvas->dtag("all", "group_select");	
				      },
				     Ev('x'), Ev('y')]
				    );
}
sub _setupAxes {
    my ($self)=@_;
    my $draftmap = $self->DraftMap;            # set references to keep code clearer
    my $finishedmap = $self->FinishedMap;
    my $draftc = $self->DraftCanvas;
    my $finishedc = $self->FinishedCanvas;
    my $seqlength = $self->MapSeq->length;

    # Set up axis
    $draftmap->   MapAxis('-color' => 'black', '-ticks' => 5000, '-scale' => 1000,
			  -tags => 'axis1', -axis_start => 0);
    $finishedmap->MapAxis('-color' => 'black', '-ticks' => 5000, '-scale' => 1000,
			  -tags => 'axis1', -axis_start => 0);

#    else {
#    	$draftmap->   MapAxis('-color' => 'black', '-ticks' => 1000, '-scale' => 1000,
#			      -axis_start => 0);
#    	$finishedmap->MapAxis('-color' => 'black', '-ticks' => 1000, '-scale' => 1000,
#			      -axis_start => 0);

### AXIS 2
    $draftmap->   MapAxis('-ticks' => 2500, '-scale'=> 1000, '-offset' => 9999,
			  '-tags' => 'axis2', -axis_start => 0);
    $finishedmap->MapAxis('-ticks' => 2500, '-scale'=> 1000, '-offset' => 9999,
			  '-tags' => 'axis2', -axis_start => 0);
### AXIS 3
    $draftmap->   MapAxis('-ticks' => 1000, '-scale'=> 1000, '-offset' => 9999,
			  '-tags' => 'axis3', -axis_start => 0);
    $finishedmap->MapAxis('-ticks' => 1000, '-scale'=> 1000, '-offset' => 9999,
			  '-tags' => 'axis3', -axis_start => 0);
### AXIS 4
    $draftmap->   MapAxis('-ticks' => 100, '-scale'=> 1, '-offset' => 9999,
			  '-tags' => 'axis4', -axis_start => 0);
    $finishedmap->MapAxis('-ticks' => 100, '-scale'=> 1, '-offset' => 9999,
			  '-tags' => 'axis4', -axis_start => 0);


    # zoom-triggering is an idea from Nomi Harris in her Genotator program
    # we changed the structure of the zoom triggers to make them "perlish"
    # by putting them in a hash, but the fundamental concept is Nomi's.  The idea is that
    # several axes are drawn on the canvas with different frequencies of ticks,
    # but most are drawn outside of the visible canvas area.
    # During the zoom in/out events these "hidden" axes are shifted
    # into and out of the visible area (by a canvas->move call)
    # note that these axes are **independent objects** relative to the Bio::Tk_Map Axis object.
    # i.e. you are not changing the Bio::Tk map axis when you call "move"  you are
    # simply shifting the position of a line-with-ticks-and-labels object
    # that has been given the tag "axis2" or whatever...

    my %zoom_triggers = (hin=>{	0.015	=> sub {$draftc   ->move('axis1', 0,-9999);
						$finishedc->move('axis1', 0,-9999);
						$draftc   ->move('axis2', 0, 9999);
						$finishedc->move('axis2', 0, 9999);
					    },

				0.07	=> sub {$draftc   ->move('axis3', 0, 9999);
						$finishedc->move('axis3', 0, 9999);
					    },

				0.5	=> sub {$draftc   ->move('axis4', 0, 9999);
						$draftc   ->move('axis3', 0,-9999);
						$draftc   ->move('axis2', 0,-9999);
						$finishedc->move('axis4', 0, 9999);
						$finishedc->move('axis3', 0,-9999);
						$finishedc->move('axis2', 0,-9999);
					    }},

			 hout=>{ 0.015	=> sub {$draftc   ->move('axis1', 0, 9999);
						$finishedc->move('axis1', 0, 9999);
				                $draftc   ->move('axis2', 0,-9999);
						$finishedc->move('axis2', 0,-9999);
					    },

				 0.07	=> sub {$draftc   ->move('axis3', 0,-9999);
						$finishedc->move('axis3', 0,-9999);
					    },

				 0.5  	=> sub {$draftc   ->move('axis4', 0,-9999);
						$draftc   ->move('axis3', 0, 9999);
						$draftc   ->move('axis2', 0, 9999);
						$finishedc->move('axis4', 0,-9999);
						$finishedc->move('axis3', 0, 9999);
						$finishedc->move('axis2', 0, 9999);
					    }},

			 vin=>{	0.015	=> sub {$draftc   ->move('axis1', -9999,0);
						$finishedc->move('axis1', -9999,0);
						$draftc   ->move('axis2',  9999,0);
						$finishedc->move('axis2',  9999,0);
					    },

				0.07	=> sub {$draftc   ->move('axis3',  9999,0);
						$finishedc->move('axis3',  9999,0);
					    },

				0.5	=> sub {$draftc   ->move('axis4',  9999,0);
						$draftc   ->move('axis3', -9999,0);
						$draftc   ->move('axis2', -9999,0);
						$finishedc->move('axis4',  9999,0);
						$finishedc->move('axis3', -9999,0);
						$finishedc->move('axis2', -9999,0);
					    }},

			 vout=>{0.015	=> sub {$draftc   ->move('axis1',  9999,0);
						$finishedc->move('axis1',  9999,0);
						$draftc   ->move('axis2', -9999,0);
						$finishedc->move('axis2', -9999,0);
					    },

				0.07	=> sub {$draftc   ->move('axis3', -9999,0);
						$finishedc->move('axis3', -9999,0);
					    },

				0.5  	=> sub {$draftc   ->move('axis4', -9999,0);
						$draftc   ->move('axis3',  9999,0);
						$draftc   ->move('axis2',  9999,0);
						$finishedc->move('axis4', -9999,0);
						$finishedc->move('axis3',  9999,0);
						$finishedc->move('axis2',  9999,0);
					    }}
			);

    $self->zoom_triggers(\%zoom_triggers);

}

sub DoZoom  {	
    # this is also based conceptually on Nomi Harris' Genotator code
    #  DoZoom provides an extra layer of abstraction above the actual
    #  zooming, to allow for scale-triggered features.
    # we modified the code somewhat, but you will still be able
    # to recognize the basic structure of the DoZoom event
    # as coded in Genotator.

    my ($self)=@_;
    my ($desired_scale,$zoom_ratio,$min_zoom,$max_zoom, $triggers) = ($self->zoom_level,$self->zoom_ratio, $self->min_zoom, $self->max_zoom, $self->zoom_triggers);
    
    my $draftmap = $self->DraftMap;           # set up easy references
    my $finishedmap = $self->FinishedMap;
    my $draftc = $self->DraftCanvas;
    my $finishedc = $self->FinishedCanvas;
    my ($annotmap);
    if ($self->AnnotTextMap){$annotmap = $self->AnnotTextMap}
    my ($pre_scale_factor, $post_scale_factor,
       $trigger_point, $coderef, $trigger_struct);

    my $current_loc = $self->current_loc;     # the location of the last clicked widget

    $draftc->delete('selection_box');           # since boxes don't zoom they have to be deleted
    $draftc->dtag('selected');                  # along with corresponding "selected" tags
    $finishedc->delete('selection_box');
    $finishedc->dtag('selected');

    $pre_scale_factor = $draftmap->{scale_factor};   # should be the same for both maps... if not, then the whole shebang is buggered!

    my $normalized_desired_scale = (($desired_scale/100)**2)*100*$zoom_ratio + $min_zoom;

    my $zoom_factor = $normalized_desired_scale/$pre_scale_factor;

    # HERE IS WHERE THE AnnotMap::Zoom SUBROUTINE IS CALLED
    # ******************************************************
    $draftmap->Zoom($zoom_factor, $current_loc);
    $finishedmap->Zoom($zoom_factor, $current_loc);
    if ($annotmap) {$annotmap->Zoom($zoom_factor, $current_loc)};
    # *****************************************************

    my %triggs = %{$triggers};
    $post_scale_factor = $draftmap->{scale_factor};

    if ($zoom_factor > 1) {	# Zoom in	
    	if ($self->{-orientation} eq "horizontal"){
	    foreach my $scale_threshold (keys %{$triggs{hin}}) {
		if ($pre_scale_factor  <  $scale_threshold &&
		    $post_scale_factor >= $scale_threshold) {
		    &{$triggs{hin}{$scale_threshold}};
		}
	    }
    	} else {
	    foreach my $scale_threshold (keys %{$triggs{vin}}) {
		if ($pre_scale_factor  <  $scale_threshold &&
		    $post_scale_factor >= $scale_threshold) {
		    &{$triggs{vin}{$scale_threshold}};
		}
	    }
    	}
    }

    elsif ($zoom_factor < 1)  {    # Zoom out	
    	if ($self->{-orientation} eq "horizontal"){
         	foreach my $scale_threshold (keys %{$triggs{hout}}) {
         	    if ($post_scale_factor <  $scale_threshold &&
         	        $pre_scale_factor  >= $scale_threshold) {
         		&{$triggs{hout}{$scale_threshold}};
       	    	}
    		}
    	} else {
         	foreach my $scale_threshold (keys %{$triggs{vout}}) {
         	    if ($post_scale_factor <  $scale_threshold &&
         	        $pre_scale_factor  >= $scale_threshold) {
         		&{$triggs{vout}{$scale_threshold}};
       	    	}
    	    }
    	}
    }
}

sub _prepareSeqFeatures {

    my ($self) = @_;
    # ******** TOP LEVEL FEATURES *****************
    my $TOP = $self->SysMess;
    if ($TOP){$TOP->configure(-text => "preparing Seq Features"); $TOP->update}

    my @features = $self->MapSeq->top_SeqFeatures; # first the top level features
    my @Finishedsources;
    if ($TOP){$TOP->configure(-text => "Extracting Source tags"); $TOP->update}

    # this extracts the "source" tag from each feature,
    push @Finishedsources, ("gene", _extract_sources(@features)); 

    # Because of the way BioPerl parses genbank we filter out the
    # "gene" features in the _extract_sources routine because even
    # exons are called "genes" so the whole terminology becomes
    # meaningless... that's why we add this feature-type back in here
    # as an exclusively top-level feature

    # make variable to temporarily hold the sources for each subfeature
    my @tempsources;		
    foreach my $feature(@features){
        # now take the sub-features from each top-level feature
    	my @subfeatures = $feature->sub_SeqFeature; 
        # extract the source names from all subfeatures
    	my @tempsources = _extract_sources(@subfeatures); 
    	my $flag;
    	foreach my $tempsource(@tempsources){ # check each one in turn
	    $flag = 0;
            # to see if it exists in the list of Finished sources we already know
	    foreach my $source(@Finishedsources){ 
		if ($tempsource eq $source) {$flag = 1}
	    }
	    if ($flag == 0) {push @Finishedsources, $tempsource} # and if not, then add it.
	}
    }

    if ($TOP){$TOP->configure(-text => "Assigning Colors to top-level Sources"); $TOP->update}
    _assign_colors($self, @Finishedsources); # assign a unique color to each source
    if ($TOP){$TOP->configure(-text => "Assigning Offsets to top-level Sources"); $TOP->update}
    $self->{finished_total_offset} = _assign_offsets($self, @Finishedsources); # assign a unique axis-offset to each source
    $self->FinishedSources(\@Finishedsources); # stick the list into the $self object to make it easy to get to


    # ********** SUB FEATURES ******************
    # this call returns all features, including top-level "gene" features
    @features = $self->MapSeq->all_SeqFeatures;	
    my @Draftsources;
    # we need an additional class "hand-annotation" to deal with modified exons
    push @Draftsources, ("EST", _extract_sources(@features), "hand_annotation",); 
    # so we don't bugger-up primary data
    # and another class EST to deal with features that are not really part of the sequence 
    # we are displaying.
    if ($TOP){$TOP->configure(-text => "Assigning Colors to sub-level Sources"); $TOP->update}
    _assign_colors($self, @Draftsources); # assign colors to each
    if ($TOP){$TOP->configure(-text => "Assigning Offsets to sub-level Sources"); $TOP->update}
    $self->{draft_total_offset} = _assign_offsets($self, @Draftsources); # assign offsets to each
    # stick it into $self to make it easier to get to from other places
    $self->DraftSources(\@Draftsources); 
}

sub _drawTopLevelFeatures {
    my ($self) = @_;  	
    my $TOP = $self->SysMess;
    if ($TOP){$TOP->configure(-text => "Drawing Top-Level features"); $TOP->update}

    my (@genes, @subfeatures, @FinishedFeatures);
    my @features = $self->MapSeq->top_SeqFeatures; # extract top level features from bioPerl Seq object

    foreach my $feature(@features){
	next if (!($feature->primary_tag eq "gene")); # if it aint a gene, don't map it
	push @genes, $feature;	# if it is, then stick it in a list and...

	foreach my $subfeature($feature->sub_SeqFeature) { # get a list of all of its sub-features
	    push @subfeatures, $subfeature; # stick them into a list too
	}
    }
    push @FinishedFeatures, @genes;
    push @FinishedFeatures, @subfeatures; # stick the lists together and...		
    mapFeatures($self,		# MAP THEM!
		'finished',	# which canvas to draw on
		\@FinishedFeatures, # the list of top-level genes and sub-features
		);
    _drawLabels($self,
		$self->FinishedLabelCanvas, # the canvas upon which to draw the labels
		$self->FinishedSources,	# the source names that will be the text of each label
		);  				
}

sub _drawSubFeatures {
    my ($self) = @_;		# as above, except take all features but throw away the genes
    my $TOP = $self->SysMess;
    if ($TOP){$TOP->configure(-text => "Drawing Sub features"); $TOP->update}
    my @DraftFeatures;
    my @features = $self->MapSeq->all_SeqFeatures;
    foreach my $feature(@features){
    	next if ($feature->primary_tag eq "gene");
    	push @DraftFeatures, $feature;
    }	
    mapFeatures($self,
		'draft',
		\@DraftFeatures, # the sub-features associated with that object
		);

    _drawLabels($self,
		$self->DraftLabelCanvas, # as above
		$self->DraftSources,
		);
}


sub _extract_sources {
    my (@features) = @_;
    my @sources;
    my $flag;
    #@sources = undef;

    foreach my $feature(@features) {
	$flag = 0;
	my $this_source = $feature->source_tag;
	if (!$this_source) {$this_source = "undefined"}

	next if ($feature->primary_tag eq "gene"); # this filters out top-level gene objects
	# so that they are not included in the "get all" features list
	foreach my $source(@sources){
	    if ($this_source eq $source) {$flag = 1}
	}
	if ($flag == 0) {push @sources, $this_source}
    }
    return @sources;
}

sub _assign_colors {
    #print "assigning Colors\n";
    my ($self, @sources) = @_;
    my $ColorPos;
    my @colorlist = $self->colorlist;
    my %colordef = $self->colordef;

    foreach my $source(@sources) {
	if (! $self->current_colors->{$source} ){
	    $ColorPos = $self->next_colorpos;
	    $self->current_colors->{$source} = $colordef{$colorlist[$ColorPos]};
	}	
    }
}

sub _assign_offsets {		# this also draws the labels on the rows
    #print "assigning Offsets\n";
    my ($self, @sources) = @_;
    my $def_offset = 10;	#the space between rows of features
    my $whitespace = $self->whitespace;	# a bit of space between the axis and the first feature
    my $increment;

    foreach my $source(@sources) {
	if ($source eq "gene"){ $self->current_offsets->{$source} = $whitespace; next} # we want these to be right near the axis

	if (!($self->current_offsets->{$source})){ # if there is no defined offset for this source
	    $increment = $self->next_offset; # get the next increment value for offsets
	    $self->current_offsets->{$source} = $whitespace + ($increment * $def_offset); # assign the offset as increment*distance
	    #print "$source with offset " . $self->current_offsets->{$source} . "\n";   		
	}
    }

    return (($whitespace + (($self->offset_pointer) * $def_offset))*2);	# double the (offset + whitespace) = total map width

}

sub _drawLabels {	
    my ($self, $labels, $sources) = @_;
    ###########################################################################
    #  now draw the labels on the label canvas - one for each line of features
    #############################################################################
    my $text_width = ($self->{-orientation} eq "horizontal") ? 0:1; 
    # for horizontal it is 20 characters long, for vertical it is 1 character 
    # wide (essentially vertically written)
    # now draw the labels
    my @sources = @{$sources};
    foreach my $source(@sources) {
	my $color = $self->current_colors->{$source};
	my $offset = $self->current_offsets->{$source};
	if ($self->{-orientation} eq "vertical") { 
            # vertical text requires splitting between every character, 
	    # and splits only occurr before spaces
	    $source = join ' ', (split //, $source); 
            # so we break the string up with spaces between each character.
	}

	if ($self->{-orientation} eq "horizontal") {
	    $labels->createText(5, ($self->{-axis_loc}+$offset)-5,  
				# the -5 is because the AnnotMap function draws 
				# the bars using a different centering mechanism 
				# relative to simply writing text on the canvas
				-text => $source,
				-fill => $color,
				-width => $text_width,
				#-justify => 'right',
				-font => "Courier 10 normal",
				-anchor => 'nw', 
				);
	    $labels->createText(5, ($self->{-axis_loc}-$offset)-5,  
				# the -5 is because the AnnotMap function draws 
				# the bars using a different centering mechanism 
				# relative to simply writing text on the canvas
				-text => $source,
				-fill => $color,
				-width => $text_width,
				#-justify => 'right',
				-font => "Courier 10 normal",
				-anchor => 'nw',

				);
	} else {
	    $labels->createText(($self->{-axis_loc}+$offset)-5, 5,  
				# the +5 is because the AnnotMap function draws 
				# the bars using a different centering mechanism 
				# relative to simply writing text on the canvas
				-text => $source,
				-fill => $color,
				-width => $text_width,
				#-justify => 'right',
				-anchor => 'nw',
				);
	    $labels->createText(($self->{-axis_loc}-$offset)-5, 5,  
				# the +5 is because the AnnotMap function draws 
				# the bars using a different centering mechanism 
				# relative to simply writing text on the canvas
				-text => $source,
				-fill => $color,
				-width => $text_width,
				#-justify => 'right',
				-anchor => 'nw',
				);

	}	
    }
}

sub _doubleClickFeature {

# this routine simply adds a "double_clicked" tag to whatever widget
# was double-clicked.  more importantly, it **erases the
# "double_clicked" tag from any previously double-clicked widget on
# either canvas

}

sub _selectFeature { 

    # the upshot of this is to identify and box any widgets which are
    # "current" on a particular canvas. A widget with the tag
    # "now_current" comes from another subroutine which has
    # computationally selected this item for whatever reason.  The tag
    # "current" comes from the Tk canvas itself, and is added to a
    # widget when it is clicked by the mouse.  We deal with both of
    # these situations here.  SorM holds 'single' or 'multi', and is
    # simply needed to tell the drawSelectionBox routine whether or
    # not to delete any existing selection boxes At the end of this
    # routine, any "current" and "now_current" widget is given the
    # "selected" tag.

    my ($self, $canvas, $map, $SorM) = @_;
    my @exons = $canvas->find('withtag', 'now_current'); 
    # if the widget was selected by a subroutine then it has the
    # "now_current" tag

    if (!@exons){@exons = $canvas->find('withtag', 'current')} 
    # if it was selected by the mouse it has the "current" tag
    # only one of these two options will be true under normal circumstances
    my $widgetid = shift @exons; 
    # this is presumed to be a list of only one element - the current widget id

    my @tags = $canvas->gettags('current'); # get the other tags for the currently selected widget
    push @tags, ($canvas->gettags('now_current')); 
    # one or the other of these will return undef under normal circumstances

    my ($FeatureID, $strand, $source) = _extractTags(\@tags); 
    # parse the tags to get the juicy bits

    my $exitflag = "false";
    foreach my $tag (@tags){
    	if ($tag eq "selected"){ # this object has already been selected! so... unselect it
	    $canvas->delete("sel_box_$FeatureID"); # delete the selection box from around this object only
	    $canvas->dtag($FeatureID, "selected"); # remove the "selected" status of this widget
	    $canvas->dtag('now_current');
	    $exitflag = "true";	# raise the flag to exit this routine
    	}
    }
    return if ($exitflag eq "true"); # get out if the event was a de-selection event

    my ($FeatureIndex)  = ($FeatureID =~ /^FID(.+)/); 
    # get the IndexedFeatureList index pointer for this feature
    
    if ( ! defined $FeatureIndex ) { 
	$canvas->dtag('now_current'); 
	return; 
    } 
    # there are all sorts of other invisible junks on the map for some reason, 
    # so filter out these things
    
    my $feature = $self->{IndexedFeatureList}->[$FeatureIndex]; 
    # then extract this Bio::Feature object from the list
    my $start = $feature->start;              
    # $feature now contains the actual BioSeqFeature object, 
    # so we can use the Feature methods...

    my $stop = $feature->end;             # like start, stop, strand, etc.
    my $offset = $self->current_offsets->{$source}; 
    # offset from axis always depends on the source tag
    # quickly nab the position that was clicked so that we can zoom around this
    my $current_loc = ($self->{-orientation} eq "horizontal") ? 
	($canvas->canvasx($canvas->XEvent->x)) : ($canvas->canvasy($canvas->XEvent->y));  #/)
    $self->current_loc($current_loc);				
    # this becomes the location on the map around which we will zoom if the user choses
    
    if ($strand eq "-1") {
	_drawSelectionBox ($self, $canvas, $map, $start, $stop, $offset, $FeatureID, $SorM);
    } else {
	_drawSelectionBox ($self, $canvas, $map, $start, $stop, -$offset, $FeatureID, $SorM);
    }
    $canvas->addtag("selected", "withtag", "$FeatureID");
    
    #original
    $canvas->dtag('now_current');	
}

sub _drawSelectionBox {		# this is conceptually based on Nomi Harris' Genotator code
    my($self, $canvas, $map, $start, $stop, $offset, $FeatureID, $SorM) = @_;
    #print "start $start  end $end  offset $offset total offset $total_offset exon $ExonID  SM $SorM\n";

    my $y1 = (($self->actual_total_offset)/2) + $offset -3; #/
    my $y2 = $y1 + 6;

    if ((defined $SorM) && ($SorM eq "single")) {clearSelections($self)}; 
    # if, for example, the user is not holding now the "shift" key when they click
    # then clear all other selections/boxes

    my @tags = ('selection_box', "sel_box_$FeatureID");
    if ($self->{-orientation} eq "vertical"){
	$canvas->create('rectangle', # draw a rectangle around the colored feature box widget
			$y1, $map->MapLocation($start),
			$y2, $map->MapLocation($stop),
			'-tags' => \@tags, # add a tag so that we can delete it later if necessary
			);
    } else {
	$canvas->create('rectangle', # draw a rectangle around the colored feature box widget
			$map->MapLocation($start), $y1,
			$map->MapLocation($stop), $y2,
			'-tags' => \@tags, # add a tag so that we can delete it later if necessary
			);
    }
}


sub _extractTags {
    my (@tagsref) = @_;
    my $tags = shift @tagsref;
    my ($FeatureID, $strand, $source);
    foreach my $tag(@{$tags}){
	if ($tag =~ /^(FID.+)/) {$FeatureID = $1}
	if ($tag =~ /^Source (.+)/){$source = $1}
	if ($tag =~ /^Strand (.+)/){$strand = $1}
    }
    #print "tags were $FeatureID, $strand, $source\n\n";
    return ($FeatureID, $strand, $source);
}

sub _isLabel {
    my ($self, $widgetTkID) = @_;
    my @tags = $self->DraftCanvas->gettags($widgetTkID);
    push @tags, $self->FinishedCanvas->gettags($widgetTkID);
    foreach my $tag(@tags){
	if ($tag eq "bioTk_Map_Label"){return 1}
    }
    return 0;
}


# *********************************************
# *******************  API STARTS HERE ********
# *********************************************

=pod

=head2 mapFeatures

 Title    : mapFeatures
 Usage    : $FeatureIDs = $MapObj->mapFeatures('draft'|'finished',
					       \@FeatureObj)
 Function : map SeqFeature objects to the 'draft'(white) or 
               'finished' (blue) maps
 Returns  : reference to a list of the FeatureID's of the mapped Features
 Args     : 'draft'|'finished', \@FeatureObj

=cut
#'

sub mapFeatures {
    my ($self, $whichmap, $features) = @_;
    my ($map, $canvas, $offsets);
    if ($whichmap eq 'draft'){
	$map = $self->DraftMap;
	$canvas = $self->DraftCanvas;
    } elsif ($whichmap eq 'finished'){
	$map = $self->FinishedMap;
	$canvas = $self->FinishedCanvas;
    } else {print "no such map type $whichmap\n"; return}

    my @coords;
    my @MappedIDs;

    foreach my $feature(@{$features}) {
	next if ($feature->primary_tag eq "source"); # this just gives one BIIIG line representing the entire sequence
	next if ($feature->primary_tag eq "CDS_span"); # these are on strand 0 so should be chucked (or?)
	next if ($feature->primary_tag eq "intron"); # these are ugly to map
	next if ($feature->primary_tag eq "gene_span");	# these are apparently redundant to the tag "gene"
	next if ($feature->primary_tag eq "CDS");
	my @tags;

	push @{$self->IndexedFeatureList}, $feature; # push the reference to this feature onto the indexed list
	my $FeatureID =  $self->next_id; # get next available index number
	my $FID = "FID$FeatureID"; # just to remind us that this is now the widget designation not the index number

	push @tags, $FID;	# assign that ID to this on-screen widget		

	my $start = $feature->start; # get various useful goodies for mapping
	my $end = $feature->end;
	my $source = $feature->source_tag;
	my $type = $feature->primary_tag;
	my $id;			# this may be undefined at the end of the routine if this particular feature is not a gene-type-feature
	if ($feature->primary_tag eq "gene") {$source = "gene"}   	
	# because the BioSeq parser calls *everything* a top-level gene feature
	# we shift (IMHO) "real" top-level features out to a unique source-line 'gene'
	# to prevent over-drawing sub-feature objects.  Also grab the 'id' tag if it exists...
	my $offset = $self->current_offsets->{$source};
    my $color = $self->current_colors->{$source};
		
		my $strand = $feature->strand;
		$strand =~ s/\+/1/;                     # these change GFF format strand designations into BioPerl Seq object strand desig.
		$strand =~ s/-$/-1/;                    # But really... BioPerl should adopt GFF formats one day -  The GFF designations are
		$strand =~ s/\./0/;	                    # much more intuitive (IMHO)
		
		if ($feature->has_tag("id")){my ($value) = $feature->each_tag_value("id");
									push @tags, "DB_ID " . $value}  # this is to 'link' this widget to an an external database if desired.
																						#  DB_ID should be the unique index number of that DB entry
		push @tags, "Source $source";           # push the source so that we can retrieve the offset and color later if necessary
		push @tags, "Strand $strand";
		push @tags, "Type $type";				# this holds the info about what type of Feature it is... comes from Primary tag...
		push @tags, "Canvas $whichmap";			# let the widget know which map it is sitting on
		#print "$FeatureID - primary " . $feature->primary_tag . " source " . $feature->source_tag . " strand " . $feature->strand . " start " . $feature->start . " offset $offset color $color\n";
				
		
		
		if ($strand eq "-1") {
			push @coords, [$end, $start];
			if (  (!($self->label))   or   (!($feature->has_tag($self->label)))    ){         # if no labels, or if this feature doesn't have the label then map without labelling
							$map->MapObject(\@coords, '-ataxis' => $offset,
								'-color' => $color, '-tags' => \@tags);
			} else {
				my ($label) = $feature->each_tag_value($self->label);              # if the user has defined a tag they wish to label, and if that tag exists, then create a label
				$map->MapObject(\@coords, '-ataxis' => $offset, '-label' => $label, '-labelcolor' => $color,
								'-color' => $color, '-tags' => \@tags);
			}
	    		
		} else {
			push @coords, [$start, $end];
			if ((!($self->label)) or (!($feature->has_tag($self->label)))){
				$map->MapObject(\@coords, '-ataxis' => -$offset,
								'-color' => $color, '-tags' => \@tags);
			} else {
				my ($label) = $feature->each_tag_value($self->label);
				$map->MapObject(\@coords, '-ataxis' => -$offset, '-label' => $label, '-labelcolor' => $color,
								'-color' => $color, '-tags' => \@tags);
			}
	    }
	
	    @coords = () ;   # reset for next iteration through features

	    $canvas->bind("$FID", '<Button-1>', sub{_selectFeature($self, $canvas, $map, 'single')});       # clicking the left mouse selects a single widget
     	$canvas->bind("$FID", '<Shift-Button-1>', sub{_selectFeature($self, $canvas, $map, 'multi')});  # shift-clicking selects multiple widgets
     	$canvas->bind("$FID", '<Double-Button-1>', sub{_selectFeature($self, $canvas, $map, 'single')});  		# a double-click must be assigned to only
     	$canvas->bind("$FID", '<Shift-Double-Button-1>', sub{_selectFeature($self, $canvas, $map, 'single')});  # one widget, so call with 'single' for both cases
     	$canvas->bind("$FID", '<Enter>', sub{$canvas->dtag("Mouse_over");$canvas->addtag("Mouse_over", "withtag", $FID)});   # mouse-enter over a given feature will add a unique "mouse_over" tag
     	$canvas->bind("$FID", '<Leave>', sub{$canvas->dtag("Mouse_over")});       	# leaving that widget will delete this tag
      									   # This can be examined via a call to selectWithtag("mouse_over")<Movement> event in the
      									   # top-level windowing system
     	
     	push @MappedIDs, "$FID";
     	

	}  # end of the foreach $feature loop
	return \@MappedIDs;
}

=head2 unmapFeatures

 Title    : unmapFeatures
 Usage    : my $FeatureObjsRef = $MapObj->unmapFeatures(\@FeatureIDs)
 Function : to remove mapped features from the map display
 Returns  : referenced list of removed $FeatureObj objects

=cut

sub unmapFeatures {
    my ($self, $FeatureIDs) = @_;
    my @Features = @{$FeatureIDs};
    my (@unmappedFeatures);
    if ($#Features == -1) {return @unmappedFeatures};

    $self->clearSelections;
    foreach my $Feature (@Features){
	#print "deleting Feature $Feature\n";
	$self->DraftCanvas->delete($Feature);                              # delete the map widgets
	$self->FinishedCanvas->delete($Feature);
	my ($id)= $Feature =~ /FID(.+)/;
		push @unmappedFeatures, $self->IndexedFeatureList->[$id];     # take the feature out of the encapsulated list and prepare to send it back to the caller
		undef $self->IndexedFeatureList->[$id];                       # delete it from the encapsulated list
    }
    return \@unmappedFeatures
}

=head2 getSelectedIDs

 Title    : getSelectedIDs
 Usage    : $FeatureIDs = $MapObj->getSelectedIDs
 Function : to retrieve the FeatureID's of 
               all currently selected mapped objects
 Returns  : reference to a list of FeatureID's
 Args     : none

=cut

sub getSelectedIDs {
	
	# a special case of getIDsWithTag - just fill in with "selected" and return the result
	my $self = shift;
	my $FeatureListRef = $self->getIDsWithTag(["selected"]);
	return $FeatureListRef;
	
}

=pod

=head2 getSelectedTags

 Title   : getSelectedTags
 Usage   : ($FeatureID, $strand, $source, 
	    $type, $canvas [, $DB_ID]) = $MapObj->getSelectedTags
 Returns : FeatureID, Source, Strand, Type (i.e. Primary_tag),
    Canvas ('draft' or 'finished'), 
    and Database_Index (if available).
 Comment : This is to be used for single-selection events only!
 Args    : none		

=cut



sub getSelectedTags {
    my $self = shift;
    my $Dcanvas = $self->DraftCanvas;
    my $Fcanvas = $self->FinishedCanvas;
    my (@selected, $FeatureID, $source, $strand, $type, $canvas, $DB_ID);
    my $widget;

    #check the Draft and Finished canvasses for selected
    @selected = ($Dcanvas->find("withtag", "selected"),$Fcanvas->find("withtag", "selected"));       # find all Widget ID's that have a "selected" tag
    if (@selected) {
	$widget=shift @selected;
    }
    my @tags = $Dcanvas->gettags($widget);
    if (not @tags) {$Fcanvas->gettags($widget)}
    # for each widget, extract all tags associated with that widget
    foreach my $tag(@tags){
	if ($tag =~ /^(FID.+)/) {$FeatureID = $1}
	if ($tag =~ /^Source (.+)/){$source = $1}
	if ($tag =~ /^Strand (.+)/){$strand = $1}
	if ($tag =~ /^Type (.+)/){$type = $1}
	if ($tag =~ /Canvas (.+)/){$canvas = $1}
	if ($tag =~ /^DB_ID (.+)/){$DB_ID = $1}
	
    }
	return ($FeatureID, $strand, $source, $type, $canvas, $DB_ID);   # note that this returns only the values for the last-parsed widget!!
}

=pod

=head2 getIDsWithTag
    
 Title    : getIDsWithTag
 Usage    : $FeatureIDs = $MapObj->getIDsWithTag(\@taglist)
 Function : to retrieve the FeatureID's of all currently selected mapped objects
 Returns  : reference to a list of FeatureID's
 Args     : a reference to a list of tags (see discussion of proper tag format above)

=cut


sub getIDsWithTag {
	my ($self, $whichtags) = @_;
	my @whichtags = @{$whichtags};	
	my $Dcanvas = $self->DraftCanvas;
	my $Fcanvas = $self->FinishedCanvas;
	my (@FeatureIDList, @selected);
	
	if ($#whichtags == -1) {return \@FeatureIDList};           # returns the empty list if no parameters were sent into the routine

	foreach my $whichtag(@whichtags){
    	#first check the Draft canvas for selected
        @selected = $Dcanvas->find("withtag", $whichtag);       # find all Widget ID's that have a "selected" tag
        foreach my $widget(@selected){
        	my @tags = $Dcanvas->gettags($widget);               		# for each widget, extract all tags associated with that widget
        	my ($FeatureID, $strand, $source) = _extractTags(\@tags);   # get just the interesting ones
        	next if (!$FeatureID);    	
        		my $testflag = 0;                                       # this test routine is the result of a two-hour-long god damn frustrating bug-hunt!
        		foreach my $testID(@FeatureIDList){                       # It turns out that when you click on a labelled widget BOTH the widget AND
        			if ($testID eq $FeatureID){$testflag = 1; last}     # the label are considered "selected" as two independant widgets with the same
        		}                                                       # FID number coming from Bio::TkPerl, but different Tk Canvas widget ID's... bastards!
        		if ($testflag == 0){push @FeatureIDList, $FeatureID};     # so to prevent errors elsewhere, stick the ID in the list to be returned to the user
         }                                                              # iffff that ID is unique to the list (i.e. is not the label for an already pushed widget)

         # now do the Finished Canvas
        @selected = $Fcanvas->find("withtag", $whichtag);
        foreach my $widget(@selected){
        	my @tags = $Fcanvas->gettags($widget);
        	my ($FeatureID, $strand, $source) = _extractTags(\@tags);   # stick the id in the list
        	next if (!$FeatureID);
        	my $testflag = 0;
        		foreach my $testID(@FeatureIDList){
        			if ($testID eq $FeatureID){$testflag = "1"; last}
        		}
        		if ($testflag == 0){push @FeatureIDList, $FeatureID};
         }
     }  # end of foreach $whichtag
     return \@FeatureIDList;
}

=head2 getSelectedFeatures

 Title   : getSelectedFeatures
 Usage   : $FeatureHashRef = $MapObj->getSelectedFeatures
 Returns : a reference to a hash where the FeatureID is the key, 
           and the Bio::SeqFeature Object is the value
 Args : none

=cut


sub getSelectedFeatures{
	# this is a special case of getFeaturesWithTag
	# so fill in the "whichtag" with "selected" and return the result

	my $self = shift;
	my $FeatureHashRef = $self->getFeaturesWithTag(["selected"]);
	return $FeatureHashRef;
}

=head2 getFeaturesWithTag

 Title   : getFeaturesWithTag
 Usage   : $FeatureHashRef = $MapObj->getFeaturesWithTag(\@taglist)
 Returns : a reference to a hash where the FeatureID is the
           key, and the Bio::SeqFeature Object is the value
 Args    : reference to a list of valid tags 
           (see discussion of proper tag format)

=cut

sub getFeaturesWithTag {
	my ($self, $whichtags) = @_;
	my @whichtags = @{$whichtags};
	
 	my (%FeatureHash, @selected);
	if ($#whichtags == -1){return \%FeatureHash};   # returns an empty hash if there were no parameters sent
	
	foreach my $whichtag(@whichtags){	
    	my $Dcanvas = $self->DraftCanvas;
    	my $Fcanvas = $self->FinishedCanvas;
        @selected = $Dcanvas->find("withtag", $whichtag);       # find all DRAFT Widget ID's that have a "selected" tag
        foreach my $widget(@selected){
        	my @tags = $Dcanvas->gettags($widget);               		# for each widget, extract all tags associated with that widget
        	my ($FeatureID, $strand, $source) = _extractTags(\@tags);   # get just the interesting ones
        	$FeatureID =~ /FID(.+)/;
        	next if (!$FeatureID);
        	my $FeatureIndex = $1;
        	my $feature = $self->IndexedFeatureList->[$FeatureIndex];   # extract this Bio::Feature object from the indexed list
        	$FeatureHash{"$FeatureID"} = $feature;                 # stick it in the hash to be returned to the user
         }
        @selected = $Fcanvas->find("withtag", $whichtag);      # find all FINISHED Widget ID's that have a "selected" tag
        foreach my $widget(@selected){
        	my @tags = $Fcanvas->gettags($widget);
        	my ($FeatureID, $strand, $source) = _extractTags(\@tags);
        	$FeatureID =~ /FID(.+)/;
        	next if (!$FeatureID);
        	my $FeatureIndex = $1;                                       # extract the digit portion of this, which is a pointer to the feature list
        	my $feature = $self->IndexedFeatureList->[$FeatureIndex];   # extract this Bio::Feature object from the list
        	$FeatureHash{$FeatureID} = $feature;                         # assign it in a $hash{FIDxxx} = $FeatureObject
         }                                                               # N.B. because of the hash structure we don't need to worry about this feature/label duplication
     }	# end of foreach $whichtag                                       # that arose in getIDsWithTag, as it simply overwrites them.
     return \%FeatureHash;                                           # return the hash
}

=pod

=head2 clearSelections

 Title    : clearSelections
 Usage    : $MapObj->clearSelections
 Function : Clear all selection boxes and "selected" status of all Features.
 Returns  : nothing
 Args     : none


=cut
sub clearSelections {
	my $self = shift;
    $self->DraftCanvas->delete('selection_box');   #  we delete all reference to selected stuff on both maps
    $self->DraftCanvas->dtag('selected');          # 			"
    $self->FinishedCanvas->delete('selection_box');# 			"
    $self->FinishedCanvas->dtag('selected');        # 			"
}

=pod

=head2 selectFeatures

 Title    : selectFeatures
 Usage    : $MapObj->selectFeatures(\@FeatureIDs)
 Function : "select" all Features with @FeatureID id's
 Args     : @FeatureIDs - a list of valid
            FeatureIDs (of the form FIDnnn where nnn is a unique integer)

=cut
#' 

sub selectFeatures {
	my $self = shift @_;
	my @FeatureIDs = @{shift @_};
	return if ($#FeatureIDs == -1);
	
	foreach my $FeatureID(@FeatureIDs) {
		$self->DraftCanvas->addtag('now_current', 'withtag', $FeatureID);    		# the _selectFeature routine looks for widgets that are 'current' and boxes them
		_selectFeature ($self, $self->DraftCanvas, $self->DraftMap, 'multi'); 	# call the routine in multi-mode
		$self->FinishedCanvas->addtag('now_current', 'withtag', $FeatureID);    		# the _selectFeature routine looks for widgets that are 'current' and boxes them
		_selectFeature ($self, $self->FinishedCanvas, $self->FinishedMap, 'multi'); 	# call the routine in multi-mode
	
	}
}

=pod

=head2 selectWithTag

 Title    : selectWithTag
 Usage    : $MapObj->selectWithTag(\@tag_list [,'draft'|'finished'])
 Function : "select" all features which have any of @tag_list tags.
 Args     : @taglist, and optional 'draft' or 'finished' which map

=cut

sub selectWithTag {	
	my $self = shift @_;
	my @tags = @{shift @_};
	my $whichmap = shift @_;
	return if ($#tags == -1);
	
	foreach my $tag(@tags) {
		if (defined $whichmap && $whichmap eq 'finished'){
    		my @widgets = $self->FinishedCanvas->find("withtag", $tag);
    		foreach my $widget(@widgets){
    			$self->FinishedCanvas->addtag('now_current', 'withtag', $widget);    		# the _selectFeature routine looks for widgets that are 'now_current' and boxes them
    			_selectFeature ($self, $self->FinishedCanvas, $self->FinishedMap, 'multi'); 	# call the routine in multi-mode
    		}
		}
		elsif (defined $whichmap && $whichmap eq 'draft'){
    		my @widgets = $self->DraftCanvas->find("withtag", $tag);
    		foreach my $widget(@widgets){
    			if (! $self->_isLabel($widget)){
        			$self->DraftCanvas->addtag('now_current', 'withtag', $widget);    		# the _selectFeature routine looks for widgets that are 'now_current' and boxes them
        			_selectFeature ($self, $self->DraftCanvas, $self->DraftMap, 'multi'); 	# call the routine in multi-mode
				}
    		}
		} else {
    		my @widgets = $self->FinishedCanvas->find("withtag", $tag);
    		push @widgets, $self->DraftCanvas->find("withtag", $tag);
    		foreach my $widget(@widgets){
    			if (! $self->_isLabel($widget)){
        			$self->FinishedCanvas->addtag('now_current', 'withtag', $widget);    		# the _selectFeature routine looks for widgets that are 'now_current' and boxes them
        			_selectFeature ($self, $self->FinishedCanvas, $self->FinishedMap, 'multi'); 	# call the routine in multi-mode
        			$self->DraftCanvas->addtag('now_current', 'withtag', $widget);    		# the _selectFeature routine looks for widgets that are 'now_current' and boxes them
        			_selectFeature ($self, $self->DraftCanvas, $self->DraftMap, 'multi'); 	# call the routine in multi-mode
    			}
    		}
		}   	
	}
}

=pod

=head2 recolorWithTag

 Title    : recolorWithTag
 Usage    : $MapObj->recolorWithTag('#XXXXXX'|'default', 'draft'|'finished', \@tag_list)
 Function : change the color of mapped objects having one of @tag_list tags.
 Returns  : nothing
 Args     :
	First arg:hex-reference to an RGB color value, or 'default'.
	Second arg: the canvas ('draft', or 'finished')
	Third arg: a referenced list of tags.

=cut

sub recolorWithTag {
    my ($self, $color, $whichmap, $tagsref) = @_;
    my @tags = @{$tagsref};
    return if ($#tags == -1);
    if ($whichmap eq 'draft'){
    	foreach my $tag(@tags) {
	    if ($color eq "default"){
		my @thesetags = $self->DraftCanvas->gettags($tag); # extract tags
		# specifially to obtain 'source'
		my ($ID, $strand, $source) = _extractTags(\@thesetags);      
		# get the color associated with 'source'		
		my $thiscolor = $self->current_colors->{$source};
                # assign that color to the widget
		$self->DraftCanvas->itemconfigure($tag, -fill => $thiscolor); 
	    } else {
                # assign that color to the widget
                $self->DraftCanvas->itemconfigure($tag, -fill => $color); 
	    }	
    	}
    }
    elsif ($whichmap eq 'finished') {
    	foreach my $tag(@tags) {
	    if ($color eq "default"){
		# extract tags
		my @thesetags = $self->FinishedCanvas->gettags($tag); 
                # specifially to obtain 'source'
		my ($ID, $strand, $source) = _extractTags(\@thesetags);	
                # get the color associated with 'source
		my $thiscolor = $self->current_colors->{$source}; 
                # assign that color to the widget
		$self->FinishedCanvas->itemconfigure($tag, -fill => $thiscolor); 
	    } else {
                # assign that color to the widget
		$self->FinishedCanvas->itemconfigure($tag, -fill => $color); 
	    }	
	}
    } else {
	print "No known map-type was specified in the call to Recolor",
	" - must be either 'draft' or 'finished'"; 
    }   
}

=pod

=head2 assignCustomColors

 Title    : assignCustomColors
 Usage    : $MapObj->assignCustomColors($top)
 Function : change the default map-color for a selected widgets "Source" tag.
 Returns  : nothing
 Args     : a reference to a Tk::MainWindow object (new or existing).

=cut

sub assignCustomColors {
    my ($self, $top) = @_;
    return if (!$top);
    return if (!ref($top) =~ /MainWindow/);
    my ($FID, $strand, $source, $DB_ID) = $self->getSelectedTags;
    return if (!$source);
    my $cedit;
    $cedit = $top->ColorEditor(-title => "chose a new color for the $source features",
			       -command => 
			       sub {
				   my $color = $_[1];
				   $self->current_colors->{$source} = $color;
				   #print "new color for $source is " ,
				   #       $self->current_colors->{$source} . "\n";
				   $self->recolorWithTag('default', 'draft', ["Source $source"]);
				   $self->recolorWithTag('default', 'finished', ["Source $source"]);
				   $cedit->destroy;
			       } );

$cedit->delete_menu_item(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 16, 17);
$cedit->Show;
$cedit->add_menu_item($source);

}

=head2 is_draft_feature

 Title    : is_draft_feature
 Usage    : $result = $MapObj->is_draft_feature($FeatureID)
 Function : check if a $FeatureID is on the draft (white) map.
 Returns  : 1 for true, undef for false
 Args     : the FeatureID you are querying

=cut


sub is_draft_feature {  # this simply returns 1 (true) or undef (false) if the passed widgetID is on the draft map
	my ($MapObj, $FID) = @_;
	return if (!$FID);
	my $result;
	my @WidgetTags = $MapObj->DraftCanvas->gettags("$FID");
	if (@WidgetTags){$result = 1}
	return $result;
}


=pod

=head2 is_finished_feature

 Title    : is_finished_feature
 Usage    : $result = $MapObj->is_finished_feature($FeatureID)
 Function : check if $FeatureID is on the finished (blue) map.
 Returns  : 1 for true, undef for false
 Args     : the FeatureID you are querying

=cut

sub is_finished_feature {
    my ($MapObj, $FID) = @_;
    return if (!$FID);
    my $result;
    my @WidgetTags = $MapObj->FinishedCanvas->gettags("$FID");
    if (@WidgetTags){$result = 1}
    return $result;
}	

=pod

=head1 EVENTS

The SeqCanvas both internally responds to mouse events, and sets "tags" on the mapped feature in response to mouse events
such that the user can "trap" these events in the top-level windowing system and evaluate which mapped feature the user was
manupulating.

=head2 Mouse-Click

Clicking or shift-Clicking the left mouse button
over a mapped feature causes the feature(s) to become "selected".
A selected object is displayed on the screen with a black box surrounding
the object, and the object becomes tagged with a testable tag "selected"
(use the getSelectedFeatures or getSelectedIDs to retrieve additional information
about this object)

=head2 Mouse-Double-Click

Both Double-clicking and Shift Double-Clicking
the mouse over an object selects that (single) mapped feature. All
other features become unselected.

=head2 Mouse-Click and Drag

Used to select multiple objects. Any object touched by the bounding box will be included in the selection.

=head2 Mouse-Over

As the mouse pointer enters the mapped widget, the tag "Mouse_over" is added to this object. information about this
object could be retrieved by, for example, calling the getIDsWithTag(["Mouse_over"])
method. This tag is removed when the mouse pointer leaves the mapped-feature
space. Bind the <Movement> event in the top-level windowing
system to track the mouse movements if you wish to monitor the Mouse-Over
widget events.

=cut

1;
