#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

# DN1
#####################################
# Graphics section for Clone/Project 
#####################################


use strict;


use gull_graphics_sql;
#require "/nfs/disk68/dn1/badger-bin/gull/gull_graphics_sql.pm";

use gull_contig_clone;
#require "/nfs/disk68/dn1/badger-bin/gull/gull_contig_clone.pm";

use MyWaitBox;

BEGIN { push(@INC, $ENV{'BIOTKPERL_LIBRARY'}); }

use sigtrap qw[die untrapped normal-signals
               die any error-signals];

#require "/nfs/disk68/dn1/BIO/perl_version/bioTkperl0.8/Tk/bioTk_Map.pm";
use bioTk_Map;

my $entrycolour = 'white';
my $BITMAP_DIR = "$ENV{'BADGER'}/lib/gull/bitmaps";
my $db;

package contig;

my $dbh;

sub start_plot {

    
    my ($type, $mw, $hit, $call_prog, $contig);
    ($type, $db, $mw, $hit, $call_prog, $contig, $dbh) = @_;

    #################################
    # nb. $hit or $contig can be 'na'
    #################################
    my $plot_type;
    if ($hit eq 'na' && $contig eq 'na'){
	die "Clone and contig cannot both be na !\n";
    }
    if ($hit ne 'na' && $contig ne 'na'){
	die "Clone and contig cannot both have real values !\n";
    }
    if ($hit ne 'na') {
	$plot_type = 'clone';
	$hit = $hit;
    } else {
	$plot_type = 'contig';
	$hit = $contig;
    }

    eval {
	my $window = MyWindow->new($mw, $call_prog, $hit, $db, $plot_type);
    };

}

package MyWindow;

sub new {
    my ($type, $mw, $call_prog, $hit, $db, $plot_type) = @_;
    
    my $self = {};
    bless($self, $type);

    # Start our display/data object
    my $contig_data = Display->new();

    ################## vars-u-like
    my $this_contig;
    my $on;
    my $on_left;
    my $on_right;
    my $this_clone;
    my $this_clone_status;
    my $this_clone_remark;
    my $this_project;
    my $this_project_remark;
    my $this_project_status;
    my $this_project_status_remark;
    my $this_project_finisher;

    $self->{original_mw} = $mw;
    $self->{ecl} = "grey";
    $self->{ecr} = "grey";

    # Set up the screen object
    $self->makeWindow($mw, $plot_type, $hit, $db);
    if ($self->{bother} eq 'dont'){ return ();}

    $self->makeFrames();

    my $contig_type = "Clone";
    if ($plot_type eq 'clone'){
	$this_contig = $self->info($hit, \$this_contig);
    } else {
	######################
	# What kind of plot ?
	######################
	$contig_type = contig->get_type($dbh, $hit);
	$self->info2($hit, $contig_type);
	$this_contig = $hit;
    }
    
    if ($contig_type eq 'Parent'){

	&main::popup ($mw, "WARN", ["Sorry ! I cannot plot parent maps yet :-(  \n"]);
	$self->{mainWindow}->destroy();

    } else {
	$self->makeMenu($contig_data, $db, $hit, $this_contig, \$on, \$on_left, \$on_right, \$this_clone, \$this_clone_status, \$this_clone_remark, \$this_project, \$this_project_remark, \$this_project_status, \$this_project_status_remark, \$this_project_finisher, $contig_type);

	$self->on_contig(\$on_left, \$on_right, \$on, \$this_clone, \$this_clone_status, \$this_clone_remark, \$this_project, \$this_project_remark, \$this_project_status, \$this_project_status_remark, \$this_project_finisher);
    }

    return $self;
}

sub makeWindow {
    my ($self, $mw, $plot_type, $hit, $db) = @_;
    $self->{mainWindow} = $mw->Toplevel;
    $self->{mainWindow}->configure(cursor  => 'hand2');
    $self->{mainWindow}->wm('minsize', 820, 620);
    $self->{mainWindow}->wm('maxsize', 820, 620);
    my $f = $self->{mainWindow}->Frame(-height => 620, -width => 820);
    $f->pack();
    $self->{mainWindow}->idletasks();
    $self->{mainWindow}->packPropagate(0);
    $self->{mainWindow}->idletasks();
    $f->packForget();

    # Bitmaps
    # up button
    $self->{mainWindow}->Bitmap('in',
				-file => "$BITMAP_DIR/magplus.xbm",
				-maskfile => "$BITMAP_DIR/magplus.xbm"
				);
    # down button
    $self->{mainWindow}->Bitmap('out',
				-file => "$BITMAP_DIR/magminus.xbm",
				-maskfile => "$BITMAP_DIR/magminus.xbm"
				);

    if ($plot_type eq 'clone'){
	$self->{mainWindow}->configure (-title => "Clone name $hit->{Clone_info}->{Clonename}");

	my $contigs = convert->clone2contig($dbh, $hit->{Clone_info}->{Clonename});
	
	# No point going on if there are no associated contigs
	if (@$contigs[0] eq ''){
	    &main::popup ($mw, "WARN", ["Sorry ! Cannot plot as there are no associated contigs for this hit.  \n"]);
	    $self->{mainWindow}->destroy();
	    $self->{bother} = 'dont';
	    return();
	}
	$self->{available_contigs} = $contigs;

    } else {
	$self->{mainWindow}->configure (-title => "Contig name $hit");
	my @contigs = ($hit);
	$self->{available_contigs} = \@contigs;
    }

    

	#############################################
	# We can get the Waitbox ready at this point
	#############################################
	$self->{cancel_test} = 0;
	$self->{utxt} = "Initializing...";
	$self->{wd} = $self->{mainWindow}->WaitBox(
						   #-bitmap =>'questhead', # Default would be 'hourglass'
						   #-txt2 => 'tick-tick-tick', #default would be 'Please Wait'
						   -title => 'Please wait...',
						   -cancelroutine => sub {
						       ################################
						       # Need to stop things gracefully
						       ################################
						       $self->{wd}->unShow;
						       $self->{utxt} = undef;

						       if ($self->{choose_ok} eq 'no'){
							   $self->{choose_clone}->destroy();
						       }
						       if ($self->{key_ok} eq 'no'){
							   $self->{key}->destroy();
						       }

						       $self->{cancel_test} = 1;

						       $self->{mainWindow}->destroy();
						   }
						   );
	
	$self->{wd}->wm('minsize', 400, 80);
	$self->{wd}->wm('maxsize', 400, 80);
        my $f = $self->{wd}->Frame(-height => 80, -width => 400);
        $f->pack();
        $self->{wd}->withdraw;
        $self->{mainWindow}->idletasks();
	$self->{wd}->packPropagate(0);
        $f->packForget();
	$self->{wd}->configure(-txt1 => "Calculating contig...");

	##################################################################################
	# User defined frame bit --> maybe we could print out the clone we are importing 
	##################################################################################
	$self->{u} = $self->{wd}->Frame()->pack(side => 'top', fill => 'x');
	#$u->Label(-textvariable => \$utxt)->pack(-expand => 1, -fill => 'both');

	$self->{base} = $self->{u}->Frame(-background =>'gray',
					     -relief => 'sunken',
					     -borderwidth => 2,
					     -height => 20)->pack(-side => 'left', -anchor => 'w',-expand => 1,-fill => 'both');
	$self->{bar} = $self->{base}->Frame(-borderwidth => 2,
					       -relief => 'raised',
					       -height => 20,
					       -width => 0,
					       -background => 'lemonchiffon2')->pack(-fill => 'y', -side => 'left');
	$self->{wd}->configure(-canceltext => 'Cancel plot'); # default is 'Cancel'
    
}


sub makeFrames {
    my ($self) = @_;
    $self->{info_frame} = $self->{mainWindow}->Frame()->pack(side => 'top', fill => 'x');
    $self->{on_frame} = $self->{mainWindow}->Frame()->pack(side => 'top', fill => 'x');

    $self->{menu_frame} = $self->{mainWindow}->Frame()->pack(side => 'top', fill => 'x');

    $self->{canvas_frame} = $self->{mainWindow}->Frame(-relief => 'groove', -borderwidth => '6' )->pack(side => 'top', fill => 'both', -expand => 'yes');



    $self->{bottom_tool_frame} = $self->{mainWindow}->Frame()->pack(side => 'bottom', fill => 'x');
    $self->{tool_frame_left} = $self->{bottom_tool_frame}->Frame()->pack(side => 'left', fill => 'x');
    $self->{tool_frame_right} = $self->{bottom_tool_frame}->Frame(-relief => 'ridge', -borderwidth => '4' )->pack(side => 'right', fill => 'x');


    $self->{tool_frame_left_left} = $self->{tool_frame_left}->Frame()->pack(side => 'left', fill => 'x');
    $self->{tool_frame_left_right} = $self->{tool_frame_left}->Frame()->pack(side => 'right', fill => 'x');

    $self->{tool_frame_right_left} = $self->{tool_frame_right}->Frame()->pack(side => 'left', fill => 'x');
    $self->{tool_frame_right_right} = $self->{tool_frame_right}->Frame()->pack(side => 'right', fill => 'x');

}

sub makeMenu {
    my ($self, $contig_data, $db, $hit, $this_contig, $on, $on_left, $on_right, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher, $contig_type) = @_;
    $self->{plot_options} = {};

    $self->{menu} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'File', underline => 0);

    # File
    $self->{fileMenu1} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'File', underline => 0);
    $self->{fileMenu1}->configure(-menu => $self->{fileMenu1}->Menu(tearoff => 0));
    $self->{fileMenu1}->command(-label => 'Quit', 
				underline => 0,
				command => sub{

				    if ($self->{choose_ok} eq 'no'){
					$self->{choose_clone}->destroy();
				    }
				    if ($self->{key_ok} eq 'no'){
					$self->{key}->destroy();
				    }

				    $self->{mainWindow}->destroy();

				});
    $self->{fileMenu1}->pack(-side => 'left');


    # Find
    $self->{findMenu1} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'Search', underline => 0, state => 'disabled');
    $self->{findMenu1}->configure(-menu => $self->{findMenu1}->Menu(tearoff => 0));
    $self->{findMenu1}->command(-label => "Find a clone",
				-underline => 0,
				-command => sub{
				    unless ($self->{choose_ok} eq 'no'){
					$self->choose_clone($contig_data);
				    }
				});

    $self->{findMenu1}->pack(-side => 'left');
    

    # Key
    $self->{keyMenu1} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'Key', underline => 0,  state => 'disabled');
    $self->{keyMenu1}->configure(-menu => $self->{keyMenu1}->Menu(tearoff => 0));
    $self->{keyMenu1}->command(-label => 'Colour key',
			       underline => 0,
			       command => sub{

				   unless ($self->{key_ok} eq 'no'){
				       $self->start_key($contig_data);
				    }

			       });
    $self->{keyMenu1}->pack(-side => 'left');



    # Plot setup
    $self->{configure} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'Configure', underline => 0);
    $self->{configure}->configure(-menu => $self->{configure}->Menu(-tearoff => 0));

    my $menu_rb = 'Show clone names';
    $self->{configure}->cascade(-label => $menu_rb, -underline => 0);
    my $rm = $self->{configure}->cget(-menu);
    my $rc = $rm->Menu(-tearoff => 0);
    my ($label);
    $self->{configure}->entryconfigure($menu_rb, -menu => $rc );
    foreach $label (qw(yes no)) {
	$rc->radiobutton(
			 -label    => "$label",
			 -variable => \$self->{plot_options}->{show_names},
			 -value    => $label,
			 );
    }
    $rc->invoke(0);

    my $menu_rb2 = 'Use colour to indicate status';
    $self->{configure}->cascade(-label => $menu_rb2, -underline => 0);
    my $rm2 = $self->{configure}->cget(-menu);
    my $rc2 = $rm2->Menu(-tearoff => 0);
    my ($label2);
    $self->{configure}->entryconfigure($menu_rb2, -menu => $rc2 );
    foreach $label2 (qw(no clone project)) {
	$rc2->radiobutton(
			  -label    => "$label2",
			  -variable => \$self->{plot_options}->{colour_clone_status},
			  -value    => $label2,
			  );
    }
    $rc2->invoke(3);

    my $menu_rb3 = 'Indicate uncovered contig regions';
    $self->{configure}->cascade(-label => $menu_rb3, -underline => 0);
    my $rm3 = $self->{configure}->cget(-menu);
    my $rc3 = $rm3->Menu(-tearoff => 0);
    my ($label3);
    $self->{configure}->entryconfigure($menu_rb3, -menu => $rc3 );
    foreach $label3 (qw(yes no)) {
	$rc3->radiobutton(
			  -label    => "$label3",
			  -variable => \$self->{plot_options}->{contig_cover},
			  -value    => $label3,
			  );
    }
    $rc3->invoke(0);


    $self->{configure}->pack(-side => 'right');




    # Plot
    $self->{plotMenu1} = $self->{menu_frame}->Menubutton(bg => 'grey77', text => 'Plot', underline => 0);
    $self->{plotMenu1}->configure(-menu => $self->{plotMenu1} ->Menu(tearoff => 0));
    $self->{plotMenu1}->command(-label => 'Start plot for this contig', 
				underline => 0,
				command => sub{ 

				    if ($self->{plot_options}->{colour_clone_status} eq 'clone'){
					$self->{ecl} = "white";
					$self->{clone_label}->configure(-background => $self->{ecl});
					$self->{status_label}->configure(-background => $self->{ecl});
					$self->{remark_label}->configure(-background => $self->{ecl});
				    }
				    if ($self->{plot_options}->{colour_clone_status} eq 'project'){
					$self->{ecr} = "white";
					$self->{project_label}->configure(-background => $self->{ecr});
					$self->{project_status_label}->configure(-background => $self->{ecr});
					$self->{project_status_remark}->configure(-background => $self->{ecr});
					$self->{project_remark}->configure(-background => $self->{ecr});
					$self->{current_finisher}->configure(-background => $self->{ecr});
				    }

				    $self->{plotMenu1}->configure(-state => 'disabled');
				    $self->{configure}->configure(-state => 'disabled');
				    $self->{contig}->configure(-state => 'disabled');
				    
				    ###### 
				    $contig_data->collect_data($db, $self, $hit, $this_contig, $on, $on_left, $on_right, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher, $contig_type);
				    ###### 

				    if ($self->{cancel_test} == 0){
					$contig_data->focus($self);
					$self->{findMenu1}->configure(-state => 'active');

					if ( ($self->{plot_options}->{colour_clone_status} eq 'clone') || ($self->{plot_options}->{colour_clone_status} eq 'project') ){
					    $self->{keyMenu1}->configure(-state => 'active');
					} 
					$self->{zoom_in}->configure(-state => 'active');
					$self->{zoom_out}->configure(-state => 'active');
				    }
				});

    $self->{plotMenu1}->pack(-side => 'left');

    # Zoom buttons
    $self->{zoom_in} = $self->{menu_frame}->Button(-text => 'Zoom In', -image => 'in', -state => 'disabled', 
						   -command => sub { 

						       $self->zoom(2); 

						   })->pack(-side => 'left');
    $self->{zoom_out} = $self->{menu_frame}->Button(-text => 'Zoom Out',-image => 'out', -state => 'disabled', 
						    -command => sub { 

							$self->zoom(0.5); 

						    })->pack(-side => 'right');
    $self->{zoom_in}->pack(-side => 'right');
    $self->{zoom_out}->pack(-side => 'right');
}


sub info {
    my ($self, $hit, $this_contig) = @_;
    $self->{info_frame}->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			       text => '      Species:')->pack(-side => 'left');
    $self->{species_label} = $self->{info_frame}->Entry(
						      -state => 'disabled',
						      -width => 10,
						      -font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
						      -bg => $entrycolour,
						      -textvariable => \$hit->{Clone_info}->{Speciesname},
						      )->pack(side => 'left');

    $self->{info_frame}->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			     text => ' Chromosome:')->pack(-side => 'left');
    $self->{chromo_label} = $self->{info_frame}->Entry(
						       -state => 'disabled',
						       -width => 5,
						       -font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
						       -bg => $entrycolour,
						       -textvariable => \$hit->{Clone_info}->{Chromosome},
						       )->pack(side => 'left');

    

    $self->{info_frame}->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			       text => ' This Contig:')->pack(-side => 'left');
    $self->{contig} = $self->{info_frame}->BrowseEntry(
						       -width => 12,
						       -variable => \$this_contig, 
						       -state => 'readonly'
						       )->pack(-side => 'left');
    # Populate the contig list
    my $next;
    foreach $next ( @{$self->{available_contigs}} ){
	$this_contig = $self->{available_contigs}->[0];
	$self->{contig}->insert('end', $next);
    }

    return ($this_contig);

}

sub info2 {
    my ($self, $hit, $contig_type) = @_;
    $self->{info_frame}->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			       text => ' This Contig:')->pack(-side => 'left');
    $self->{contig} = $self->{info_frame}->Entry(
						 -state => 'disabled',
						 -width => 20,
						 -textvariable => \$hit,
						 -bg => $entrycolour,
						 )->pack(-side => 'left');

   
    $self->{info_frame}->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
				   text => ' Contig type:')->pack(-side => 'left');
    $self->{contig_type} = $self->{info_frame}->Entry(
						      -state => 'disabled',
						      -width => 10,
						      -textvariable => \$contig_type,
						      -bg => $entrycolour,
						      )->pack(-side => 'left');
    
}



sub zoom {
    my ($self, $factor) = @_;
    my ($x1, $y1, $x2, $y2) = @{$self->{canvas}->cget(-scrollregion)};
    my ($scrlLeft, $scrlRight) = $self->{canvas}->xview();
    $self->{canvas}->scale('all', 0, 0, $factor, 1);
    my $newWidth = ($x2 - $x1) * $factor;
    my $newLeft = (($scrlRight + $scrlLeft) / 2) - (($scrlRight - $scrlLeft) / ($factor * 2));
    $self->{canvas}->configure(-scrollregion => [$x1, $y1, $x1 + $newWidth, $y2]);
    $self->{canvas}->xview(moveto => $newLeft);
}


sub on_contig {
    my ($self, $on_left, $on_right, $on, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher) = @_;

    ##############################
    # Make the clone info section
    ##############################
    my $a = "Clone";
    $self->{clone_labelt} = $self->{tool_frame_left_left}->Entry(
								-state => 'disabled',
								-width => 13,
								-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								#-bg => $entrycolour,
								-textvariable => \$a,
								)->pack(side => 'top');


    $self->{clone_label} = $self->{tool_frame_left_right}->Entry(
								 -state => 'disabled',
								 -width => 29,
								 -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								 -bg => $self->{ecl},
								 -textvariable => \$$this_clone,
								 )->pack(side => 'top');


    my $b = "Clone Status";
    $self->{status_labelt} = $self->{tool_frame_left_left}->Entry(
								  -state => 'disabled',
								  -width => 13,
								  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								  #-bg => $entrycolour,
								  -textvariable => \$b,
								  )->pack(side => 'top');



    $self->{status_label} = $self->{tool_frame_left_right}->Entry(
								  -state => 'disabled',
								  -width => 29,
								  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								  -bg => $self->{ecl},
								  -textvariable => \$$this_clone_status,
								  )->pack(side => 'top');


    my $c = "Clone Remark";
    $self->{remark_labelt} = $self->{tool_frame_left_left}->Entry(
								  -state => 'disabled',
								  -width => 13,
								  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								  #-bg => $entrycolour,
								  -textvariable => \$c,
								  )->pack(side => 'top');

    $self->{remark_label} = $self->{tool_frame_left_right}->Entry(
								  -state => 'disabled',
								  -width => 29,
								  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								  -bg => $self->{ecl},
								  -textvariable => \$$this_clone_remark,
								  )->pack(side => 'left');


    
    my $d = "Project";
    $self->{project_labelt} = $self->{tool_frame_right_left}->Entry(
								    -state => 'disabled',
								    -width => 14,
								    -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								    #-bg => $entrycolour,
								    -textvariable => \$d,
								    )->pack(side => 'top');


    $self->{project_label} = $self->{tool_frame_right_right}->Entry(
								    -state => 'disabled',
								    -width => 29,
								    -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								    -bg => $self->{ecr},
								    -textvariable => \$$this_project,
								    )->pack(side => 'top');


    my $e = "Project Status";
    $self->{project_status_labelt} = $self->{tool_frame_right_left}->Entry(
								    -state => 'disabled',
								    -width => 14,
								    -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								    #-bg => $entrycolour,
								    -textvariable => \$e,
								    )->pack(side => 'top');

    $self->{project_status_label} = $self->{tool_frame_right_right}->Entry(
									   -state => 'disabled',
									   -width => 29,
									   -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
									   -bg => $self->{ecr},
									   -textvariable => \$$this_project_status,
									   )->pack(side => 'top');


    my $f = "Status Remark";
    $self->{project_status_remark_labelt} = $self->{tool_frame_right_left}->Entry(
									   -state => 'disabled',
									   -width => 14,
									   -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
									   #-bg => $entrycolour,
									   -textvariable => \$f,
									   )->pack(side => 'top');


    $self->{project_status_remark} = $self->{tool_frame_right_right}->Entry(
								     -state => 'disabled',
								     -width => 29,
								     -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								     -bg => $self->{ecr},
								     -textvariable => \$$this_project_status_remark,
								     )->pack(side => 'top');


    my $g = "Project Remark";
    $self->{project_remark_labelt} = $self->{tool_frame_right_left}->Entry(
									   -state => 'disabled',
									   -width => 14,
									   -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
									   #-bg => $entrycolour,
									   -textvariable => \$g,
									   )->pack(side => 'top');

    $self->{project_remark} = $self->{tool_frame_right_right}->Entry(
								     -state => 'disabled',
								     -width => 29,
								     -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								     -bg => $self->{ecr},
								     -textvariable => \$$this_project_remark,
								     )->pack(side => 'top');

    
    #######
    my $h = "Finisher";
    $self->{current_finisher_labelt} = $self->{tool_frame_right_left}->Entry(
									     -state => 'disabled',
									     -width => 14,
									     -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
									     -textvariable => \$h,
									     )->pack(side => 'top');

    $self->{current_finisher} = $self->{tool_frame_right_right}->Entry(
								       -state => 'disabled',
								       -width => 29,
								       -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
								       -bg => $self->{ecr},
								       -textvariable => \$$this_project_finisher,
								       )->pack(side => 'top');



    $self->{on_frame}->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
			     text => '                              Other:')->pack(-side => 'left');
    $self->{on_contig} = $self->{on_frame}->Entry(
						  -state => 'disabled',
						  -width => 13,
						  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						  #-bg => $entrycolour,
						  -textvariable => \$$on,
						   )->pack(side => 'left');

    $self->{on_frame}->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
			     text => 'Left:')->pack(-side => 'left');
    
    $self->{on_contig_left} = $self->{on_frame}->Entry(
						       -state => 'disabled',
						       -width => 13,
						       -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						       #-bg => $entrycolour,
						       -textvariable => \$$on_left,
						       )->pack(side => 'left');

    $self->{on_frame}->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
			     text => 'Right:')->pack(-side => 'left');
    
    $self->{on_contig_right} = $self->{on_frame}->Entry(
							-state => 'disabled',
							-width => 13,
							-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
							#-bg => $entrycolour,
							-textvariable => \$$on_right,
							)->pack(side => 'left');
}

sub choose_clone {
    my ($self, $contig_data) = @_;
    $self->{choose_ok} = 'no';
    # Need to start a new Toplevel
    $self->{choose_clone} = $self->{original_mw}->Toplevel;
    $self->{choose_clone}->configure(cursor  => 'hand2');
    $self->{choose_clone}->wm('minsize', 200, 300); 
    $self->{choose_clone}->wm('maxsize', 200, 300);
    my $f = $self->{choose_clone}->Frame(-height => 300, -width => 200);
    $f->pack();
    $self->{mainWindow}->idletasks();
    $self->{choose_clone}->packPropagate(0);
    $self->{choose_clone}->idletasks();
    $f->packForget();

    $self->{choose_clone}->configure (-title => "Available clones");

    my (@clones) = sort (keys( %{$self->{Find_Clone}}) );

    $self->{frame1} = $self->{choose_clone}->Frame();
    $self->{frame1}->pack(-side => 'top', -fill => 'x');
    $self->{frame2} = $self->{choose_clone}->Frame(-relief => 'groove', -borderwidth => '3');
    $self->{frame2}->pack(-side => 'top', -fill => 'x');

    # Need a scrolling-listbox and a quit button
    $self->{choose_listbox} = $self->{frame1}->ScrlListbox (
							    -bg => 'white',
							    -scrollbars => 'e',
							    -label => "Clones",
							    -height => 10,
							    -width => 30,
							    -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*'
							    );
    $self->{choose_listbox}->pack(-side => 'left', -expand => 1, -fill => 'both');

    $self->{choose_listbox}->bind ('<Double-Button-1>' => sub { 
	
	my $get = $self->{choose_listbox}->get('active');
	$self->{interesting_clone} = $self->{Find_Clone}->{$get};
	$contig_data->focus($self);

    });
    
    $self->{choose_quit} = $self->{frame2}->Button( -text => 'Close', 
						   -command => sub {

						       $self->{choose_ok} = 'yes';
						       $self->{choose_clone}->destroy();
						   });
    $self->{choose_quit}->pack(-side => 'left', -expand => 1, -fill => 'both');

    $self->{choose_listbox}->insert('end', @clones);
}

sub choose_clone2 {
    my ($self, $contig_data) = @_;
    $self->{choose_ok} = 'no';
    # Need to start a new Toplevel
    $self->{choose_clone} = $self->{original_mw}->Toplevel;
    $self->{choose_clone}->configure(cursor  => 'hand2');
    $self->{choose_clone}->wm('minsize', 200, 300); 
    $self->{choose_clone}->wm('maxsize', 200, 300);
    my $f = $self->{choose_clone}->Frame(-height => 190, -width => 410);
    $f->pack();
    $self->{mainWindow}->idletasks();
    $self->{choose_clone}->packPropagate(0);
    $f->packForget();
    $self->{choose_clone}->idletasks();
    $self->{choose_clone}->configure (-title => "Available contigs");

    my (@clones) = sort (keys( %{$self->{Find_Clone}}) );

    $self->{frame1} = $self->{choose_clone}->Frame();
    $self->{frame1}->pack(-side => 'top', -fill => 'x');
    $self->{frame2} = $self->{choose_clone}->Frame(-relief => 'groove', -borderwidth => '3');
    $self->{frame2}->pack(-side => 'top', -fill => 'x');

    # Need a scrolling-listbox and a quit button
    $self->{choose_listbox} = $self->{frame1}->ScrlListbox (
							    -bg => 'white',
							    -scrollbars => 'e',
							    -label => "Contigs",
							    -height => 10,
							    -width => 30,
							    -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*'
							    );
    $self->{choose_listbox}->pack(-side => 'left', -expand => 1, -fill => 'both');

    $self->{choose_listbox}->bind ('<Double-Button-1>' => sub { 
	
	my $get = $self->{choose_listbox}->get('active');
	$self->{interesting_clone} = $self->{Find_Clone}->{$get};
	$contig_data->focus($self);

    });
    
    $self->{choose_quit} = $self->{frame2}->Button( -text => 'Close', 
						   -command => sub {

						       $self->{choose_ok} = 'yes';
						       $self->{choose_clone}->destroy();
						   });
    $self->{choose_quit}->pack(-side => 'left', -expand => 1, -fill => 'both');

    $self->{choose_listbox}->insert('end', @clones);
}

sub start_key {
    my ($self) = @_;
    $self->{key_ok} = 'no';

    my $key;
    if ($self->{plot_options}->{colour_clone_status} eq 'clone'){
	$key = collect->colours_for_clone_status($dbh);
    } else {
	$key = collect->colours_for_project_status($dbh);
    }

    my $capture = Data::Dumper::Dumper($key);

    # Need to start a new Toplevel
    $self->{key} = $self->{original_mw}->Toplevel;
    $self->{key}->configure(cursor  => 'hand2');
    $self->{key}->wm('minsize', 270, 275); 
    $self->{key}->wm('maxsize', 270, 275);
    my $f = $self->{key}->Frame(-height => 270, -width => 275);
    $f->pack();
    $self->{mainWindow}->idletasks();
    $self->{key}->packPropagate(0);
    $f->packForget();
    $self->{key}->idletasks();
    $self->{key}->configure (-title => "Status key for $self->{plot_options}->{colour_clone_status}.");

    $self->{framekey1} = $self->{key}->Frame();
    $self->{framekey1}->pack(-side => 'top', -fill => 'x');
    $self->{framekey2} = $self->{key}->Frame(-relief => 'groove', -borderwidth => '3');
    $self->{framekey2}->pack(-side => 'top', -fill => 'x');

    $self->{legend_text} = $self->{framekey1}->Text(-wrap => 'none', 
						    -state => 'normal', 
						    #-width => 60, 
						    -height => 15,
						    -background => 'white');
    $self->{legend_scroll} = $self->{framekey1}->Scrollbar(-command => [$self->{legend_text} => 'yview']);
    $self->{legend_text}->configure(-yscrollcommand => [$self->{legend_scroll} => 'set']);
    $self->{legend_scroll}->pack(-side => 'right', -fill => 'y');
    
    $self->{legend_text}->pack(-side => 'left', -expand => 1, -fill => 'both');

    $self->{key_quit} = $self->{framekey2}->Button( -text => 'Close', 
						-command => sub {
						    
						    $self->{key_ok} = 'yes';
						    $self->{key}->destroy();
						});
    $self->{key_quit}->pack(-side => 'left', -expand => 1, -fill => 'both');

    


    my $next;
    sub numerically { $a <=> $b; }
    foreach $next (sort numerically (keys(%$key)) ){

	my $s = $key->{$next};
	my @ks = keys %$s;


	$self->{legend_text}->insert('end', "     ", $key->{$next}->{$ks[0]}, "$ks[0]\n", "text$ks[0]");

	$self->{legend_text}->tagConfigure($key->{$next}->{$ks[0]}, -background => $key->{$next}->{$ks[0]},
					   -foreground => 'white', -font => '*times*-r*20*');
	$self->{legend_text}->tagConfigure("text$ks[0]",
					   #-foreground => 'black', -font => '*times*-r*20*');
					   -foreground => 'black', -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*');

    }
    $self->{legend_text}->configure(-state => 'disabled');
}

package Display;

sub new {
    my ($type) = @_;
    #############
    # New object;
    #############
    # Will contain contig info and the clone info which makes up that contig
    # Should contain things like coordinates for plotting of both clones and
    # 'overlaps'.
    my $self = {};
    bless $self, $type;
    return $self;
}


sub focus {
    my ($self, $interface) = @_;

    my ($x1, $y1, $x2, $y2) = @{$interface->{canvas}->cget(-scrollregion)};
    my $newWidth = ($x2 - $x1);
    my (@BBox) = $interface->{canvas}->bbox($interface->{interesting_clone});
    my @x = $interface->{canvas}->xview;
    my $midXnow = abs(($x[1] - $x[0])/2);
    my $midx = abs(($BBox[2] - $BBox[0])/2) + $BBox[0];
    my $XSCROLL = $newWidth;
    my $fx = $midx / $XSCROLL;
    $interface->{canvas}->xview(moveto => $fx - $midXnow);
}


sub collect_data {

    my ($self, $db, $interface, $hit, $this_contig, $on, $on_left, $on_right, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher, $contig_type) = @_;

    $interface->{wd}->Show;

    # Which clone are we looking at >?<
    my $test = ref $hit;
    my $clonename;
    if ($test ne ''){
	$clonename = $hit->{Clone_info}->{Clonename};
    } else {
	$clonename = 'na';
    }

    $self->add_contig($this_contig);

    # Find out things about this contig
    $interface->{kill_me} = $dbh;

    #contig.leftpos contig.rightpos
    my $length = contig->calc_length($dbh, $this_contig);
    $self->check_length($length, $interface);
    $self->add_length($length);

    $$on = contig->on_contig($dbh, $this_contig);
    ($$on_left, $$on_right) = contig->on_positions($dbh, $this_contig);
    $self->add_other_contig($on, $on_left, $on_right);

    my $number = 4;
    my $clones = contig->NEWget_clones($dbh, $this_contig, $interface, $number);

    return if ($interface->{cancel_test} == 1);
    
    $self->add_clones($clones);

    #################################################
    # Set up the canvas if we don't have one already
    #################################################
    $interface->{canvas} = $interface->{canvas_frame}->Scrolled('Canvas', -scrollbars => 's')->pack(-side => 'top', -fill => 'both', -expand => 'yes');

    $interface->{canvas}->configure (-bg => 'white');

    ###############
    # Make the map
    ###############

    my $l = $self->{contig}->{extent_to} - $self->{contig}->{extent_from};
    
    my $contig_top = $interface->{canvas}->bioTk_Map(50, 20, ($l+50), 1000);
    my $contig = $interface->{canvas}->bioTk_Map(50, 50, ($l+50), 1000);

    # Do we need a 'fixing factor' for plotting >?<
    my $factor;
    if ( $self->{contig}->{extent_from} < 0){
	# We have a -ve start
	$factor = -($self->{contig}->{extent_from});
    } else {
	$factor = 0 - $self->{contig}->{extent_from};
    }
    $factor = ($factor + 50);


    # We now draw the axis to help orient the contig:
    $interface->{canvas}->update; # just to display axis before drawing the contig

    &drawContig($contig_top, $interface, $self->{contig}->{extent_from}, $self->{contig}->{extent_to}, $self, $factor);

    &drawCosmids($contig, $interface, $self, $factor, $clonename, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher);

    unless ($interface->{plot_options}->{contig_cover} eq 'no'){
	&showgaps($contig_top, $interface, $self, $factor);
    }
    sub drawContig {
	my ($contig, $interface, $left, $right, $self, $factor) = @_;
	my $x = 'black';
	my $addr = $self->{contig}->{name};
	my $return = $contig->MapObject([[($left+$factor), ($right+$factor)]], '-color' => $x, '-label' => $addr, '-labelcolor' => $x, '-width' => 10, '-at' => 10, '-anchor' =>  's');
    }

    sub showgaps {
	my ($contig, $interface, $self, $factor) = @_;
	
#	warn "HERE ! $contig, $interface, $self, $factor \n";

	my $cos;
	foreach $cos ( @{$self->{clones}} )  {
	    $interface->{canvas}->update;

	    # Clone colour
	    my $x = 'red';

	    my $left = "$$cos{leftpos}";
	    my $right = "$$cos{rightpos}";
	    my $addr = $$cos{clonename};
	    my $return = $contig->MapObject([[($left+$factor), ($right+$factor)]], '-color' => $x, '-width' => 10, '-at' => 10);
	}
    }



    # Finally, we create a procedure to actually draw the contig itself:
    sub drawCosmids {
	my ($contig, $interface, $self, $factor, $clonename, $this_clone, $this_clone_status, $this_clone_remark, $this_project, $this_project_remark, $this_project_status, $this_project_status_remark, $this_project_finisher) = @_;
	my $cos;
	foreach $cos ( @{$self->{clones}} )  {

	    $interface->{canvas}->update;

	    # Clone colour
	    my $x;

	    if ($interface->{plot_options}->{colour_clone_status} eq 'clone'){
		$x = $$cos{status_colour};
	    } elsif ($interface->{plot_options}->{colour_clone_status} eq 'project'){
		$x = $$cos{project_status_colour};
	    } else {
		$x = 'blue';
	    }

	    my $left = "$$cos{leftpos}";
	    my $right = "$$cos{rightpos}";
	    my $addr = $$cos{clonename};


	    my $return;
	    if ($interface->{plot_options}->{show_names} eq 'yes'){
		$return = $contig->MapObject([[($left+$factor), ($right+$factor)]], '-color' => $x, '-label' => $addr, '-anchor' =>  'n', -labelfont => '-*-clean-*-r-*-*-12-*-*-*-*-*-*-*', '-width' => 8);

		$interface->{Find_Clone}->{$addr} = $return;
		
	    } else {
		$return = $contig->MapObject([[($left+$factor), ($right+$factor)]], '-color' => $x, '-width' => 8);
		$interface->{Find_Clone}->{$addr} = $return;
	    }
	    

	    if ($addr eq $clonename){
		$interface->{interesting_clone} = $return;
	    }


	    $interface->{canvas}->bind($return, '<1>' => sub {

		my $window = My_choice_Window->new($interface->{mainWindow}, $$cos{clonename}, $db, $$cos{project_status}, $$cos{project_name}, $dbh);

	    });
	    

            $interface->{canvas}->bind($return, '<Enter>' => sub {
		$$this_clone = $$cos{clonename};
		$$this_clone_status = $$cos{status_now};
		$$this_clone_remark = $$cos{remark};

		$$this_project = $$cos{project_name};
		$$this_project_remark = $$cos{project_remark};
		$$this_project_status = $$cos{project_status};
		$$this_project_status_remark = $$cos{project_status_remark};
		$$this_project_finisher = $$cos{project_finisher};
	    });

	}
    }


# ... and sort out the scrollable-region

my ($x1, $y1, $x2, $y2) = $interface->{canvas}->bbox("all");
#warn "------------------> $x1, $y1, $x2, $y2\n";
#$interface->{canvas}->configure(-scrollregion => [$interface->{canvas}->bbox("all")]);
$interface->{canvas}->configure(-scrollregion => [($x1 - 49), $y1, ($x2 + 49), $y2]);

$interface->{wd}->unShow;

}


sub add_contig {
    my ($self, $this_contig) = @_;
    $self->{contig}->{name} = $this_contig;
}

sub add_length {
    my ($self, $length) = @_;
    $self->{contig}->{extent_from} = $$length[0];
    $self->{contig}->{extent_to} = $$length[1];
}

sub check_length {
    my ($self, $length, $interface) = @_;
    my $from = $$length[0];
    my $to = $$length[1];
    if ($from == 0 && $to == 0){
	$interface->{cancel_test} = 1;
	# yelp
	&main::popup ($interface->{mainWindow}, "WARN", ["Sorry ! I cannot determine a length for this contig. Please cancel the plot."]);
    }

}

sub add_other_contig {
    my ($self, $on, $on_left, $on_right) = @_;
    $self->{contig}->{on_contig} = $on;
    $self->{contig}->{leftpos} = $on_left;
    $self->{contig}->{rightpos} = $on_right;
}

sub add_clones {
    my ($self, $clones) = @_;
    #warn $clones;
    $self->{clones} = $clones;
}



1;







