SeqCanvas.pm

# $Id$

=head1 NAME

Bio::Tk::SeqCanvas.pm - (v3.0) Graphical display of SeqI objects

=head1 SYNOPSIS

 # To create a BioSeq map and return a handle to the map object:
 use Tk;
 use Bio::SeqIO;
 use Bio::Tk::SeqCanvas;

 Begin();
 MainLoop;

 sub Begin {

 # set up the Tk Windows

 my $MW = 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
 # (note:  the test file used below is in the /t/ folder) 	

 my $SIO = Bio::SeqIO->new(-file=> 'testseq.gb', -format => 'genbank');
 my $SeqObj = $SIO->next_seq();

 # Draw the Map
 my $axis_length = 800;  # how large (long axis) I want the final map to be

 my $MapObj = Bio::Tk::SeqCanvas->new(
 	$axis_length,
 	$Frame,
 	$lblSysMess,
 	$SeqObj,
 	-orientation => 'horizontal',
 	label => 'primary_tag',
 	width => 200,
 	);
 }


=head1 DESCRIPTION

Creates an interactive scalable/zoomable map of all features and
subfeatures of Bio::SeqI compliant and GeneStructureI compliant objects.
Selecting single and multiple map objects is handled 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 SeqFeature::Generic objects, and by the ordinal transcript number
of Gene:;TranscriptI compliant objects. These are assigned "on the fly" based on
whatever is contained in the BioSeq object provided.  The maps re-size
on the fly to accomodate newly added features.


=head1 AUTHORS

Mark Wilkinson (mwilkinson@gene.pbi.nrc.ca),
David Block (dblock@gnf.org)


=head1 ACKNOWLEDGEMENTS

This module requires an updated version of Gregg Helt's original
BioTkPerl modules (version 0.82) which are available from BioPerl.  The
original BioTkPerl (version 0.80) is Copyright (c) Gregg Helt, 1995;
Version 0.82 was generated by Mark Wilkinson, PBI-NRC, May, 2001.

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)

=head1 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.

=head1 NEW FEATURES IN THIS VERSION

=head2 Re-casting of SeqFeature types

During editing you may map numerous features of the type SeqFeature::Generic
or other non-GeneStructureI compliant feature type.  Since the Finished canvas
accepts only GeneStructureI objects, it is now possible to "re-cast"
features on the draft canvas into any of the GeneStructureI features types (Exon,
Intron, UTR, PolyA, Promoter, NC_Feature).  This is accomplished by selecting the
features you wish to be re-cast, right-mouse-clicking on the canvas, and selecting
the new cast from the drop-down menu.  Internally a new object of the selected type is
created from the GFF2 string of the original feature.  This is added to the Seq object,
the original object is deleted from the Seq object, the old widget unmapped and the new
widget mapped.  (Note: each widget has a unique WidgetID, but may point to the same
underlying feature.  Thus in the case of multiple transcripts, the same SeqFeature object
may be represented by multiple Widgets with unique WidgetID's)


=head2 Live Sequence Object Editing and Retrieval

All events happening on the canvas are fed back through to the SequenceI object
that was used to initialize the SeqCanvas.  Thus at any given moment the Seq object
can be retrieved using:

   $SeqObj = $SeqCanvas->MapSeq;

and the structure of the object you obtain is precisely (I believe) what is currently visible
on the canvas.  Thus, if you should ever wish to do so, SeqCanvas could be used as
a 'sanity checkpoint' in a pipeline, where an annotator can view the data, make
any obvious modifications, and then send it farther along the pipe.  N.B. I haven't
tested this thoroughly, so don't take it as gospel until you have done this a few
times.

=head2 Drag-n-Drop editing

This version of SeqCanvas supports drag-n-drop for the creation of:

=over

=item *

New genes

=item *

New gene transcripts

=item *

addition of features to existing transcripts

=back

The interface is straightforward - simply select one or more features on the Draft canvas
and drag them onto the Finished canvas.  If you drag them to an empty spot, you will create
a new gene.  If you drag them onto an existing gene, you will create a new transcript for that
gene.  If you drag them onto an existing transcript you will add them to that transcript.

=head1 WIDGET 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

=head1 CODE EXAMPLES:  Adding/Binding Features

SeqCanvas is a dynamic map, allowing features to be added or removed
after the object has been created.  In addition, events occurring on
this canvas can be externally bound and assigned to subroutines to
allow the canvas to feed information out to an external program for
further processing.

Some code examples are below; these can be added into the Begin()
subroutine in the synopsis to see how they work:

    # MAPPING SIMPLE GENERIC FEATURES
    #________________________________
    # make six arbitrary features and map them
    # if this is added into the Synopsis routine
    # you will see that these features are labelled
    # using their "author" tag values
    my $x = 1;
    while ($x < 6){
    my $feat = new Bio::SeqFeature::Generic (
    	-start => 5000*$x,
    	-end => 6000*$x,
       -strand => -1,
       -primary => 'Unusual_feature',
       -source => "example$x",
       -score  => 1000,
       -tag    => {new => 1,
    		author => 'someone_$x',
    		sillytag => 'this is silly!'}
    		);
    my ($FID) = $MapObj->mapFeatures(undef, [$feat]);
    ++$x;
    }


    # MAPPING GeneStructureI COMPLIANT FEATURES
    #__________________________________________
    # first create the feature 	
    use Bio::SeqFeature::Gene::Exon;
    use Bio::SeqFeature::Gene::Transcript;
    use Bio::SeqFeature::Gene::GeneStructure;
    use Bio::SeqFeature::Generic;

    my $exon1 = new Bio::SeqFeature::Gene::Exon (-start => 3300, -end => 4000, -primary => "exon", -source => "genscan", -strand => -1);
    my $exon2 = new Bio::SeqFeature::Gene::Exon (-start => 4400, -end => 6000, -primary => "exon", -source => "genscan", -strand => -1);
    my $exon3 = new Bio::SeqFeature::Gene::Exon (-start => 3000, -end => 4000, -primary => "exon", -source => "genemark", -strand => -1);
    my $exon4 = new Bio::SeqFeature::Gene::Exon (-start => 5000, -end => 6000, -primary => "exon", -source => "genemark", -strand => -1);
    my $polyA = Bio::SeqFeature::Generic->new(-start => 2500, -end => 2800, -primary=> "polyA", -source => "polyA-scan", -strand => -1);
    my $prom = Bio::SeqFeature::Generic->new(-start => 6200, -end => 6500, -primary=> "promoter", -source => "prom-find", -strand => -1);
    my $transcript = Bio::SeqFeature::Gene::Transcript->new(-start => 2500, -end => 6500, -primary => "transcript", -source => "transcript", -strand => -1);
    my $transcript2 = Bio::SeqFeature::Gene::Transcript->new(-start => 2500, -end => 6500, -primary => "transcript", -source => "transcript", -strand => -1);
    $transcript->add_promoter($prom);
    $transcript->add_exon($exon1, 'initial');
    $transcript->add_exon($exon2, 'terminal');
    $transcript->poly_A_site($polyA);
    $transcript->source_tag("cDNA_evidence");
    $transcript2->add_promoter($prom);
    $transcript2->add_exon($exon3, 'initial');
    $transcript2->add_exon($exon4, 'terminal');
    $transcript2->poly_A_site($polyA);
    $transcript2->source_tag("EST_evidence");
    my $Gene = Bio::SeqFeature::Gene::GeneStructure->new(-start => 2500, -end => 6500, -strand => -1, -primary => "gene", -source => "mark");
    $Gene->add_transcript($transcript);
    $Gene->add_transcript($transcript2);
    #$Gene->add_transcript($transcript8);
    $SeqObj->add_SeqFeature($Gene);
    my ($FID) = $MapObj->mapFeatures(undef, [$Gene]);


    # BINDING EVENTS
    #_______________
    # usually you will want to bind events to the
    # MainWindow ($MW) object.
    #

    $MW->bind("<Button-1>" => sub {
     my ($FID, $strand, $source, $type, $canvas, $DB_ID) = $MapObj->getSelectedTags;
      print "Feature ID = $FID\n";
      print "Source = $source\n";
      print "Primary_tag = $type\n";
      print "Strand = $strand\n\n";
    });

    $MW->bind("<Motion>" => sub {
     my @FIDs = @{$MapObj->getIDsWithTag(["Mouse_over"])};
      # do whatever here, for example:
      # foreach my $ID(@FIDs){print "id=$ID\n"}
    });


    # one useful binding would be to retrieve the current Seq object
    # after an editing session.  The code below binds the "n" key
    # to retrieve the Seq object from the current SeqCanvas window and create a
    # new SeqCanvas window with it.

    $MW->bind("<Key-n>" => sub {
         my $MW = MainWindow->new (-title => "Map Of BioSeq Object");
         my $Frame = $MW->Frame()->pack(-side => 'top');
         my $lblSysMess = $MW->Label()->pack(-side => 'bottom', -fill => 'both');
         my $axis_length = 800;  # how large I want the final map to be
         my $MapObj2 = Bio::Tk::SeqCanvas->new(
               $axis_length,
               $Frame,
               $lblSysMess,
               $MapObj->MapSeq,   #  Here we are getting the up-to-date Seq object
               -orientation => 'horizontal',
               label => 'author',
               width => 300,
         );
         });


=cut


package Bio::Tk::SeqCanvas;
use Bio::Tk::SeqCanvasFeature;
use strict;
use Tk;
use Tk::DragDrop;
use Tk::DropSite;
use Carp;
use Bio::Tk::AnnotMap;
use Tk::widgets qw(ColorEditor Dialog);
use Bio::SeqI;
use Bio::SeqIO;
#use Bio::SeqFeature::Gene::Exon; deprecated
use Bio::SeqFeature::Gene::Exon;
use Bio::SeqFeature::Gene::Transcript;
use Bio::SeqFeature::Gene::GeneStructure;
use vars qw(@ISA $AUTOLOAD);

require Bio::Tk::BioTkPerl8_2; # requires version 0.82 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');

$Bio::Tk::SeqCanvas::VERSION='3.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 => '#aaeeaa',
	 );
	 my @colorlist = qw(darkblue yellowgreen fuschia orange purple dkgreen chartreuse lightblue magenta turquoise green yellow brown ltgreen);
	
	my $dxa;
	my $dya;
	my $dxb;
	my $dyb;
	
	sub dxa {
		my ($self, $newval) = @_;
		if ($newval){$dxa = $newval}
		$dxa=0 unless $dxa;
		return $dxa;
	}
	sub dya {
		my ($self, $newval) = @_;
		if ($newval){$dya = $newval}
		$dya=0 unless $dya;
		return $dya;
	}
	sub dxb {
		my ($self, $newval) = @_;
		if ($newval){$dxb = $newval}
		$dxb=0 unless $dxb;
		return $dxb;
	}
	sub dyb {
		my ($self, $newval) = @_;
		if ($newval){$dyb = $newval}
		$dyb=0 unless $dyb;
		return $dyb;
	}
	
	#___________________________________________________________
	#ATTRIBUTES
    my %_attr_data = #     					DEFAULT    			ACCESSIBILITY
                  (	
                    #dxa					=>  [0,           	'read/write'],  # x/y coords of the draft (d) and finished (f) canvases
                    #dya  				=>  [0,           	'read/write'],
                    #dxb  				=>  [0,         		'read/write'],
                    #dyb  				=>  [0,         		'read/write'],
                    fxa					=>  [0,           		'read/write'],
                    fya  				=>  [0,           		'read/write'],
                    fxb  				=>  [0,         		'read/write'],
                    fyb  				=>  [0,         		'read/write'],
                    -axis_loc  			=>  [0,           		'read/write'],	
                    -labelfont 			=> 	['TimesNewRoman 9 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'],
                    SeqFrame			=>  [undef, 			'read/write'],  # the frame to hold the sequence display
                    #SeqText				=>  [undef, 		'read/write'],  # the sequence display text box
                    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'],
                    InitialFinishedLabels=> [['gene'], 			'read/write'],
                    InitialSources		=>  [['hand_annotation'],		'read/write'],
                    BioPerlFeatureTypes	=>  [{
						"Gene" 			=> "Bio::SeqFeature::Gene::GeneStructure",
						"Transcript"		=> "Bio::SeqFeature::Gene::Transcript",
						"Exon" 			=> "Bio::SeqFeature::Gene::Exon",
						"Intron"			=> "Bio::SeqFeature::Gene::Intron",
						"Promoter"		=> "Bio::SeqFeature::Gene::Promoter",
						"Poly_A_site"	=> "Bio::SeqFeature::Gene::Poly_A_site",
						"UTR"				=> "Bio::SeqFeature::Gene::UTR",
						"Non-Coding"		=> "Bio::SeqFeature::Gene::NC_Feature",
											},					'read/write'],
					Menu				=>  [undef, 			'read/write'], # the menu that contains "Re-Cast Selected As", to allow additions from outside of the module
					ReCastMenu			=>	[undef, 			'read/write'], # the menu that is cascaded by selecting Re-CastSelected As" to allow re-configuration of callbacks from outside if you are not using generic BioPerl feature objects
					Colors				=>	[{},				'read/write'],  # the colors associated with each source  $Colors{$source} = "color"; Class property
                    colordefs 			=>	[\%colordef,    	'read/write'],
                    colorlist 			=> 	[\@colorlist,		'read/write'],
                    current_offsets		=>	[{}, 				'read/write'],
                    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
                    width				=>	[200,				'read/write'],   # the "width" (perpendicular to the axis) of the maps at the outset
                    -orientation 		=>  [undef,				'read/write'],
                    whitespace 			=>	[10, 				'read'],         # whitespace is the distance between the axis and the first widget; the default never changes
                    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'],
                    def_offset			=>	[10, 				'read/write'],
                    _activeDelete		=>	["off",			'read/write'], # does pressing the delete key delete the selected features?
                    DropHighlighted		=>  [undef, 			'read/write'], # this gets set during a drag-n-drop motion event, it holds the FID of a currently mouse-drag-over feature

                    );

	my $_nextDoffset=0;
    my $_nextFoffset=0;
					# note that these are encapsulated CLASS properties
    my %colors;		# and thus are constant from one instantiation to the next
    my $_color_pos = 0;
    my @FinishedSourceLabels;
    my @Sources;
    my %AllFeatures;  # this is the list of features mapped onto the canvas, key is the stringified feature hash address, value is the feature object
    #_____________________________________________________________
    #METHODS, to operate on encapsulated class data

    # Is a specified object attribute accessible in a given mode
    sub _accessible  {
	my ($self, $attr, $mode) = @_;
    return 0 unless ($_attr_data{$attr}[1] &&  $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 FinishedSources {    # for backwards compatibility
    	return \@FinishedSourceLabels;
    }

    sub DraftSources {       # for backwards compatibility
    	return \@Sources;
    }

    sub AllFeatures {
    	# this is the hash of the unique FeatureID and associated SeqCanvasFeature value.
    	# can be called three ways:
    	#->AllFeatures($FID, $SCF) sets the value
    	#->AllFeatures($FID) returns the single value
    	#->AllFeatures() returns all values
    	my ($self, $FID, $SeqCanvasFeature) = @_;
    	if ($SeqCanvasFeature){
    		$AllFeatures{$FID} = $SeqCanvasFeature;
    		return 1;
    	} # the stringified address of the hash is the key, the feature is the value
    	if ($FID){
    		return $AllFeatures{$FID}
    	}
    	return \%AllFeatures
    }

    sub FinishedSourceLabels {  # this is a get/set
    	my ($self, @labels) = @_;
    	if (scalar @labels){@FinishedSourceLabels = @labels}
    	return @FinishedSourceLabels;
    }

    sub addFinishedSourceLabel {
    	my ($self, @labels) = @_;
    	my %sourcehash;
    	foreach my $source(@FinishedSourceLabels){$sourcehash{$source} = 1}
    	foreach my $new(@labels){$sourcehash{$new} = 1}
    	@FinishedSourceLabels = (keys %sourcehash);
    	return @FinishedSourceLabels;
    }

    sub Sources {
    	my ($self, @sources) = @_;
    	if (scalar @sources){@Sources = @sources}
        return 	@Sources;
    }

    sub addSource {
    	my ($self, @new_sources) = @_;
    	my %sourcehash;
    	foreach my $source(@Sources){$sourcehash{$source} = 1}
    	foreach my $new(@new_sources){$sourcehash{$new} = 1}
    	@Sources = (keys %sourcehash);
    	return @Sources;
    }

    sub colorlist {
    	return @colorlist
    }

    sub colordef {
    	return %colordef
    }

    sub MapArgs {
    	my ($self) = @_;
    	my %_map_args;
    	foreach my $key ($self->_standard_keys) {
    		
    		if ($key =~ /^-/) {
    			$_map_args{$key} = $self->{$key};
    		}
    	}
    	return %_map_args;
    }

    #sub next_id {
	#	return $_nextid++;
    #}

	my $ori;
	sub ori {   # the orientation of the canvas has been set... horizontal or vertical.
		my ($self, $val) = @_;
		$ori = $val if $val;
		return $ori;
	}
		
		
		
    sub next_draft_offset {
    	if (!$_nextDoffset){$_nextDoffset=2}
    	return $_nextDoffset++;     # in this case increment it
    }

    sub next_finished_offset {
    	if (!$_nextFoffset){$_nextFoffset=2}
    	return $_nextFoffset++;     # in this case increment it
    }

    sub draft_offset_pointer {
    	if (!$_nextDoffset){$_nextDoffset = 2}
    	return $_nextDoffset;       # in this case just send it as it is
    }
    sub finished_offset_pointer {
    	if (!$_nextFoffset){$_nextFoffset = 2}
    	return $_nextFoffset;       # 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 Tk::Error {
	Tk->break;
}

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 localDestroy {
	my ($self) = @_;	
	if ($self->Menu){eval {$self->Menu->destroy}}
	if ($self->ReCastMenu){eval {$self->ReCastMenu->destroy}}
    eval {$self->FinishedCanvas->destroy};
    eval {$self->DraftCanvas->destroy};
    eval {$self->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
#__________________________________________________________________________________


=head1 Methods

=cut


=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;

   	if ($args{-orientation} =~ /h/i) {$self->{-orientation} = "horizontal"; $self->ori("horizontal")}
   	elsif ($args{-orientation} =~ /v/i) {$self->{-orientation} = "vertical"; $self->ori("vertical")}
   	else {return -4}

	delete $args{-orientation};
	
    foreach my $attrname ( $self->_standard_keys ) {
        next if $attrname eq "-orientation";
        if (exists $args{$attrname}) {
            $self->{$attrname} = $args{$attrname} }
        elsif ($caller_is_obj) {
            $self->{$attrname} = $caller->{$attrname} }
        else {
            $self->{$attrname} = $self->_default_for($attrname) }
    }
	
    $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->SeqFrame($frame->Frame->pack(-side => 'top', expand => 1, -fill => 'x')); # the frame to hold the sequence text
    	$self->ScrollFrame($frame->Frame->pack(-side => 'bottom', -fill => 'x'));
    } else {
    	#$self->SeqFrame($frame->Frame->pack(-side => 'left', expand => 1, -fill => 'y')); # the frame to hold the sequence text
    	$self->ScrollFrame($frame->Frame->pack(-side => 'right', -fill => 'y'));
    }
    $self->MapFrame($frame->Frame->pack(-side => 'top', -expand => 1, -fill => "both")); # the sub-frame to hold the two maps

    $self->MapSeq($SeqObj);    # SeqCanvas contains the sequence object
    # *******************************
    # - This line ensures that the sequences fills the allocated space.
    $self->{-range} = [0, ($SeqObj->length)];   	

    # within these routines 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
    # ************************************************************
    # ***********************************************************

    # Create the MapCanvases with correct dimensions
    
    my $map_width;

	# remember, $self->dxa/dya are *class* variables, not instance varaibles!
	$map_width = (2* ($self->whitespace + ($self->draft_offset_pointer*$self->def_offset)));
	if ($map_width < 200){$map_width = 200}
	
	
    if ($self->{-orientation} eq "horizontal") {
		# the SeqText widget breaks MS-Windows, and is of questionable value anyway...
		# I have removed it, but if you are running *nix and create only horizontal
		# maps you are free to uncomment these lines, as well as the reference in the
		# initializing hash at the top of the code and any other lines that
		# make reference to ->SeqText to make it appear again.
		#$self->SeqText($self->SeqFrame->Scrolled("Text", -scrollbars => "s", -height => 3, -background => 'black', -foreground => "white", -wrap => 'none')->pack(-expand => 1, -fill => 'both')); # text box for teh sequence
		#$self->SeqText->insert('end', "\n");
		#$self->SeqText->insert('end', $SeqObj->seq);
    
		$self->dya(-$map_width/2); # each map is equally distributed
		$self->fya(-$map_width/2); # each map is equally distributed
		$self->dyb($map_width/2); # around the zero axis
		$self->fyb($map_width/2);  # around the zero axis
		$self->{-axis_loc} = $map_width/2; # axis goes half-way (this is a strange bug in AnnotMap... even if you specify that the map is -100 to +100, you can't set the axis at 0, you have to set it at +100 to put it in the middle of this 200 range....
		$self->dxa(1);
		$self->fxa(1);
		$self->dxb($window_length);# height is unchanged
		$self->fxb($window_length);# height is unchanged

		my $DLF = $self->MapFrame->Frame->pack(-side => 'top', -fill => 'both', -expand => 1);	# frame for Draft map and labels
		my $FLF = $self->MapFrame->Frame->pack(-side => 'top', -fill => 'both', -expand => 1);	# frame for Finished map and labels
		$self->DraftLabelCanvas($DLF->Canvas(-width => 100, -height => $map_width, -background => "#ffffff")->pack(-side => 'left', -fill => 'both', -expand => 1));
		$self->DraftCanvas($DLF->Canvas(-width => $window_length, -height => $map_width, -background => "#ffffff")->pack(-side => 'left', -fill => 'both', -expand => 1));
		my $Dyscrollbar = $DLF->Scrollbar('-orient' => 'vertical','-command' => sub {$self->DraftLabelCanvas->yview(@_);$self->DraftCanvas->yview(@_)})->pack(-side => 'left', '-fill'=>'y', '-expand' => 1);
			
		$self->FinishedLabelCanvas($FLF->Canvas(-width => 100, -height => $map_width, -background => "#eeeeff")->pack(-side => 'left', -fill => 'both', -expand => 1));
		$self->FinishedCanvas($FLF->Canvas(-width => $window_length, -height => $map_width, -background => "#eeeeff")->pack(-side => 'left', -fill => 'both', -expand => 1));
		my $Fyscrollbar = $FLF->Scrollbar('-orient' => 'vertical','-command' => sub {$self->FinishedLabelCanvas->yview(@_);$self->FinishedCanvas->yview(@_)})->pack(-side => 'left', '-fill'=>'y', '-expand' => 1);
			
		$self->DraftLabelCanvas->configure('-yscrollcommand' => ['set' => $Dyscrollbar] );
		$self->FinishedLabelCanvas->configure('-yscrollcommand' => ['set' => $Fyscrollbar] );

        $self->DraftCanvas->configure('-yscrollcommand' => ['set' => $Dyscrollbar] );
        $self->FinishedCanvas->configure('-yscrollcommand' => ['set' => $Fyscrollbar] );
		
		$self->DraftCanvas->configure(-scrollregion => [1, $self->dya, $self->dxb, $self->dyb]);
        $self->FinishedCanvas->configure(-scrollregion => [1, $self->fya, $self->fxb, $self->fyb]);
        $self->DraftLabelCanvas->configure(-scrollregion => [1, $self->dya, 100, $self->dyb]);
        $self->FinishedLabelCanvas->configure(-scrollregion => [1, $self->fya, 100, $self->fyb]);

		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
    	
		$self->dxa(-$map_width/2); # each map is equally distributed
		$self->fxa(-$map_width/2); # each map is equally distributed
		$self->dxb($map_width/2);  # around the zero axis
		$self->fxb($map_width/2);  # around the zero axis
		$self->{-axis_loc} = $map_width/2; # axis goes half-way (this is a strange bug in AnnotMap... even if you specify that the map is -100 to +100, you can't set the axis at 0, you have to set it at +100 to put it in the middle of this 200 range....
		$self->dya(1);
		$self->fya(1);
		$self->dyb($window_length);# height is unchanged
		$self->fyb($window_length);# height is unchanged

		my $DLF = $self->MapFrame->Frame->pack(-side => 'left', -fill => 'both'); # frame for Draft map and labels
		my $FLF = $self->MapFrame->Frame->pack(-side => 'left', -fill => 'both'); # frame for Finished map and labels

		$self->DraftLabelCanvas($DLF->Canvas(-width => $map_width, -height => 100, -background => "#ffffff")->pack(-side => 'top', -fill => 'both'));
		$self->DraftCanvas($DLF->Canvas(-width => $map_width, -height => $window_length, -background => "#ffffff")->pack(-side => 'top', -fill => 'both'));
		my $Dyscrollbar = $DLF->Scrollbar('-orient' => 'horizontal','-command' => sub {$self->DraftLabelCanvas->xview(@_);$self->DraftCanvas->xview(@_)})->pack(-side => 'top', '-fill'=>'x', '-expand' => 'y');

		$self->FinishedLabelCanvas($FLF->Canvas(-width => $map_width, -height => 100, -background => "#eeeeff")->pack(-side => 'top', -fill => 'both'));
		$self->FinishedCanvas($FLF->Canvas(-width => $map_width, -height => $window_length, -background => "#eeeeff")->pack(-side => 'top', -fill => 'both'));
		my $Fyscrollbar = $FLF->Scrollbar('-orient' => 'horizontal','-command' => sub {$self->FinishedLabelCanvas->xview(@_);$self->FinishedCanvas->xview(@_)})->pack(-side => 'top', '-fill'=>'x', '-expand' => 'y');

		$self->DraftLabelCanvas->configure('-xscrollcommand' => ['set' => $Dyscrollbar] );
		$self->FinishedLabelCanvas->configure('-xscrollcommand' => ['set' => $Fyscrollbar] );

		$self->DraftCanvas->configure('-xscrollcommand' => ['set' => $Dyscrollbar] );
		$self->FinishedCanvas->configure('-xscrollcommand' => ['set' => $Fyscrollbar] );

		$self->DraftCanvas->configure(-scrollregion => [$self->dxa, 1, $self->dxb, $self->dyb]);
		$self->FinishedCanvas->configure(-scrollregion => [$self->fxa, 1, $self->fxb, $self->fyb]);
		$self->DraftLabelCanvas->configure(-scrollregion => [$self->dxa, 1, $self->dxb, $self->dyb]);
		$self->FinishedLabelCanvas->configure(-scrollregion => [$self->dxa, 1, $self->dxb, 100]);

		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->update;

    $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
    if ($self->_activeDelete eq "on"){$self->DraftCanvas->Tk::bind("<KeyPress-Delete>", sub {$self->deleteFeatures([(keys %{$self->getSelectedFeatures})])} )}
    if ($self->_activeDelete eq "on"){$self->FinishedCanvas->Tk::bind("<KeyPress-Delete>", sub {$self->deleteFeatures([(keys %{$self->getSelectedFeatures})])} )};
	# and now create the maps
    $self->FinishedMap($self->FinishedCanvas->AnnotMap($self->fxa, $self->fya, $self->fxb, $self->fyb, $self->MapArgs));
    $self->DraftMap($self->DraftCanvas->AnnotMap($self->dxa, $self->dya, $self->dxb, $self->dyb, $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 => 1,
					    -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);
    $self->{zoom_level} = 5;
	$self->DoZoom;
    # initialize the canvas with the default rows & colors
    foreach my $source(@{$self->InitialSources}){
    	$self->_check_and_expand_draft_canvas($source);
    	$self->addSource($source);
    }
	foreach my $label(@{$self->InitialFinishedLabels}){
    	$self->_check_and_expand_finished_canvas($label);
    	$self->addFinishedSourceLabel($label);
    }

    # draw the labels for default rows and colors
    foreach my $source($self->Sources){
    	$self->_drawDraftLabels([$source]);
    }
    foreach my $label($self->FinishedSourceLabels){
    	$self->_drawFinishedLabels([$label]);
    }

    # now that everything is set up, go ahead and draw the features
    my @features = $self->MapSeq->top_SeqFeatures;
    my @IDs = @{$self->mapFeatures("both", \@features)}; # only the features from a top_SeqFeatures call -> screened for GeneStructure objects in this routine
	
    $self->_bindMultiSelection(); # this sets up teh mouse-bindings for the "rubber-band box" that snaps around multiple features
    $self->_setupDrag_n_Drop();  # this sets up the basics of the drag n drop interface

    my $toplevel = $self->DraftCanvas->toplevel;
    my $a = $toplevel->geometry;
	$a =~ /(\d+)x(\d+)\+-?(\d+)\+-?(\d+)/;      #get current screen position of top-level window eg. 500x300+20+-45
	$toplevel->geometry("$1"."x"."$2+10+10");  # set it so that the control bar is entirely visible at the top of the screen

	$self->_addMenus;

	$self->MapFrame->OnDestroy(sub {&localDestroy($self)});

    $self->{zoom_level} = 1;
	$self->DoZoom;

	# return the object handle	
    return $self;
}

=head2 activeDelete


 Title    : activeDelete
 Usage    : $MapObj->activeDelete("on" | "off")
 Function : enable/disable 'delete' key to delete mapped features (default off)
 Returns  : 
 Args     : "on" | "off" (case sensitive)


=cut



sub activeDelete {
	my ($self, $onoff) = @_;
	$self->_activeDelete($onoff);
    if ($self->_activeDelete eq "on"){
		$self->DraftCanvas->Tk::bind("<KeyPress-Delete>", sub {$self->deleteFeatures([(keys %{$self->getSelectedFeatures})])} );
	}else {
		$self->DraftCanvas->Tk::bind("<KeyPress-Delete>", sub {} );
	}
    if ($self->_activeDelete eq "on"){
		$self->FinishedCanvas->Tk::bind("<KeyPress-Delete>", sub {$self->deleteFeatures([(keys %{$self->getSelectedFeatures})])} );
	}else {
		$self->FinishedCanvas->Tk::bind("<KeyPress-Delete>", sub {} );
	}
}

sub _addMenus {
	my ($self) = @_;
	
	#if ($self->Menu){eval {$self->Menu->destroy}}
	#if ($self->ReCastMenu){eval {$self->ReCastMenu->destroy}}
	
	my $canvas = $self->DraftCanvas;
	my $menu = $canvas->Menu(-type => 'normal', -tearoff => 0);
    my $cm = $menu->Menu(-type => 'normal', -tearoff => 0);
	
    
    foreach my $type (keys %{$self->BioPerlFeatureTypes()}) {
		$cm->add(
			'command',
			-label => "$type",
            -command => sub {$self->reCastAs(${$self->BioPerlFeatureTypes}{$type});},
        );
	}

	my $f = $menu->add(
		'cascade',
		-label => 'Re-Cast Selected As',
		-menu => $cm
		);
    
	$self->Menu($menu);
	$self->ReCastMenu($cm);

    $canvas->Tk::bind ("<Button-3>" => sub {$self->Menu->Popup(-popover => 'cursor',
						        -popanchor => 'nw'); });

}

sub reCastAs {
	my ($self, $cast) = @_;
	my %FeatureHash = %{$self->getSelectedFeatures};
	my $newfeature; my @del_list; my @add_list;
	foreach my $FID (keys %FeatureHash){
		my $feature = $FeatureHash{$FID};
		$newfeature = $cast->new();  # make a new object of that type
		$newfeature->_from_gff_string($feature->gff_string);	# and fill it with the information from the existing feature::Generic
		push @del_list, $feature;
		push @add_list, $newfeature;
	}		
	$self->unmapFeatures([(keys %FeatureHash)]);
	$self->mapFeatures("draft", \@add_list);
		
}	

sub _deleteFeatureFromSeqObject {
	# called by unmapFeatures *exclusively*
	# send this a feature and it will remove it from the seq object
	# if it is represented on the map only once
	# returns 0 if the feature was not deleted, 1 if it was.
	
	my ($self, $delfeature) = @_;
	my $Seq = $self->MapSeq;
	my @features = (values %{$self->getFeaturesWithTag(["Canvas draft"])});
	push @features, (values %{$self->getFeaturesWithTag(["Canvas finished"])});
	# now we have a list of all features, check if the feature is a singleton, and if so, delete it

	return 0 if (scalar (grep {$_ eq $delfeature} @features) > 1);  # it is represented more than once on the map, so don't destroy it!
	# okay, here we have to 
	@features = $Seq->all_SeqFeatures;
	$Seq->flush_SeqFeatures;
	foreach my $feature(@features){
		next if ($feature eq $delfeature);  # filter out the ones we don't want
		$Seq->add_SeqFeature($feature);
	}
	return 1;
}

sub _setupDrag_n_Drop {
	my ($self) = @_;
	my $source_canvas = $self->DraftCanvas;
	my $dest_canvas = $self->FinishedCanvas;  # note that Drag n Drop is unidirectional in Genquire
	$dest_canvas->eventAdd('<<DROP>>','<Triple-Button-5>');  # define this as an event that I can trigger at will later on
	$self->_bindDropEvent;  # create a binding to deal with drops.
	
	# create the drag-n-drop widget... this is the little label that moves as you drag; teh start_command subroutine is executed on the first movement
	my $DnD_token;
	$DnD_token = $source_canvas->DragDrop ( # this is creating a label-like thing
		-event     => '<B2-Motion>',  # drag and drop is accomplished with button *2* of the mouse
		-sitetypes => ['Local'],   # I will try "remote" one day, which should allow importing of features from one canvas to another
		-startcommand => sub {my @idxs = @{$self->getSelectedIDs};  # see if anything is selected to drag
								unless (scalar(@idxs) > 0){ 		# if nothing selected then abort
									$DnD_token->configure(-text => "** nothing selected **");
									$self->{validDnD} = 0;          # set a flag so the drop routine knows to immediately abort
									return;                         # and abort
								}
								foreach my $FID(@idxs){
									if ($self->is_finished_feature($FID)){  # only draft features are allowed to be dragged
										$DnD_token->configure(-text => "** select only draft features! **");
										$self->{validDnD} = 0;      # set a flag so the drop routine knows to immediately abort
										return;                     # and abort
									}
								}    							
								$self->{validDnD} = 1;      # set a flag so the drop routine knows to immediately abort
								$self->_start_DnD_Drag($DnD_token) },  # if we get here, then all is okay!
	);
	
	# Define a target canvas for drops.
	$dest_canvas->DropSite(   # this defines the dest_canvas (Finished canvas in this case) as a valid drop site
		-droptypes     => ['Local'],
		-dropcommand   => [sub {return unless ($self->{validDnD});
							$self->{validDnD} = 0;      # lower the flag now that we are dropping
							$self->_DnD_Drop($source_canvas, $dest_canvas, $DnD_token)
							} ],
		-motioncommand => [sub {return unless ($self->{validDnD});
							$self->_examine_DnD_Motion($source_canvas, $dest_canvas, $DnD_token)
							} ],

	);	
}

sub _start_DnD_Drag {
    my($self, $DnD_token) = @_;
    my @idxs = @{$self->getSelectedIDs};  # figure out which widget was clicked on
    unless (scalar(@idxs) > 0){
    	$DnD_token->destroy;  # destroy the drag-n-drop process
    	undef $DnD_token;
    	return;
    }

    $DnD_token->configure(-text => "");  # reset the token
	my $w = $DnD_token->parent; # $w is the canvas
    my $EV = $w->XEvent;  # get the mouse event
    my $X = $EV->X;
    my $Y = $EV->Y;

    # Configure the dnd token to show a helpful message
	$DnD_token->configure(-text => "drop in:\n(1) gene - create new transcript\n(2) transcript - add to transcript\n(3) empty space - create new gene");
	# Show the token
	$DnD_token->MoveToplevelWindow($X, $Y); # the innards of DnD has already converted this label widget into a top-level window, so it is no longer a child of the original canvas
	$DnD_token->raise;         # make sure it is visible
	$DnD_token->deiconify;     # and non-iconified
	$DnD_token->FindSite($X, $Y, $EV);  # call the Drag-n-Drop FindSite subroutine and pass it the coords and the event
        								# check whether it is currently over a drop-site (note: this call is only executed *once* from this subroutine.
        								# From now on, a call to FindSite (in DragDrop::rect.pm!!) is made from within the DragDrop module itself
        								# note also that it is using absolute screen coords to make the determination
        								# I am not certain, therefore, whether you are able to drop this on a window which is hidden, as I can't see a test for this anywhere.
}

sub _examine_DnD_Motion {
	my ($self, $source, $dest, $token) = @_;
    return unless ($token);
    my $EV = $token->XEvent;
    my $abs_x = $EV->X;  # the screen coords of the event
    my $abs_y = $EV->Y;
    my $dest_root_x = $dest->rootx;  # the screen coords of the upper left corner of the canvas
    my $dest_root_y = $dest->rooty;
    my $destx = $dest->canvasx($abs_x - $dest_root_x);  # the canvas coords of the event, taking into account the scrollregion
    my $desty = $dest->canvasy($abs_y - $dest_root_y);

    if ($self->DropHighlighted){
    	$self->recolorWithTag("default", "finished", [$self->DropHighlighted]);  # set anything highlighted back to default color
    	$self->DropHighlighted(undef);   # and set it to no longer be highlighted
    }

    my $widget =$dest->find('overlapping', $destx, $desty, $destx, $desty);
    my $FeatureType;
    # there are two possibilities, either the user is over a blank part of the canvas
    # or they are over a widget.  Only the latter case is interesting
    unless ($widget){$token->configure(-text => "drop here to create new gene"); return};
	
	# we are over an existing widget, but it must be a type that can accept drag and drop
	my @tags = $dest->gettags($widget); # get the tags from this widget
	my ($FeatureID, $strand, $start, $stop, $offset, $primary_tag);
    ($FeatureID, $strand, $source, $start, $stop, $offset, $primary_tag) = _extractTags(\@tags);
	return unless ($FeatureID);  # all sorts of things can appear here... so make sure it is a genuine feature
	
	my $SCF = $self->AllFeatures($FeatureID);  # get the SeqCanvasFeature for this widget
	if ($SCF->Feature->can('transcripts')){$FeatureType = "GENE"}  # widget is a gene
	elsif ($SCF->Feature->can('exons')){$FeatureType = "TRANSCRIPT"} # widget is a transcript
	else {return}  # we only allow dropping onto a mapped widget if it is a gene or a transcript
	if ($FeatureType eq "GENE"){
		$self->recolorWithTag("#99bbee", 'finished', [$FeatureID]);
		$token->configure(-text => "make new gene transcript");
		$self->DropHighlighted($FeatureID);  # set this as being currently highlighted
	} elsif ($FeatureType eq "TRANSCRIPT"){
		$self->recolorWithTag("#eedd07", 'finished', [$FeatureID]);
		$token->configure(-text => "add to this transcript");
		$self->DropHighlighted($FeatureID);  # set this as being currently highlighted
	}
}


sub _DnD_Drop {
    my($self, $source, $dest, $token) = @_;

    my $EV = $token->XEvent;
    my $abs_x = $EV->X;  # the screen coords of the event
    my $abs_y = $EV->Y;
    my $dest_root_x = $dest->rootx;  # the screen coords of the upper left corner of the canvas
    my $dest_root_y = $dest->rooty;
    my $destx = $dest->canvasx($abs_x - $dest_root_x);  # the canvas coords of the event, taking into account the scrollregion
    my $desty = $dest->canvasy($abs_y - $dest_root_y);
    $dest->eventGenerate('<<DROP>>', -when => 'now', -x => $destx, -y => $desty);     #==
    $self->clearSelections;
}

sub _bindDropEvent {
	#all we need to do here is ensure that the finished canvas knows what to do when
	# a DROP event is triggered... that is, figure out what (if anything) is teh recipient of the drop
	# and go on from there.
	my ($self) = @_;
	
	my $finished = $self->FinishedCanvas;
	$finished->Tk::bind('<<DROP>>' => sub {	my $EV = $finished->XEvent;
											my $x = $EV->x; my $y = $EV->y; 				#;;
											my $widget = $finished->find('overlapping', $x, $y, $x, $y);
											if ($widget){
												# there is a widget that was dropped on
												# deal with it
												$self->_receiveDropOnWidget($widget);
											} else {
												$self->_receiveDropCreateNewGene();
											}
											});

}

sub _receiveDropOnWidget {
	my ($self, $widget) = @_; # the Canvas WidgetID is sent in here, not the FeatureID... so get the feature
	my @tags = $self->FinishedCanvas->gettags($widget);
	my ($FID) = _extractTags(\@tags);  # FeatureID is contained in the tags, and can be parsed out
	my $SCF = $self->AllFeatures($FID);  # then get this feature id from the list

	if ($self->DropHighlighted){
			$self->recolorWithTag("default", "finished", [$self->DropHighlighted]);  # set anything highlighted back to default color
			$self->DropHighlighted(undef);   # and set it to no longer be highlighted
	}

	my %features = %{$self->getSelectedFeatures};
	my $start = 0; my $stop = 0; my $strand;  # get the dimensions of the new transcript
	foreach my $feature(values %features){  # get boundary information and ensure they are all on the same strand.
		if ($strand && ($strand ne $feature->strand)){
			$self->DraftCanvas->Dialog(
					-title => "cross-strand",
					-text => "transcript will cross strands - ignored",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
			return 0
		}

		else {$strand = $feature->strand} # get strand information from the current feature while we are at it			
	}	

	foreach my $feature(values %features){  # sanity check - have to be featues of a certain BioPerl implementing type
		next unless $feature;
		unless ($feature->isa($self->BioPerlFeatureTypes->{Exon}) ||
			$feature->isa($self->BioPerlFeatureTypes->{Poly_A_site}) ||
			$feature->isa($self->BioPerlFeatureTypes->{Promoter}) ||
			$feature->isa($self->BioPerlFeatureTypes->{UTR})){
				$self->DraftCanvas->Dialog(
					-title => "Invalid Feature Type ".(ref $feature)."",
					-text => "features must be of type Exon, Poly_A_site, Promotor, or UTR.  Please re-cast non-compliant features and drop again",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
			return
			}
	}

	if ($SCF->Feature->can('transcripts')){  # it has been dropped on a Gene-type widget, therefore we want to make a new transcript from it
	    my $Gene = $SCF->Feature;
	    $self->unmapFeatures([$SCF->FID]);
	    $Gene->add_transcript_as_features(values %features);
		return $self->mapFeatures(undef, [$Gene]);
	}
	else{  # in this case we have dropped on something other than a gene-type widget.  This will either be a transcript or a transcript part...
		my $Trans; my $Gene;
												# figure out what type of widget it is (this is better done with an ->isa cal I think...)
		if ($SCF->Feature->can('exons')){ 		# is it a transcript?
			print "dropping on transcript\n";
			$Trans = $SCF->Feature;     		# this IS the transcript object
			$Gene = $SCF->parent_gene;  		# get the SCF gene object
		} elsif ($SCF->Feature->can('cds')){	# is it an exon?, if so we need to findthe transcript of which that exon is a part...
            print "dropping on exon\n"; 			
			$Trans = $SCF->parent_transcript;	# get the parent transcript
			$Gene = $SCF->parent_gene;  		# get the SCF gene object
		} else {warn "invalid drop-recipient object"; return 0}
print "one\n";
		foreach my $feature(values %features){  # ensure they are all on the same strand.
print "two\n";			
			next unless $feature;
print "three\n";
			if ($feature->strand ne $Trans->strand){
				$self->DraftCanvas->Dialog(
					-title => "cross-strand",
					-text => "transcript will cross strands - ignored",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
				return 0}
		}	
		
		foreach my $feature(values %features){
print "four ".(ref $feature)."\n";
			next unless $feature;
			if ($feature->isa("Bio::SeqFeature::Gene::ExonI")){print "adding exon $feature ".(ref $feature)."\n";$Trans->add_exon($feature)}
			elsif ($feature->isa("Bio::SeqFeature::Gene::Poly_A_site")){$Trans->poly_A_site($feature)}
			elsif ($feature->isa("Bio::SeqFeature::Gene::Promoter")){$Trans->add_promoter($feature)}
			elsif ($feature->isa("Bio::SeqFeature::Gene::UTR")){$Trans->add_utr($feature)}
            else {
                $self->DraftCanvas->Dialog(
					-title => "Invalid Feature Type ".(ref $feature)."",
					-text => "features must be of type Exon, Poly_A_site, Promotor, or UTR.  Please re-cast non-compliant features and drop again",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
                return
			}
		}
			
		$self->unmapFeatures([$Gene->FID]);
		
		return $self->mapFeatures(undef, [$Gene->Feature]);
		
	}	
}


sub _receiveDropCreateNewGene {
	my ($self) = @_;
	my %features = %{$self->getSelectedFeatures};
	my $strand;my $start = 0; my $stop = 0;  # get the dimensions of the new transcript
	foreach my $feature(values %features){
		next unless $feature;
		unless ($feature->end < $stop){$stop = $feature->end}
		unless ($start){$start = $feature->start}
		if ($start < $feature->start){$start = $feature->start}
		if ($strand && ($strand ne $feature->strand)){
			$self->DraftCanvas->Dialog(
					-title => "cross-strand",
					-text => "transcript will cross strands - ignored",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
			if ($self->DropHighlighted){
					$self->recolorWithTag("default", "finished", [$self->DropHighlighted]);  # set anything highlighted back to default color
					$self->DropHighlighted(undef);   # and set it to no longer be highlighted
			}
			return 0
		}
		else {$strand = $feature->strand}			
	}	
	foreach my $feature(values %features){  # sanity check - have to be featues of a certain type
		next unless $feature;
		unless ($feature->isa($self->BioPerlFeatureTypes->{Exon}) ||
			$feature->isa($self->BioPerlFeatureTypes->{Poly_A_site}) ||
			$feature->isa($self->BioPerlFeatureTypes->{Promoter}) ||
			$feature->isa($self->BioPerlFeatureTypes->{UTR})){
				$self->DraftCanvas->Dialog(
					-title => "invalid types",
					-text => "features must be of type Exon, Poly_A_site, Promotor, or UTR.  Please re-cast non-compliant features and drop again",
					-default_button => "OK",
					-buttons => ["OK"])->Show(-global);
				if ($self->DropHighlighted){
					$self->recolorWithTag("default", "finished", [$self->DropHighlighted]);  # set anything highlighted back to default color
					$self->DropHighlighted(undef);   # and set it to no longer be highlighted
				}
			return
		}
	}

	my $Gene = $self->BioPerlFeatureTypes->{Gene}->new(-start => $start, -end => $stop, -strand => $strand, -primary => "gene", -source => "SeqCanvas");  	
	my $retval=$self->MapSeq->add_SeqFeature($Gene);
	
	if (($retval ne "1") && ($retval->isa($self->BioPerlFeatureTypes->{Gene}))) {
	    $Gene=$retval;
	}
	$Gene->add_transcript_as_features(values %features);
	$self->DropHighlighted(undef);
	return $self->mapFeatures(undef, [$Gene]);
}


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; my $x1 = shift; my $y1 = shift;
						 #print "mouse event $x1\n";
					$self->dragx1($self->DraftCanvas->canvasx($x1)); 
					$self->dragy1($self->DraftCanvas->canvasy($y1))}, 
				   Ev('x'), Ev('y')]);   
    $self->DraftCanvas->Tk::bind("<B1-Motion>" =>
				 [sub {	$self->{rubberbanding} = "true";  # set a flag to distinguish between ruberbanding and drag/drop
					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
					return unless ($x1 && $x2 && $y1 && $y2);
					
					$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 {	return unless $self->{rubberbanding}; # this has to distinguish between multi-select and drag/drop
					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);
					return unless ($x1 && $x2 && $y1 && $y2);
					#print "SeqCanvas x1 $x1  y1 $y1  x2 $x2  y2 $y2\n";
					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);
					   return if (!($x1 && $x2 && $y1 && $y2));
						$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);
					  return if (!($x1 && $x2 && $y1 && $y2));
						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 _processSeqFeatures {
    # all features should be top_SeqFeatures when they enter this routine...
    my ($self, $features) = @_;
    return unless $features;
    my @features = @{$features};
		
	$self->_extract_sources(\@features);  # this gets the feature and all sub-features, updates SCF's labels and canvas sizes
	$self->_extract_transcripts(\@features);  # this updates both labels and canvas sizes
	
}


sub _check_and_expand_draft_canvas {

	my ($self,$source) = @_;

    my $canvas = $self->DraftLabelCanvas;
    my $map = $self->DraftCanvas;
	
	foreach my $current_source($self->Sources){
		if ($current_source eq $source){  # if the given source exists, then exit this routine ASAP
			if ($self->{-orientation} eq "horizontal"){
				#print "\aconfigure scroll ",$self->dyb+1,"\n";
				$canvas->configure(-scrollregion => [1, $self->dya-10, 100,        $self->dyb+10]);
				$map->configure(-scrollregion =>    [1, $self->dya-10, $self->dxa, $self->dyb+10]);
				$self->DraftMap->{canvas_min} = $self->dya-10; # inform AnnotMap about the new size for zooming purposes
				$self->DraftMap->{canvas_max} = $self->dyb+10;				
			} else {
				$canvas->configure(-scrollregion => [$self->dxa-10, 1, $self->dxb+10, 100]);
				$map->configure(-scrollregion =>    [$self->dxa-10, 1, $self->dxb+10, $self->dyb]);
				$self->DraftMap->{canvas_min} = $self->dxa-10; # inform AnnotMap about the new size for zooming purposes
				$self->DraftMap->{canvas_max} = $self->dxb+10; # the +/- 10 is because I set the canvas scroll region for the labels to be +/- 10 compared to the actual offset
			}
			return;
		}
	}
	# at this point we have determined that the $source is a new one.
	
	my $offset = $self->next_draft_offset;
	my $ColorPos = $self->next_colorpos;
	my @colorlist = $self->colorlist;
	my %colordef = $self->colordef;
	
	$self->current_colors->{$source} = $colordef{$colorlist[$ColorPos]};
	$self->current_offsets->{$source} = $self->whitespace + ($offset * $self->def_offset);
		if ($self->{-orientation} eq "horizontal"){
			my $yb = $self->current_offsets->{$source};
			my $ya = -$yb;
			if ($yb > $self->dyb){
				$self->dya($ya);
				$self->dyb($yb);
			}
			$self->_drawDraftLabels([$source]);
			$self->DraftCanvas->update;
		} else {
			my $xb = $self->current_offsets->{$source};
			my $xa = -$xb;
			if ($xb > $self->dxb){
				$self->dxa($xa);
				$self->dxb($xb);
			}
			$self->_drawDraftLabels([$source]);
			$self->DraftCanvas->update;
		}
}


sub _extract_transcripts {
    my ($self, $features) = @_;
    my @features = @{$features};
	my %Labels;
    my @currentLabels = $self->FinishedSourceLabels;  # at the beginning this should be a list of 1 element - "gene"
    foreach my $label(@currentLabels){
    	$Labels{$label}=1;        # set these labels as being "known" to us.
    }

    foreach my $feature(@features) {
		next unless $feature;
	    my $model=0;   # this is a counter for the number of transcript models contained in the gene

		next unless ($feature->can("transcripts") || $feature->can("exons") || ($feature->primary_tag eq "gene"));  # we only want GeneStructureI compliant objects on finished map, but allow things with primary tag "gene" to be mapped also just to be compliant with SeqIO parsing of genbank files (ugly!!)
		
		if ($feature->can("transcripts")){                         # and get out now if it isn't GeneStructureI compliant
    		my @transcripts = $feature->transcripts;     # get all transcripts from this object
    		next if ($#transcripts == -1);               # exit if there are none
    		foreach my $transcript(@transcripts){        # for every transcript give it a new offset & assign it directly to the transcript object
    			++$model;
    			my $offset;                                # increment model counter -> increment offset from the axis.
    			if (!($Labels{"transcript$model"})){$offset = $self->_check_and_expand_finished_canvas("transcript$model")}  # if label is unknown add it to the finished label canvas, update both label canvas and map size
    			else {$offset = $self->current_offsets->{"transcript$model"}}
    			$Labels{"transcript$model"} = 1;  # define this label as known
    			
    		}
		} elsif ($feature->can("exons")){
		
		} else {next}
	}
	my @transcripts = (keys %Labels);
	$self->FinishedSourceLabels(@transcripts);
	return @transcripts;

}

sub _check_and_expand_finished_canvas {

	my ($self, $label) = @_;

    my $canvas = $self->FinishedLabelCanvas;
    my $map = $self->FinishedCanvas;


	foreach my $current_label($self->FinishedSourceLabels){
		if ($current_label eq $label){  # if the given source exists, then set scroll region and exit this routine ASAP
			if ($self->{-orientation} eq "horizontal"){
				$canvas->configure(-scrollregion => [1, $self->fya-10, 100,        $self->fyb+10]);
				$map->configure(-scrollregion =>    [1, $self->fya-10, $self->fxa, $self->fyb+10]);
				$self->FinishedMap->{canvas_min} = $self->fya-10; # inform AnnotMap about the new size for zooming purposes
				$self->FinishedMap->{canvas_max} = $self->fyb+10; # the +/- 10 is because I set the canvas scroll region for the labels to be +/- 10 compared to the actual offset

			} else {
				$canvas->configure(-scrollregion => [$self->fxa-10, 1, $self->fxb+10, 100]);
				$map->configure(-scrollregion =>    [$self->fxa-10, 1, $self->fxb+10, $self->fyb]);
				$self->FinishedMap->{canvas_min} = $self->fxa-10; # inform AnnotMap about the new size for zooming purposes
				$self->FinishedMap->{canvas_max} = $self->fxb+10;
			}
				return;
		}
	}
	# at this point we have determined that the $source is a new one.
	
	my $offset = $self->next_finished_offset;
	
	my @colorlist = $self->colorlist;
	my %colordef = $self->colordef;
	my $this_offset = $self->whitespace + ($offset * $self->def_offset);
	
	$self->current_colors->{$label} = $colordef{$colorlist[0]};  # was $colorpos instead of 0... but I want them to be consistent
	$self->current_offsets->{$label} = $this_offset;
	
		if ($self->{-orientation} eq "horizontal"){
			my $yb = $this_offset;
			my $ya = -$yb;
			if ($yb > $self->fyb){
				$self->fya($ya);
				$self->fyb($yb); # write the new dimensions of self to self
			}	
			$self->_drawFinishedLabels([$label]);
			$self->FinishedCanvas->update;
		} else {
			my $xb = $this_offset;
			my $xa = -$xb;
			if ($xb > $self->fxb){
				$self->fxa($xa);
				$self->fxb($xb); # write the new dimensions of self to self			
			}
			$self->_drawFinishedLabels([$label]);
			$self->FinishedCanvas->update;
		}
	return $this_offset; 	
}

sub _extract_sources {
	# sources are used to define both offset and color on the draft canvas,
	# but only color on the finished canvas
	# here we are taking the $feature->source_tag and determining if it has already
	# been assigned an offset/color, or if it represents a new source
	# if so, then it is assigned an offset/color in the _check_and_expand routines
	# then a list of currently valid sources (i.e. those that have color/offset assignments)
	# is returned
	
    my ($self, $Features) = @_;   # SCFs are SeqCanvasFeatures, which behave like BioPerl Features (~ FeatureI compliant)
    my @Features = @{$Features};
    my %sources;    # use a hash do simplify screening for duplicate entries - assignment of 'undef' to the same hash key can be safely made multiple times
    my @currentSources = $self->Sources;
    foreach my $source(@currentSources){
    	$sources{$source}=1;   # add current sources to the hash
    }

    foreach my $Feature(@Features) {
		next unless $Feature;
		unless ( ($Feature->primary_tag eq "gene") || ($Feature->can("transcripts")) ){ # this filters out top-level gene objects
			my $this_source = $Feature->source_tag;  # get the source tag
			if (!$this_source) {$this_source = "undefined"}  # or assign it if it doesn't exist
			if (!$sources{$this_source}){$self->_check_and_expand_draft_canvas($this_source);}  # if it is unknown, then expand the canvas
			$sources{$this_source}=1;     # this is essentially a non-redundant list of sources        # now set it to "known"
		}
		my @subfeatures = $self->_getAllSubFeatures($Feature);   # get all sub-features
		foreach my $subfeature(@subfeatures){
			next if (($subfeature->primary_tag eq "gene")||($subfeature->can("transcripts"))||($subfeature->can("exons"))); # this filters out top-level gene objects and transcript objects
			my $this_source = $subfeature->source_tag; # do the same as above
			if (!$this_source) {$this_source = "undefined"}
			if (!$sources{$this_source}){$self->_check_and_expand_draft_canvas($this_source);}
			$sources{$this_source}=1;
		}			
    }
    my @sources = (keys %sources);  # get the non-redundant list
    $self->Sources(@sources);      # and make the list of sources
    return @sources;
}


sub _getAllSubFeatures {
	my ($self, $feature) = @_;
	my %all_features;
	$all_features{"$feature"} = $feature;  # need a non-redundant list
	if ($feature->sub_SeqFeature){
		foreach my $sub($feature->sub_SeqFeature){
			foreach my $ssub($self->_getAllSubFeatures($sub)){
				$all_features{"$ssub"} = $ssub;
			}
			$all_features{"$sub"} = $sub;
		}
	}	
	return (values %all_features);
}


sub _drawFinishedLabels {

    my ($self, $sources) = @_;
    my $canvas = $self->FinishedLabelCanvas;
    my $map = $self->FinishedCanvas;
    ###########################################################################
    #  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, on a canvas, can only occur where there is a space
    	    $source = join ' ', (split //, $source);
    	    # so we break the string up with spaces between each character.
    	}

    	if ($self->{-orientation} eq "horizontal") {
    	    $canvas->createText(5, $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',
    				);
    	    $canvas->createText(5, -$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 {
    	    $canvas->createText($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',
    				);
    	    $canvas->createText(-$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',
    				);

    	}	
    }

	if ($self->{-orientation} eq "horizontal"){
		$canvas->configure(-scrollregion => [1, $self->fya-10, 100,        $self->fyb+10]);
    	$map->configure(-scrollregion =>    [1, $self->fya-10, $self->fxa, $self->fyb+10]);
		$self->FinishedMap->{canvas_min} = $self->fya-10; # inform AnnotMap about the new size for zooming purposes
		$self->FinishedMap->{canvas_max} = $self->fyb+10; # the +/- 10 is because I set the canvas scroll region for the labels to be +/- 10 compared to the actual offset

	} else {
		$canvas->configure(-scrollregion => [$self->fxa-10, 1, $self->fxb+10, 100]);
    	$map->configure(-scrollregion =>    [$self->fxa-10, 1, $self->fxb+10, $self->fyb]);
		$self->FinishedMap->{canvas_min} = $self->fxa-10; # inform AnnotMap about the new size for zooming purposes
		$self->FinishedMap->{canvas_max} = $self->fxb+10;
	}
}

sub _drawDraftLabels {	
    my ($self, $sources) = @_;
    my $canvas = $self->DraftLabelCanvas;
    my $map = $self->DraftCanvas;
    ###########################################################################
    #  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") {
    	    $canvas->createText(5, $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',
    				);
    	    $canvas->createText(5, -$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 {
    	    $canvas->createText($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',
    				);
    	    $canvas->createText(-$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',
    				);

    	}	
    }
	if ($self->{-orientation} eq "horizontal"){
		#print "\aSCROLL ",$self->dyb+10,"\n";
		$canvas->configure(-scrollregion => [1, $self->dya-10, 100,        $self->dyb+10]);
    	$map->configure(-scrollregion =>    [1, $self->dya-10, $self->dxa, $self->dyb+10]);
		$self->DraftMap->{canvas_min} = $self->dya-10; # inform AnnotMap about the new size for zooming purposes
		$self->DraftMap->{canvas_max} = $self->dyb+10;				
	} else {
		$canvas->configure(-scrollregion => [$self->dxa-10, 1, $self->dxb+10, 100]);
    	$map->configure(-scrollregion =>    [$self->dxa-10, 1, $self->dxb+10, $self->dyb]);
		$self->DraftMap->{canvas_min} = $self->dxa-10; # inform AnnotMap about the new size for zooming purposes
		$self->DraftMap->{canvas_max} = $self->dxb+10; # the +/- 10 is because I set the canvas scroll region for the labels to be +/- 10 compared to the actual offset
	}
}

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) = @_;

    # quickly nab the position that was clicked so that we can zoom around this
	my $current_loc;	
	if ($canvas->XEvent){    
		$current_loc = ($self->{-orientation} eq "horizontal") ?
		($canvas->canvasx($canvas->XEvent->x)) : ($canvas->canvasy($canvas->XEvent->y));
	} else {$current_loc = 1}
	
	$self->current_loc($current_loc);				
    # this becomes the location on the map around which we will zoom if the user choses

    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, $start, $stop, $offset) = _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(.+)/);
    if ( ! defined $FeatureIndex ) {   # there are all sorts of other invisible junks on the map,
		$canvas->dtag('now_current');      # so filter out these things and ignore them if they are clicked on
		return;  # exit as it was not a "real" feature that was selected
    }

    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');

    my ($index1, $index2);
    if ($self->{-orientation} eq "horizontal"){  # only horizontal maps display sequence info
    	$index1 = "2." . ($start-1);                 # convert seq coordinates into text-coordinates
    	$index2 = "2." . ($stop);
    }
    
}

sub _drawSelectionBox {		# this is conceptually based on Nomi Harris' Genotator code
    my($self, $canvas, $map, $start, $stop, $offset, $FeatureID, $SorM) = @_;

    # ******* THIS MUST BE CHANGED ********
    my $y1 = $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, $start, $stop, $offset, $type);
    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 =~ /^_SC_start (.+)/){$start = $1}
    if ($tag =~ /^_SC_stop (.+)/){$stop = $1}
    if ($tag =~ /^_SC_offset (.+)/){$offset = $1}

    }
    return ($FeatureID, $strand, $source, $start, $stop, $offset, $type);
}

sub _isLabel {
    my ($self, $widgetTkID, $canvas) = @_;
	my @tags;
	if ($canvas eq "draft"){
		@tags = $self->DraftCanvas->gettags($widgetTkID);
	} else {
		@tags = $self->FinishedCanvas->gettags($widgetTkID);
	}
    foreach my $tag(@tags){
	if ($tag eq "bioTk_Map_Label"){return 1}
    }
    return 0;
}


# *********************************************
# *******************  API STARTS HERE ********
# *********************************************


=head2 mapFeatures

 Title    : mapFeatures
 Usage    : $FeatureIDs = $MapObj->mapFeatures('draft'|'finished'|undef,
					       \@FeatureObj)
 Function : map SeqFeature objects.  Objects which are GeneStructureI compliant
            will be broken down and their individual features mapped onto
            the draft map according to their source_tag, and on the finished
            map according to which Transcript(s) they participate in.
            N.B. 'draft' versus 'finished' is now ignored but is retained
            in the call for backwards compatibility with SeqCanvas v1.0.
 Returns  : reference to a list of the FeatureID's of the mapped Features
 Args     : 'draft'|'finished'|undef, \@FeatureObj


=cut


sub mapFeatures {
    my ($self, $whichmap, $features) = @_;
    my ($map, $canvas, @IDs);
	$self->_processSeqFeatures($features);  # extract/create source/color/offset information
	# first map to the draft canvas; all sub features returns the full array of the feature and recursive searches for subfeatures
	# i.e. every freakin' thing get's mapped, but there is a filter to get rid of gene-level objects (and CDS spans and such)
	foreach my $feature(@{$features}){
		next unless $feature;
		# calls to mapFeatures which take place after initial creation
		# of the object may be mapping features which do not yet exist
		# on the sequence object.  In this case, they need to be added
		#to ensure that the SeqObject is always up to date with what is
		# being displayed
		unless ($feature->entire_seq){$self->MapSeq->add_SeqFeature($feature)}

		my @sub_features = $self->_getAllSubFeatures($feature); # okay, rip it apart and start mapping it
		push @IDs, ($self->_mapOntoDraft(\@sub_features)); # @IDs is a list of FIDxxx for the features that have been mapped
    }                                                      # this is a searchable tag for that feature

	# now map any gene-objects and their transcripts;
	# *only* objects with the primary_tag "gene", or which ->can('transcripts') are mapped
	# this we only get things that we explicitly say are genes, or things that fulfill
	# the GeneStructureI limits
	# sub objects, such as transcripts and exons, are handled delicately
	push @IDs, ($self->_mapOntoFinished($features));  # takes an array ref of top-level objects

	return \@IDs;  # return the list of FIDxxx to the caller in case they want to know...
}

sub _mapOntoFinished {

	my ($self, $genes)=@_;
    my @MappedIDs;

    foreach my $gene(@{$genes}) {
        next unless ($gene->can("transcripts") || ($gene->primary_tag eq "gene"));  # all ::Gene::GeneStructureI objects should have this method, ignore them if they don't
		my $SCF = Bio::Tk::SeqCanvasFeature->new(	SeqCanvas => $self,
													Feature => $gene,  # this fills all of the FeatureI methods
													canvas_name => 'finished',
													canvas => $self->FinishedCanvas,
													map => $self->FinishedMap,
													label => $self->label,
												);  # create a new SeqcanvasFeature object for this feature
														# it is assigned an FID during creation
				
		my ($genes, $transcripts, $exons, $promotors, $polyAs)  = $SCF->drawThyself; # ask it to draw itself on whichever map it is supposed to
    	# note that the line above begins a complex process of drawing the gene and
    	# all of its transcripts, and their sub-objects
    	# their SCF's are returned here in the order above
    	# these must be bound to respond to various mouse events
    	# and must then be added to the global list of mapped features
    	
    	# ******* EDIT BINDING FOR DIFFERENT THINGS
    	# we might want them to respond to the mouse differently, so they are dealt with separately
    	foreach my $gene(@{$genes}){
    		$self->_setupGeneBindings($gene->FID);
    	}
    	foreach my $transcript(@{$transcripts}){  # this is the critical one... it has to respond to drag/drop events
    		$self->_setupTranscriptBindings($transcript->FID);
    	}
    	foreach my $exon(@{$exons}){
    		$self->_setupExonBindings($exon->FID);
    	}
    	foreach my $promotor(@{$promotors}){
    		$self->_setupPromotorBindings($promotor->FID);
    	}
    	foreach my $polyA(@{$polyAs}){
    		$self->_setupPolyABindings($polyA->FID);
    	}
 	
    	foreach $SCF(@{$genes},@{$transcripts},@{$exons},@{$exons},@{$promotors},@{$polyAs}){
    		$self->AllFeatures($SCF->FID, $SCF);  # record the existence of each widget
    		push @MappedIDs, $SCF->FID;           # get the mapped ID's
    	}
	}  # end of the foreach $gene loop
	return @MappedIDs;
}

sub _setupGeneBindings {
	my ($self, $FID) = @_;
	my $canvas = $self->FinishedCanvas;
	my $map = $self->FinishedMap;																			
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}
sub _setupTranscriptBindings {
	my ($self, $FID) = @_;
	my $canvas = $self->FinishedCanvas;
	my $map = $self->FinishedMap;																			
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}
sub _setupExonBindings {
	my ($self, $FID) = @_;
	my $canvas = $self->FinishedCanvas;
	my $map = $self->FinishedMap;																			
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}
sub _setupPromotorBindings {
	my ($self, $FID) = @_;
	my $canvas = $self->FinishedCanvas;
	my $map = $self->FinishedMap;																			
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}
sub _setupPolyABindings {
	my ($self, $FID) = @_;
	my $canvas = $self->FinishedCanvas;
	my $map = $self->FinishedMap;																			
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}


sub _setupDraftBindings {
	my ($self, $FID) = @_;
	my $canvas = $self->DraftCanvas;
	my $map = $self->DraftMap;																			
	
	$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")});       	
	# The latter two bindigns can be examined via a call to $SeqCanvas->selectWithtag("mouse_over")<Movement> event in the
	# top-level windowing system
}

sub _mapOntoDraft {

	my ($self, $features)=@_;
    my @MappedIDs;
    foreach my $feature(@{$features}) {
		next unless $feature;

    ######### FILTER CRAP ################
    	next if ($feature->primary_tag eq "source"); 	# this just gives one BIIIG line representing the entire sequence after a genbank parse
    	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 simply too 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");    # this had to be removed because embl doesn't have "gene" objects per se, only CDS's that are associated with a gene
    	next if ($feature->primary_tag eq "gene");
		next if ($feature->primary_tag eq "mRNA");
    	next if ($feature->can("transcripts"));   # don't map genes (::Gene::GeneStructureI compliant objects)
    	next if ($feature->can("exons"));         # don't map transcripts (::Gene::TranscriptI compliant objects)
	########  END OF FILTER  ##############
		#print "mapping onto draft ",$feature->id, " start ",$feature->start,"\n";
    	# create a SeqCanvasFeature object - acts, looks, and smells like a FeatureI object, with a bit of extra knowledge about itself	
		my $SCF = Bio::Tk::SeqCanvasFeature->new(	SeqCanvas => $self,
													Feature => $feature,  # this fills all of the FeatureI methods
													canvas_name => 'draft',
													canvas => $self->DraftCanvas,
													map => $self->DraftMap,
													offset => $self->current_offsets->{$feature->source_tag},
													color => $self->current_colors->{$feature->source_tag},
													label => $self->label,
			);  # create a new SeqcanvasFeature object for this feature
				
		$self->AllFeatures($SCF->FID, $SCF);  # stick this into the local encapsulated hash of all features
		$SCF->drawThyself;                    # ask it to draw itself on whichever map it is supposed to
		$self->_setupDraftBindings($SCF->FID);# since this is a single, simple object,we can bind events to its FIDxxx

		push @MappedIDs, $SCF->FID;           # get the mapped ID's

	}  # end of the foreach $feature loop	
	return @MappedIDs;	                      # return them to the mapFeatures call
}


sub deleteFeatures {
    my ($self, $FeatureIDs) = @_;
    return unless $self->MapSeq->isa('Bio::UpdateableSeqI');
    foreach my $FeatureID (@$FeatureIDs){
    	my $SCF = $self->AllFeatures($FeatureID); 		# get the SCF (SeqCanvasFeature) object
	next unless $SCF;
	my $transcriptobj=$SCF->parent_transcript;
	my $geneobj=$SCF->parent_gene;
	my $transcript=$transcriptobj ? $transcriptobj->Feature : undef;
	my $gene=$geneobj ? $geneobj->Feature : undef;
	if ($gene) {
	    my $unmapped=$self->unmapFeatures([$geneobj->FID]);
	    return unless $unmapped;
	    my $remapped=$self->MapSeq->delete_feature($SCF->Feature,$transcript,$gene);  #this needs to be implemented in Bio::Seq
	    $self->mapFeatures(undef,[$gene]) if $gene->entire_seq;   #only remap if the gene still exists
	    $self->mapFeatures(undef,$remapped) if $remapped && @$remapped;
	} else {
	    my $unmapped=$self->unmapFeatures([$FeatureID]);
	    my $remapped=$self->MapSeq->delete_feature($SCF->Feature,$transcript,$gene);  #this needs to be implemented in Bio::Seq
	    if (defined $remapped) {
		$self->mapFeatures(undef,$remapped) if @$remapped;
	    } else {  #unsuccessful deletion
		$self->mapFeatures(undef,[$SCF->Feature]);  #then remap the not deleted feature
	    }
	}
    }
}

=head2 unmapFeatures

 Title    : unmapFeatures
 Usage    : my $FeatureObjsRef = $MapObj->unmapFeatures(\@FeatureIDs)
 Function : to remove mapped features (and SubFeatures!!) from the map display
 Returns  : referenced list of removed $FeatureObj objects;
            note that objects may appear in this list multiple times
            if they appeared in more than one place on the map!


=cut



sub unmapFeatures {
    my ($self, $FeatureIDs) = @_;
    my @FeatureIDs = @{$FeatureIDs};
    my (@unmappedFeatures);
    if ($#FeatureIDs == -1) {return \@unmappedFeatures};

    $self->DraftCanvas->toplevel->Busy;
    $self->clearSelections;
    foreach my $FeatureID (@FeatureIDs){
    	my $SCF = $self->AllFeatures($FeatureID); 		# get the SCF (SeqCanvasFeature) object
	next unless $SCF;
	my $unmappedFeature = $SCF->Feature;	  		# retrieve the BioPerl Feature object
	my (%SubFeatureList,@Sortedlist);
	foreach ($self->_getAllSubFeatures($unmappedFeature)) {
	    $SubFeatureList{$_}=$_;
	}
	foreach my $typevar (qw(Gene Transcript)) {           #we are going to sort these features into bins
	    foreach (keys %SubFeatureList) {
		if ($SubFeatureList{$_}->isa($self->BioPerlFeatureTypes->{$typevar})) {     #genes first, then transcripts
		    push @Sortedlist,$SubFeatureList{$_};
		    delete $SubFeatureList{$_};
		}
	    }
	}
	push @Sortedlist, values %SubFeatureList;  #Whatever is left goes in at the end
	foreach my $subfeature (reverse @Sortedlist) {   # now get any and all subfeatures and unmap them
	    foreach my $SCF ($self->translateFeatureIntoSCF($subfeature)) {  # we need the FID to delete it, so retrieve all the SCFs for that feature
		next unless $SCF;
		$self->DraftCanvas->delete($SCF->FID);     # delete the widgets by their ID
		$self->FinishedCanvas->delete($SCF->FID);
		push @unmappedFeatures, $SCF->Feature;# get the feature
		$self->AllFeatures($SCF->FID, undef);	  # and remove it from the feature list
	    }
	}
    }
    $self->DraftCanvas->toplevel->Unbusy;
    
    return \@unmappedFeatures
}

sub translateFeatureIntoSCF {
	# you send this a BioPerl feature object, and it will return  you
	# the SCF reference corresponding to that feature,
	# presuming that a SeqCanvasFeature already *exists* for that Feature object
	# else returns undef
	my ($self, $feature) = @_;
	my @SCF;
	my $x = scalar $feature;  # convert incoming feature to a scalar
	while (my ($FID, $SCF) = each %{$self->AllFeatures}){ # iterate through the known feature hash
		my $y = scalar $SCF->Feature;  # make a scalar from each feature
		if ($x eq $y){
			push @SCF, $SCF;
		}
	}
	return @SCF;
}

=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;
	
}

=head2 getSelectedTags

 Title   : getSelectedTags
 Usage   : ($FeatureID, $strand, $source, 
	    $type, $canvas [, $DB_ID]) = $MapObj->getSelectedTags
 Returns : FeatureID,   # the id of the mapped widget
           Strand,      # BioPerl strand 1,0,-1
           Source,      # source_tag
           Type,        # primary_tag
           Canvas,      # 'draft' or 'finished'
           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;
    my $whichmap = "draft";   # set this as the default at the beginning, if the selected feature is on the finished map we will change it
    #check the Draft and Finished canvasses for selected
    @selected = $Dcanvas->find("withtag", "selected");       # find all Widget ID's that have a "selected" tag
    if ((scalar @selected) == 0){
    	@selected = $Fcanvas->find("withtag", "selected");   # if there is nothign on the draft, perhaps there is something on the finished
    	$whichmap = "finished";                              # update our flag
    }
    return if ((scalar @selected) == 0);                     # if not, then get out

    $widget=shift @selected;                                 # get this widget (single widget only!)
	
    my @tags;
    if ($whichmap eq "draft"){@tags = $Dcanvas->gettags($widget)}
    else {@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!!
}

=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
        	next if (!$FeatureID);
        	my $SCF = $self->AllFeatures($FeatureID);   # extract this SeqCanvasFeature object from the indexed list
        	my $feature = $SCF->Feature;                # retrieve the Feature object from that
        	$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);
        	next if (!$FeatureID);
        	my $SCF = $self->AllFeatures($FeatureID);   # extract this SeqCanvasFeature object from the indexed list
        	my $feature = $SCF->Feature;                # retrieve the Feature object from that
        	$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
}



=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');        # 			"
}



=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
	
	}
}



=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, 'draft')){
        			$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, 'finished')){
        			$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
    			}
    		}
		}   	
	}
}



=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'		
			next unless $ID;
			my $thiscolor = $self->current_colors->{$source};
            if ($thiscolor){
            	# assign that color to the widget
            	$self->DraftCanvas->itemconfigure($tag, -fill => $thiscolor);
            } else {
            	# this must be a gene or transcript type feature because all other features have a color associated with their source tags...
            	# of course... no gene type features should ever appear on the draft canvas... so...???  what the hell :-)
            	my $SCF = $self->AllFeatures($ID);  # get the scf
            	return unless $SCF;
            	if ($SCF->Feature->can("transcripts")){  # then it is a gene
            		my $thiscolor = $self->current_colors->{"gene"};
            		$self->DraftedCanvas->itemconfigure($tag, -fill => $thiscolor);
            	} elsif ($SCF->Feature->can("exons")){   # then it is a transcript
            		my $thiscolor = $SCF->transcript_color; # what color are transcripts in this SCF?
            		$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
				next unless $ID;
				my $thiscolor = $self->current_colors->{$source};
				if ($thiscolor){
					# assign that color to the widget
					$self->FinishedCanvas->itemconfigure($tag, -fill => $thiscolor);
				} else {
					# this must be a gene or transcript type feature because all other features have a color associated with their source tags...
					# of course... no gene type features should ever appear on the draft canvas... so...???  what the hell :-)
					my $SCF = $self->AllFeatures($ID);  # get the scf
					return unless $SCF;
					if ($SCF->Feature->can("transcripts")){  # then it is a gene
						my $thiscolor = $self->current_colors->{"gene"};
						$self->FinishedCanvas->itemconfigure($tag, -fill => $thiscolor);
					} elsif ($SCF->Feature->can("exons")){   # then it is a transcript
						my $thiscolor = $SCF->transcript_color; # what color are transcripts in this SCF?
						$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'";
    }
}



=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, $type, $canvas, $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;
				
				   $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;
}




=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;
}	



=head2 Menu

 Title    : Menu
 Usage    : $menu = $MapObj->Menu()
 Function : Allow editing of the drop-down menu
 Returns  : returns a reference to the drop-down menu object (right-click)
 Args     : 

=cut


=head2 ReCastMenu

 Title    : ReCastMenu
 Usage    : $menu = $MapObj->ReCastMenu()
 Function : Allow editing of the cascadeing "reCast As" menu
            Would be useful to re-define the callbacks associated
            with a re-casting event.
 Returns  : returns a reference to the menu object 
 Args     : 

=cut


=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 B<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;