#!/usr/local/bin/perl
#
#######################################################################
# 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.                      #
#######################################################################
#
#$Id: create_pcr.pl,v 1.12 2004/02/12 10:45:23 kva Exp $
#
#############################################
# Program for tracking PCR's in the db.     #
#                                           #
# Enable finisher to enter their PCR        #
# templates with ease and have them         #
# tracked properly through the database.    #
#                                           #
# Author : Karen Ambrose                    #
#                                           #
#############################################
#
#
my $prog = 'create_pcr';

#use strict;
use WrapDBI;
use Tk;
use Data::Dumper;
use SDTable;

use finch2_general;
use owl_view_selector;
use var_monitor;
use NewBrowseEntry;
use BarcodeRevised;

use pcr_printmap;
#require '/nfs/griffin2/kva/badger-bin/finch/pcr_printmap.pm';

use pcr_general;
#require '/nfs/griffin2/kva/badger-bin/finch/pcr_general.pm';

# Fonts
my $title_f = "-adobe-helvetica-bold-r-normal--24-240-75-75-p-138-iso8859-1";
my $entry_f = "-adobe-helvetica-medium-r-normal--17-120-100-100-p-88-iso8859-1";
my $button_f = "-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1";
my $label_f = "-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1";

$ENV{'DISPLAY'} || die "$prog: \$DISPLAY environment variable not set, Please set via 'ncd' or 'dis' command.\n";

require 'badgerGetOpt.pl';
require Tk::Dialog;

$|=1;

my ($who);
$who = &user_who;
my $opts = {
    "-who" => {
        "type" => "text",
        "var" => \$who,
        "help" => "Specify user -DEBUGGING ONLY.",
       "def" => &user_who,
    }
};
&badgerGetOpt($prog,'',$opts) && die "Quit\n";

#Default printer
my $printer = $ENV{PRINTER};

my $plate_size;

# Map selection phase
my $maps_tot;
my $view = 1;
my $merge_view;
my @sel_maps = ();
my $maplist;
my $map_structure;
my $maps_used; 
my $gridframe;
my $map_display;
my $map_phase_indicator;
my $second_frame;
my $width;
my $height;
my $update_frame;
my $update_screen;
my $cost_info;
my $empty_frame;
my $PROJECT;
my $TYPE;
my $p1;
my $p2;
my $primernames;
my $primer_one;
my $primer_two;
my $project;
my $type_src;
my @ts;
#my @ts = ("Genomic","Clone"); #replace this with an sql statement at a later date.
my $template;
my $pcr_temp;
my $rem_entry;
my $remark;
my $well_no;
my $well_lab;
my $well;
my %WELLCONTENTS;
my %WELLREMARKS;
my %WELLTYPE;
my %WELLSEQ1;
my %WELLSEQ2;
my %WELLCOSTCODE;
my %WELLCOMBI;
my %hash;
my %REVERSE;
my $primerseq_one;
my $ps1;
my $primerseq_two;
my $ps2;
my $vessel_info;
my $tube_no;
my $select_color=0;
my $old_proj;
my $COSTCODE;
my $combi;
my $hash;
#my $thiswidget;
my $entrywidget;
my $old_widget;
my $old_tester;
my %PROBLEMS;
my @map_new_blocks;
my @map_select_blocks;

$hash = {
    "1" => "a",
    "2" => "b",
    "3" => "c",
    "4" => "d",
    "5" => "e",
    "6" => "f",
    "7" => "g",
    "8" => "h",
    "9" => "i",
    "10" => "j",
    "11" => "k",
    "12" => "l",
    "13" => "m",
    "14" => "n",
    "15" => "o",
    "16" => "p",
};

###################################################
# BUILD THE MAIN WINDOW                           # 
###################################################
my $mainWindow = MainWindow->new;
$mainWindow-> configure(cursor  => 'hand2');
$mainWindow->wm('minsize', 800, 890); 
$mainWindow->wm('maxsize', 800, 890);
$mainWindow->packPropagate(0);

# DD
#my $db = 'finch';
my $db = 'trackingclone1';

my $dbh = WrapDBI->connect("$db", {RaiseError => 1});    
$dbh->{autocommit} = 0;
print STDOUT "create_pcr started...\n";

# Barcode printer info
my $barcode_printer = Barcode->new($dbh);
$barcode_printer->Type("PV");
$barcode_printer->User("$who");

# Determine whether the user is logged on as the team-account first;
if (check->team_account($dbh, $who)){
    # This is a recognised team-account
    # ID_ROLE ? - who are we dealing with here ?
    my $user_acct = $who;
    $who = '';
    my $who_win = $mainWindow->Toplevel;
    $who_win->configure (-title => "Please provide information.");
    my $who_frame = $who_win->Frame();
    my $who_label = $who_frame->Label(-text => "You are logged in as the team account $user_acct.\nPlease give your personal login and hit return.", -font => $label_f);
    $who_label->pack(-side=> 'top');
    my $who_entry = $who_frame->Entry(-textvariable => \$who, -bg => 'honeydew2', -font => $entry_f);
    $who_entry->pack(-side => 'top');
    $who_entry->focusForce;
    $who_entry->bind ('<Return>' => sub { 
	$who_win->destroy;
    } );
    $who_entry->configure (-width => 50);
    $who_frame->pack;
    $who_frame->waitWindow;
}


my $id_person = get->id_person_from_person($dbh, $who);
unless ( defined $id_person){
    popup ($mainWindow,"STOP", ["CONTACT BUG. You are not registered in Oracle's PERSON table. \n"]);
    die;
}

# Find out relevant id_role
# Note that this person could be a finisher for multiple teams
my ($id_role, $teamname) = get->id_person2id_role($dbh, $id_person, $mainWindow, $label_f);
unless ( (defined $id_role) && (defined $teamname) ){	
    popup ($mainWindow,"STOP", ["CONTACT BUG. You are not registered in Oracle's TEAM_PERSON_ROLE table as a Finisher. \n"]);
    die;
}

# What is the initial choice for the user's finishing service ?
my $possibles = get->submission_options_for_team($dbh, $teamname);

#####################################################
# Sort out duplication wrt. $FSNAME -> $request_view
#####################################################

my $initial = 1;
my ($ID_TEAM_FINSERV, $FSNAME, $request_view);
my $ch;

if ($ch){
    &selector_info($ch);
}else{
    &get_view_selector;
}
$initial = 0;

sub get_view_selector {
    #################################################################
    # Need to sort out the fonts in owl_view_selector->view_selector
    #################################################################
    ($ch) = &view_selector($mainWindow, $possibles);
    if (($ch eq 'None') && ($initial == 1)) {
        die;
    }
    if (($ch eq 'None') && ($initial == 0)) {
        return;
    }
    unless ( ($ch =~ /^(\S+)_id_(\S+)/) || ($ch =~ /^(\S+\s+\S+)_id_(\S+)/) ) {
        die "Contact bug. Cannot parse $ch !\n";
    }
    $ID_TEAM_FINSERV = $2;
    $FSNAME = $1;
    $request_view = $FSNAME;
}

# Get the sessionid               
my $session_id = get->new_session_id($dbh);

my $COSTCODE="Select cost-code";
# We need to get a list of costcodes that relate to a team.
my $costcodes_per_team = get->teamcostcodes($teamname, $dbh, $who);

# counts the number of costcodes assigned to each team
my $team_count=@$costcodes_per_team;

#start up plate size as default.
$plate_size='96';

#Defines the vessel descriptor used in the interface.
if ($plate_size == 12){
    $vessel_info = "Tube Number";
} else {
    $vessel_info = "Well Number";
}

#Get the pcr types stored in the database.
my $ref_ptpe = lookup->pcr_type($dbh);
@ts = @$ref_ptpe;

#Generate the interface fom various piseces.
&top_piece();
&blockmenu();
&update_frame();
&displaymap();
&template_gen();
&selection();

#Monitor changes of variables
&monitor(\$plate_size, 'plate_size_var', \&mon);    
&monitor(\$PROJECT, 'project_selection', \&mon2);
&monitor(\$p2, 'second_primer_selection', \&mon3);
&monitor(\$TYPE, 'pcr_type', \&mon4);
&monitor(\$p1, 'first_primer_selection', \&mon5);
&monitor(\$COSTCODE, 'costcode_selection', \&mon7);
&monitor(\$combi, 'is_combinatorial', \&mon9);

######################################################
#If the number of costcodes a team has is only one, 
#it automatically defaults to the costcode.
######################################################
if ($team_count == '1'){
    $COSTCODE=pop(@$costcodes_per_team);
}


MainLoop();


###############
# Subroutines #
###############


sub mon {

    %WELLCONTENTS=();
    %WELLREMARKS=();
    %WELLTYPE=();
    %WELLSEQ1=();
    %WELLSEQ2=();
    %WELLCOSTCODE=();
    %WELLCOMBI=();
    %PROBLEMS=();

    $project->delete(0,'end');
    $type_src->delete(0,'end');
    $primer_one->delete(0,'end');
    $primerseq_one->delete(0,'end');
    $primer_two->delete(0,'end');
    $primerseq_two->delete(0,'end');
    $template->delete(0,'end');
    $rem_entry->delete(0,'end');

    $well_no="";
    $tube_no="";
    $pcr_temp="";
    $remark="";
    $combi = 'No';

    $gridframe->destroy();
    $empty_frame->destroy();
    $second_frame->destroy();

    if ($plate_size == 12){
        $vessel_info = "Tube Number";
        &update("Individual tubes have been selected.");
    } else {
        $vessel_info = "Well Number";
        &update("Plate size has been set to $plate_size well.");
    }
    
    &update("Done.");
    $update_screen->update('idletasks');
    
    &displaymap();
    &template_gen();
    
}

sub mon2 {

#    print "PROJECT IS THE :-$PROJECT\n";

    if ($PROJECT=~ /Select a project/) {
        #print "SUPPOSED TO BE HERE!!\n";
        #Should reset the menus.
	
    } else {
        
#	print "WELL NO :- $well_no, color selection :- $select_color\n";
	
	if ((!$well_no) || ($select_color == 0)){
            popup ($mainWindow,"STOP", ["Please select a well or tube number from the grid. \n"]);
            $PROJECT="Select a project";
            return();
            
        } else {
            
            $PROJECT=~ s/\s+//g;
            $old_proj=~ s/\s+//g;
#            print "PROJECT:-$PROJECT, OLDPROJECT:-$old_proj\n";
            
            if ($WELLCONTENTS{$well_no}){ 
                if ($old_proj ne $PROJECT){         
                    $primer_one->delete(0,'end');
                    $primer_two->delete(0,'end');
                    $primernames = lookup->get_primers($dbh,$PROJECT);
                    $primer_one->insert('end',@{$primernames});
                    $primer_two->insert('end',@{$primernames});
                    $p1 = "";
                    $p2 = "";
                    $ps1= '';
                    $ps2= '';
                    $old_proj=$PROJECT;       
                } 
                
            } else {
             
                $primer_one->delete(0,'end');
                $primer_two->delete(0,'end');
                $primernames = lookup->get_primers($dbh,$PROJECT);
                $primer_one->insert('end',@{$primernames});
                $primer_two->insert('end',@{$primernames});
                $p1 = "";
                $p2 = "";
                $ps1= '';
                $ps2= '';
                $old_proj=$PROJECT;       
            }
        }
        
    }
    
}


sub mon3 {
    
    if (($PROJECT=~ /Select a project/) || ($p2 eq '')) {
        #print "SUPPOSED TO BE HERE!!\n";
        #Should reset the menus.
	
    } else {
        
        my $count = length($p2);
        if ($count > 4){
            popup ($mainWindow,"STOP", ["The primername is greater than 4 characters, please reduce to 4 characters or less. \n"]);
            return;
        } else {
            $ps2=lookup->get_primerseq($dbh,$PROJECT,$p2);
        }
    }
    
}

sub mon4 {
    
    if ($PROJECT=~ /Select a project/) {
        #print "SUPPOSED TO BE HERE!!\n";
        #Should reset the menus.
        
    } else {  
        
#        print ">>TYPE :- $WELLTYPE{$well_no}<<\n";	
        if (! defined ($WELLTYPE{$well_no})){
            $WELLTYPE{$well_no}=$TYPE;
#            print "----------------------------------------->\n";
#            print Data::Dumper::Dumper(\%WELLTYPE);
#            print "----------------------------------------->\n";
        } else {
            my $old_type =$WELLTYPE{$well_no};
            my $new_type = $TYPE;
            $old_type=~ s/\s+//g;
            $new_type=~ s/\s+//g;
#            print ">>compare $old_type TO $new_type<<\n";
            if (($old_type ne $new_type) && ($old_type ne "") && ($new_type ne "")){
                delete($WELLTYPE{$well_no});
#                print ">>in here $new_type defined<<\n";
                $WELLTYPE{$well_no} = $new_type;
                #$TYPE=$new_type;
            }
        }
    }
}   


sub mon5 {
    
    if (($PROJECT=~ /Select a project/) || ($p1 eq '')) {
        #print "SUPPOSED TO BE HERE!!\n";
        #Should reset the menus.
	
    } else {
	
        my $count = length($p1);
        if ($count > 4){
            popup ($mainWindow,"STOP", ["The primername is greater than 4 characters, please reduce to 4 characters or less. \n"]);
            return;
        } else {
            $ps1=lookup->get_primerseq($dbh,$PROJECT,$p1);
        }
    }
    
}

sub mon6 {  
    
#    print "project set:- $PROJECT\n";
    my $entry1 = $primerseq_one->get();
    my $entry2 = $primerseq_two->get();
#    print "my entry is:-$entry\n";
    
    if ($PROJECT=~ /Select a project/){
	popup ($mainWindow,"STOP", ["Please select a project and then reselect/reenter the primer information. \n"]);
	return;
    } 
    
    elsif (($entry1=~ /Display or enter primerseq1./) || ($entry1 eq "") || ($entry2=~ /Display or enter primerseq2./) || ($entry2 eq "")){
	popup ($mainWindow,"STOP", ["Please select a primer or enter new information. \n"]);
	return;
	
    } else {
	
        $well_no=~ /(\D+)(\d+)/;
        my $let = $1;
        my $num = $2;
        %REVERSE = reverse %$hash;
        my $check = $REVERSE{$let};
        $entrywidget->[$check]->[$num]->configure(-background=>'blue');
        
	if (! defined ($WELLCONTENTS{$well_no})){
	    $pcr_temp = $PROJECT.'_'.$p1.'_'.$p2;
	    $WELLCONTENTS{$well_no}=$pcr_temp;
	} else {
	    my $old_contents = $WELLCONTENTS{$well_no};
	    my $new_contents = $PROJECT.'_'.$p1.'_'.$p2;
	    if ($old_contents ne $new_contents){
                delete($WELLCONTENTS{$well_no});
		$WELLCONTENTS{$well_no}=$new_contents;
		$pcr_temp = $new_contents; 
	    }
	}
	
	if (! defined ($WELLSEQ1{$well_no})){
	    unless ($ps1) {
		$ps1 = $primerseq_one->get;
            }
	    $WELLSEQ1{$well_no}=$p1.'_'.$ps1;  
	    
	} else {
	    
	    my $old_seq = $WELLSEQ1{$well_no};
	    $ps1 = $primerseq_one->get;
	    my $new_seq =$p1.'_'.$ps1; 
	    if ($old_seq ne $new_seq) {
                delete($WELLSEQ1{$well_no});
		$WELLSEQ1{$well_no} = $new_seq;
	    }
	    
	}
	
	
	if (! defined ($WELLSEQ2{$well_no})){
	    $WELLSEQ2{$well_no}=$p2.'_'.$ps2;
	    
	} else {
	    
	    my $old_seq = $WELLSEQ2{$well_no}; 
	    $ps2 = $primerseq_two->get; 
	    my $new_seq =$p2.'_'.$ps2; 
	    if ($old_seq ne $new_seq) {
                delete($WELLSEQ2{$well_no});
		$WELLSEQ2{$well_no} = $new_seq;
	    }
	    
	}
	

        if (! defined ($WELLTYPE{$well_no})){
            $WELLTYPE{$well_no}=$TYPE;

        } else {
            my $old_type =$WELLTYPE{$well_no};
            my $new_type = $TYPE;
            $old_type=~ s/\s+//g;
            $new_type=~ s/\s+//g;
#            print ">>compare $old_type TO $new_type<<\n";
            if (($old_type ne $new_type) && ($old_type ne "") && ($new_type ne "")){
                delete($WELLTYPE{$well_no});
#                print ">>in here $new_type defined<<\n";
                $WELLTYPE{$well_no} = $new_type;
            }
        }
        
        if (! defined ($WELLCOSTCODE{$well_no})){
	    $WELLCOSTCODE{$well_no}=$COSTCODE;
	}   else {
            my $old_type =$WELLCOSTCODE{$well_no};
            my $new_type = $COSTCODE;
            $old_type=~ s/\s+//g;
            $new_type=~ s/\s+//g;
#            print ">>compare COSTCODE $old_type TO $new_type<<\n";
            if (($old_type ne $new_type) && ($old_type ne "") && ($new_type ne "")){
                delete($WELLCOSTCODE{$well_no});
#                print ">>in here $new_type costcode defined<<\n";
                $WELLCOSTCODE{$well_no} = $new_type;
            }
        }
	
# 	print "general combi set = $combi\n";
	if (! defined ($WELLCOMBI{$well_no})){
	    $WELLCOMBI{$well_no} = $combi;
	} else {
	    my $old_combi = $WELLCOMBI{$well_no};
	    my $new_combi = $combi;
#	    print "old combi set = $old_combi\n";
#           print "new combi set = $new_combi\n";
	    if ($old_combi ne $new_combi){
		delete($WELLCOMBI{$well_no});
		$WELLCOMBI{$well_no} = $new_combi;
	    }
	}
	
    }   
}


sub mon7 {
    
    if ((!$well_no) || ($select_color == 0)){
	popup ($mainWindow,"STOP", ["Please select a well or tube number from the grid. \n"]);
	$COSTCODE="Select cost-code";
	return();
    } else {
        
        if (! defined ($WELLCOSTCODE{$well_no})){
	    $WELLCOSTCODE{$well_no}=$COSTCODE;
	}   else {
            my $old_type =$WELLCOSTCODE{$well_no};
            my $new_type = $COSTCODE;
            $old_type=~ s/\s+//g;
            $new_type=~ s/\s+//g;
#            print ">>compare COSTCODE $old_type TO $new_type<<\n";
            if (($old_type ne $new_type) && ($old_type ne "") && ($new_type ne "")){
                delete($WELLCOSTCODE{$well_no});
#                print ">>in here $new_type costcode defined<<\n";
                $WELLCOSTCODE{$well_no} = $new_type;
            }
        }     
	
    }
    
}

sub mon8 {
    
    if ($PROJECT=~ /Select a project/) {
        #print "SUPPOSED TO BE HERE!!\n";
        #Should reset the menus.
        
    } else {  
        
        my $remark = $rem_entry->get();  
#        print ">>$remark<<";
        if ($remark=~ /\"|\'|\\/g){
            popup($mainWindow,"STOP", ["Remark field contains unauthorized characters. Please remove and press enter in entry box. \n"]);
            return;
	} else {
            
            if (($remark) && ($WELLCONTENTS{$well_no})){
                if (($WELLREMARKS{$well_no}) ne ""){
                    my $check_remark1 = $WELLREMARKS{$well_no};
                    my $check_remark2 = $remark;
                    $check_remark1 =~ s/\s+//g;
                    $check_remark2 =~ s/\s+//g;
                    my @numeric_ascii1=unpack("C*", $check_remark1);
                    my @numeric_ascii2=unpack("C*", $check_remark2);
                    my $ascii_total1;
                    my $ascii_total2;
                    my $pos1 = 0;
                    my $pos2 = 0;
                    foreach (@numeric_ascii1){
                        $pos1++;
                        my $add = $_*$pos1;
                        $ascii_total1+=$add;
                    }   
                    foreach (@numeric_ascii2){
                        $pos2++;
                        my $add = $_*$pos2;
                        $ascii_total2+=$add;
                    }      
                    if ($ascii_total1 ne $ascii_total2){
#                        print "$ascii_total1 not equal $ascii_total2, changes to be made";
                        delete($WELLREMARKS{$well_no});
                        $WELLREMARKS{$well_no}=$remark;  
                    } else {
#                        print "$ascii_total1 equal $ascii_total2, no changes to be made";
                    }
                    
                } else {
#                    print "Just entering new info into remarks field for $well_no\n";
                    $WELLREMARKS{$well_no}=$remark;
                }
            }
        }
    }
}

sub mon9 {
    
#    print ">>well_no :- $well_no\\n";
  
#    print "mon9 general combi set = $combi\n";
    if (! defined ($WELLCOMBI{$well_no})){
	$WELLCOMBI{$well_no} = $combi;
    } else {
	my $old_combi = $WELLCOMBI{$well_no};
	my $new_combi = $combi;
#	print "old combi set = $old_combi\n";
#	print "new combi set = $new_combi\n";
	if ($old_combi ne $new_combi){
	    delete($WELLCOMBI{$well_no});
	    $WELLCOMBI{$well_no} = $new_combi;
	}
    }

}


sub general_clean {
    
    $pcr_temp="";
    $remark="";
    
}


sub update_frame {
    
# Update frame
    $update_frame = $mainWindow->Frame()->pack(-side => 'top', -fill => 'x');
    $update_screen = $update_frame->ScrlListbox (-font => $button_f,
                                                 -bg => 'white',
                                                 -scrollbars => 'e',
                                                 -label => "Update",
                                                 -height => 3,
                                                 -width => 30
                                                 )->pack(-side => 'top', -fill => 'x');
}


sub popup {
    my ($mainWindow, $title, $mesgref) = @_;
    my $mesg = join ("\n", @$mesgref);
    my $dialog = $mainWindow->Dialog (-title => "$title",
                                      -text => "$mesg",
                                      -default_button => '1',
                                      -buttons => ['OK']);
    $dialog->Show();
}

sub user_who {
    my $who;
    $who =`whoami`;
    chop ($who);
    return $who;
}


sub get_print_menu {

    my($map_new_blocks) = printinfo->get_created_pcr($dbh,$teamname);
    my @to_print_LP;

    my $main= MainWindow->new;
    my $print_win = $main;
    $print_win->configure (-title => "Please select the pcr maps to print.");
    $print_win->wm('minsize', 600, 645); 
    $print_win->wm('maxsize', 600, 645);
    $print_win->packPropagate(0);
    
    my $menuBar_frame = $main->Frame(-bg => 'grey77');
    $menuBar_frame->pack(-side => 'top', -fill => 'x');
    my $print_optsMenu = $menuBar_frame->Menubutton(-bg => 'grey77', -text => 'Printing options', -underline => 0);
    $print_optsMenu->configure(-menu => $print_optsMenu ->Menu(-tearoff => 0));
    $print_optsMenu->command(-label => 'Printer', -underline => 0, -command => sub{
	# A new window to enter printer-info
	my $prn_win = $main->Toplevel;
	$prn_win->configure (-title => "Please provide information.");
	my $prn_frame = $prn_win->Frame();
	my $prn_label = $prn_frame->Label(-text => "New default printer");
	$prn_label->pack(-side=> 'top');
	my $prn_entry = $prn_frame->Entry(-textvariable => \$printer, -bg => 'honeydew2');
	$prn_entry->pack(-side => 'left');
	$prn_entry->bind ('<Return>' => sub { 
	    $printer=$prn_entry->get();
            my $printer_test = &printer_check($printer);
            if ($printer_test == 1){
                &popup ($mainWindow, "Warn", ["Printer $printer cannot be found or cannot be connected to on this network."]);
            } elsif ($printer_test == 2){
                #leave the printer entry box open
                #to submit another printer name.
            } else {
                &update("Default printer set to $printer.");
                $update_screen->update('idletasks');
                $prn_win->destroy;
            }
        } );
	$prn_entry->configure (-width => 10);
	$prn_frame->pack;
    });
    $print_optsMenu->command(-label => 'Barcode Printer', -underline => 0, -command => sub{
        $barcode_printer->Viewprinters();
    });
    $print_optsMenu->pack(-side=>'left');
    
    my($val1,$val2);
    my $option_frame = $print_win->Frame(-borderwidth=>'2', -relief=> 'sunken');
    my $cb_map = $option_frame->Checkbutton(-text=>"Print Maps",
                                            -font => $button_f,
                                            -variable => \$val1,
                                            -onvalue => 1,
                                            -state=>'active')->pack(-side => 'left', -anchor =>'w');
    my $cb_barcode = $option_frame->Checkbutton(-text=>"Print Barcodes",
                                                -font => $button_f,
                                                -variable => \$val2,
                                                -onvalue => 1,
                                                -state=>'active')->pack(-side => 'right', -anchor =>'w');
    $cb_map->select();
    $cb_barcode->select();
    $option_frame->pack(-side=>'top');
    
    my @map_blocks;
    my $map_scrlframe = $print_win->Frame();
    $map_scrlframe->pack(-side => 'top', -expand => 'yes', -fill => 'both');
    my $map_blocklist = $map_scrlframe->ScrlListbox (
                                                     -bg => 'lemonchiffon1',
                                                     -scrollbars => 'e',
                                                     -label => 'pcr maps available',
                                                     -height => 10,
                                                     -width => 10
                                                     ); 
    
    my $map_selectlist = $map_scrlframe->ScrlListbox (
                                                      -bg => 'lemonchiffon2',
                                                      -scrollbars => 'e',
                                                      -label => "selected maps for printing.",
                                                      -height => 10,
                                                      -width => 10
                                                      );
    
    
    @map_new_blocks=@$map_new_blocks;
    $map_blocklist->bind ('<Double-Button-1>' => sub { &maplist_selector($map_blocklist, $map_selectlist)} );
    $map_selectlist->bind ('<Double-Button-1>' => sub { &maplist_deselector($map_blocklist, $map_selectlist)} );
    
    $map_blocklist->pack(-side => 'left', -expand => 1, -fill => 'both');
    $map_blocklist->insert('end', @map_new_blocks); 
    $map_selectlist->pack(-side => 'left', -expand => 1, -fill => 'both');
    $map_selectlist->insert('end', @map_select_blocks);
    
    my $button_frame = $print_win->Frame(-borderwidth=>'2', -relief=> 'sunken');
    
    my $print_button = $button_frame->Button(-text=>'Print selected maps', -command=> sub {
        my $printer_var = $barcode_printer->Printer();
        print "Barcode printer set to : - $printer_var.\n";
        print "Default printer set to : - $printer.\n";
        print "MAP value selection: - $val1.\n";
        print "BARCODE value selection : - $val2.\n";
        print "Selection : - @map_select_blocks.\n";
        
        if ($#map_select_blocks == -1){
            &popup ($mainWindow, "Warn", ["Please select some maps first.\n"]);
        }
        elsif (($val1 == 0) && ($val2 == 0)){
            &popup ($mainWindow, "Warn", ["Non of the above checkboxes have been selected.\n"]); 
        }    
        elsif ((!$printer_var) && ($val2 == 1) && (!$printer) && ($val1 == 1)){
            &popup ($mainWindow, "Warn", ["Non of the printers have been set.\n"]);
        }    
        elsif ((!$printer) && ($val1 == 1)){
            &popup ($mainWindow, "Warn", ["Default printer has not been set.\n"]);
        } 
        elsif ((!$printer_var) && ($val2 == 1)){
            &popup ($mainWindow, "Warn", ["Barcode printer has not been selected.\n"]);
        } else { 
            
            my @pcr_ids;
            foreach my $msb (@map_select_blocks){
#                       print ">>$msb<<\n";
                $msb =~ /(\d+)\s+\S+\s+\S+/g;
                my $id = $1;
                push @pcr_ids,$id;
            }
#                   print ">>revised selection :- @pcr_ids<<\n";
            
            if ($val2 == 1){
                &update("Barcode printer set to $printer_var.");
                $update_screen->update('idletasks');
            }
            my $date = get->today($dbh);
            
            #update and insert new entries 
            #for the pcr_vessel status.
            eval {
                my $ids;
                $ids = \@pcr_ids;
                printinfo->update_status($dbh,$session_id,$who,$prog,$ids);
            };
            if ($@){
                $dbh->rollback();
                &update("Errors were detected when altering data, and have been rolled back. Please contact bug.");
                $update_screen->update('idletasks');
                return;
            } else {
                $dbh->commit();
            }
            
            #then if barcode option selected print to barcode
            if ($val2 == 1) {
                my $format;
                if ($plate_size == 12){
                    $format = "1";
                } else {
                    $format = $plate_size;
                }
                foreach my $pids (@pcr_ids) { 
                    my $name = "pcr"."_".$pids;
                    my %to_go = ("Barcode" => "$pids",
                                 "Owner" => "$teamname",
                                 "Name" => "$name",
                                 # we can use this field for the relevant id_mapplate
                                 #"Project" => "map:$map",
                                 # we can use this field for machine-type(protocol)
                                 #"Suffix" => "$machine",
                                 "Format" => "$format",
                                 );
                    
                    push @to_print_LP, \%to_go;
                }
                
                my @loadingplates;
                foreach my $p (@to_print_LP){
                    push @loadingplates, $p->{Barcode};
                    $barcode_printer->Date("$date");
                    $barcode_printer->Barcode("$p->{Barcode}");
                    $barcode_printer->Owner("$p->{Owner}");
                    $barcode_printer->Name("$p->{Name}");
                    $barcode_printer->Format("$p->{Format}");
                    $barcode_printer->Labellist();   
                }
                
                &update("Now printing stickers to barcode printer.");
                $update_screen->update('idletasks');
                eval {
                    $barcode_printer->Printlabel();
                };
                my $printer_var = $barcode_printer->Printer();
                if ($@) {
                    &update("Problems printing. Contact bug.");
                    &update("$@");
                    $update_screen->update('idletasks');
                    return();
                }
            }
            
            #then if map option selected print to map
            #my $outfile = '/nfs/griffin2/kva/badger-bin/finch/pcr2_output.ps';
            my $outfile = 'None';
            my $pcr_id = \@pcr_ids;
            if ($val1 == 1){
   
                eval {
                    &pcr_printmap::pcrmaps_out($dbh, $pcr_id, $printer,$prog,$outfile);
                };
                if ($@){
                    &update("Problems printing. Contact bug.");
                    &update("$@");
                    $update_screen->update('idletasks');
                } else {
                    &update("PCR printouts have been sent to $printer.");
                    $update_screen->update('idletasks');
                }
                
            }
            #delete the entries from the select window.
            my @new_select = ();
            $map_selectlist->delete('0', 'end');
            my $next;
            foreach $next (@map_select_blocks){
                unless ($next eq $next) {
                    push @new_select, $next;
                }
            }
            @map_select_blocks = @new_select;
            $map_selectlist->insert('end', @map_select_blocks);
            
        }
        
    })->pack(-side=>'right');

    my $update_button = $button_frame->Button(-text=>'Update',-command=> sub {
        &map_fill_blocklist($map_blocklist, $map_selectlist);
    })->pack(-side=>'right');
    
    my $selectall_button = $button_frame->Button( -text => 'Select all',
                                                  -command => sub { &maplist_selectall($map_blocklist, $map_selectlist); });
    $selectall_button->pack(-side => 'right');
    
    my $deselectall_button = $button_frame->Button( -text => 'Deselect all',
                                                    -command => sub { @map_new_blocks = ();
                                                                      &map_fill_blocklist($map_blocklist, $map_selectlist);
                                                                  });
    $deselectall_button->pack(-side => 'right');
    
    my $exit_button = $button_frame->Button(-text=>'Exit', -command=> sub {$print_win->destroy; })->pack(-side=>'right');
    $button_frame->pack(-side=>'bottom');
    
}


sub maplist_selector {
    my ($map_blocklist, $map_selectlist) = @_;
    my @map_new_blocks2 = ();
    my $map_blockname = $map_blocklist->get('active');
    if ($map_blockname eq ''){
	return;
    }
    # we need to add $map_blockname to the $map_selectlist 
    # and re-show $map_blocklist without it
    $map_blocklist->delete ('0', 'end');
    # remake @new_blocks without $blockname
    my $next;
    foreach $next (@map_new_blocks){
	unless ($next eq $map_blockname) {
	    push @map_new_blocks2, $next;
	}
    }
    
    @map_new_blocks = @map_new_blocks2;
    $map_blocklist->insert('end', @map_new_blocks);
    # remake $selectlist with $blockname
    $map_selectlist->delete ('0', 'end');
    
    push @map_select_blocks, $map_blockname;
    $map_selectlist->insert('end', @map_select_blocks);
    
}

sub maplist_deselector {
    my ($map_blocklist, $map_selectlist) = @_;
    my @map_new_select = ();
    my $map_blockname = $map_selectlist->get('active');
    if ($map_blockname eq ''){
	return;
    }
    
    # Remake the select list with new print maps, that may have just
    # been created for printing, along with those that still remain 
    # at the printing stage.
    $map_selectlist->delete ('0', 'end');
    my $next;
    foreach $next (@map_select_blocks){
	unless ($next eq $map_blockname) {
	    push @map_new_select, $next;
	}
    }
    @map_select_blocks = @map_new_select;
    $map_selectlist->insert('end', @map_select_blocks);
    
    # remake $map_blocklist with @map_new_blocks re-added
    $map_blocklist->delete ('0', 'end');
    push @map_new_blocks, $map_blockname;
    $map_blocklist->insert('end', @map_new_blocks);
    
}

sub maplist_selectall {
    my ($map_blocklist, $map_selectlist) = @_;
    my @map_new_blocks2 = ();
    
    # clear the selectlist
    $map_selectlist->delete ('0', 'end');
    @map_select_blocks = (@map_select_blocks, @map_new_blocks);
    $map_selectlist->insert('end', @map_select_blocks);
    $map_blocklist->delete ('0', 'end');
    @map_new_blocks = ();
}

sub map_fill_blocklist {
    
    # Fills the left hand block container (the selection) with maps
    my ($map_blocklist, $map_selectlist) = @_;

    @map_new_blocks=();
    @map_select_blocks=();
    $map_blocklist->delete ('0', 'end');
    $map_selectlist->delete ('0', 'end');
    my $map_new_blocks = printinfo->get_created_pcr($dbh,$teamname);
    @map_new_blocks=@$map_new_blocks;
    $map_blocklist->insert('end', @map_new_blocks);
    $map_selectlist->insert('end', @map_select_blocks);
    
}


sub printer_check {
    
    my($printer)=@_;
    
    $printer=~ s/\s+//g;
    if ($printer eq '') { 
        &popup ($mainWindow, "Warn", ["Please specify a printer."]);
        return 2;    
    } else {
        my $allreturn=`lpq -P $printer`;
        my @allreturn=split(/\n/,$allreturn);
        my $last=pop @allreturn;
        
        if (($last=~ /cannot open connection.+/)||($last=~ /no spool directory for printer.+/)){
            #print "No connection could be found, please try another printer.";
            return 1;
        }else{
            foreach (@allreturn){
                if ($_=~ /(stalled|hold)/){
                    my $return2 = &add_popup($mainWindow, "Warn", ["There are jobs that are stalled or on hold, do you wish to continue?."]);
                    if ($return2 == 0) {
                        return 0;
                    }else{
                        &popup ($mainWindow, "Warn", ["Reselect an active printer."]); 
                        return 2;
                    }
                }
            }
            #print "A connection has been established";
            return 0;
        }
    }
    
}


sub top_piece {
    
    #Comprises of the header information
    #i.e which finisher, team and destination.
    my $header_info = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3')->pack(-side => 'top');
    $header_info->Label(-font => $title_f,
                        -text => "Finisher is $who from TEAM $teamname.  DESTINATION:",
                        "-height" => 1 )->pack(-side => 'left');
    
    #Destination-box
    my $proj_dest = $header_info->Entry(-font => $title_f, 
                                        -bg => 'honeydew2', 
                                        -width => 20, 
                                        -textvariable => \$FSNAME, 
                                        -state => 'disabled')->pack(-side => 'left');
    
}

sub blockmenu {
    
#menu bar for added functionality
    my $menuBar1 = $mainWindow->Frame(-bg => 'grey77');
    $menuBar1->pack(-side => 'top', -fill => 'x');
    
#file functions menu
    my $fileMenu1 = $menuBar1->Menubutton(-bg => 'grey77', -text => 'File', -underline => 0);
    $fileMenu1->configure(-menu => $fileMenu1 ->Menu(tearoff => 0));
    $fileMenu1->command(-label => 'Quit', 
			-underline => 0,
			-command => sub{ exit; });
    $fileMenu1->pack(-side => 'left');
    
#Create an update window-menu
    my $updateMenu = $menuBar1->Menubutton(-bg => 'grey77', -text => 'Update Window', -underline => 0);
    $updateMenu->configure(-menu => $updateMenu ->Menu(-tearoff => 0));
    $updateMenu->command(-label => 'Clear the update window',
			 -underline => 0, -command =>sub {
			     &update_clear();
			     $update_screen->update('idletasks');
			 });
    $updateMenu->pack(-side => 'left');
    
#Change the database view
    my $dbview = $menuBar1->Menubutton(-bg => 'grey77', -text => 'Database View', -underline => 0);
    $dbview->configure(-menu => $dbview ->Menu(-tearoff => 0));
    $dbview->command(-label => 'Change current database view', -underline => 0, -command => sub{
	&get_view_selector;
    });
    $dbview->pack(-side => 'left');
    
# Create a mapping-options menu
    my $mapopts = $menuBar1->Menubutton(-bg => 'grey77', -text => 'PCR options', -underline => 0);
    $mapopts ->configure(-menu => $mapopts ->Menu(-tearoff => 0));
    my $menu_ob = 'Single pcr products';
    $mapopts ->command(-label => $menu_ob, -underline => 0, -command => sub{ 
        $plate_size=12;
        &mon; 
    });
    my $menu_rb = 'Specify maximum plate capacity';
    $mapopts ->cascade(-label => $menu_rb, -underline => 0);
    my $rm = $mapopts ->cget(-menu);
    my $rc = $rm->Menu(-tearoff => 0);
    $mapopts ->entryconfigure($menu_rb, -menu => $rc );
    
    # We don't want to allow 384 well plates yet
    # well may be for a test
    foreach my $label (qw(96 384)) {
        #foreach $label (qw(96)) {
	$rc->radiobutton(-label    => "$label",
			 -variable => \$plate_size,
			 -value    => $label,
			 );
    }

#deal with the invoke statement this may be affecting it.
#    $rc->invoke(0);
    $mapopts->pack(-side => 'left');
    
#Printmenu options
    my $printMenu = $menuBar1->Menubutton(-bg => 'grey77', -text => 'Print', -underline => 0);
    $printMenu->configure(-menu => $printMenu ->Menu(-tearoff => 0));
    my $pmenu_ob1 = "Print pcr maps and barcodes";
    $printMenu->command(-label => $pmenu_ob1, -underline => 0, -command => sub{ &get_print_menu;} );
    $printMenu->pack(-side => 'left');
    
#Help menu options
    my $helpMenu = $menuBar1->Menubutton(-bg => 'grey77', -text => 'Help', -underline => 0);
    $helpMenu->configure(-menu => $helpMenu ->Menu(-tearoff => 0));
    $helpMenu->command(-label => 'Contact Bug', -underline => 0, -command => sub{ `bug`;} );
    $helpMenu->pack(-side => 'right');
    
}


sub displaymap {
    
    # need a frame to put our plate in
    if ($plate_size == 96){
        $gridframe = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3', -height => '500', -width => '820');
    } 
    elsif ($plate_size == 12){
        $gridframe = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3', -height => '200', -width => '820');
    } 
    else {
        $gridframe = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3', -height => '840', -width => '820');
    }
    
    $gridframe->pack(-side => 'top');
    my $title_column;
    
    # How big is the vessel going to be >?< 
    if ($plate_size == 12){
        $width = 12;
        $height = 1;
    }
    
    if ($plate_size == 96){
	$width = 12;
	$height = 8;
    }
    
    if ($plate_size == 384){
	$width = 12*2;
	$height = 8*2;
    }			
    
    #   my %titlewidget;
    foreach $title_column (0 .. $width){
	$titlewidget[$title_column] = $gridframe->Entry(-width => '2',
							-background => 'white',
							-textvariable => \$title_column,
							-state => 'disabled');
	$titlewidget[$title_column]->grid(-row => 1, -column => $title_column, -sticky => 'w');
	if ($title_column ==0 ){
	    $titlewidget[$title_column]-> configure(-background => 'white');
	    $titlewidget[$title_column]-> configure(-foreground => 'white');
	}
    }
    
    my $c;
    my $nrows;
    for ($nrows=1;$nrows<$height+1;$nrows++){
	foreach $c (0 .. ($width)){
	    my $entry_width = 2;
	    if ($c == 0) {
		if ($plate_size != 12){
		    my $letter = $hash->{$nrows};
		    #This is a title column
		    $entrywidget->[$nrows]->[$c] = $gridframe->Entry(-width=>"$entry_width",
								     -background=>'white',
								     -textvariable=>\$letter);
		    
		    $entrywidget->[$nrows]->[$c]->grid(-row=>$nrows+1,
						       -column=>$c,
						       -sticky=>'w');
		    
		    $entrywidget->[$nrows]->[$c]->configure(-state=>'disabled');
		}
		
	    } else {
		
		$entrywidget->[$nrows]->[$c] = $gridframe->Entry(-width=>"$entry_width",
								 -background=>'honeydew1');
		
		$entrywidget->[$nrows]->[$c]->grid(-row=>$nrows+1,
						   -column=>$c,
						   -sticky=>'w');
		
		$entrywidget->[$nrows]->[$c]->configure(-state=>'disabled');
		
		my $letter = $hash->{$nrows};
		my $thiswidget = $entrywidget->[$nrows]->[$c];
		my $type;
		
		if ($plate_size == 12) {
		    $type=$c;
		    $vessel_type = "Tube";
		} else {
		    $type=$letter.$c;
		    $vessel_type = "Well";
		}
		my $tester =$letter.$c;
		
		$thiswidget->bind('<Button-1>' =>  sub { 
		    $well_no = $letter.$c;


                    $old_tester=~ /(\D+)(\d+)/;
                    my $let = $1;
                    my $num = $2;
                    %REVERSE = reverse %$hash;
                    my $check = $REVERSE{$let};
                    $old_widget = $entrywidget->[$check]->[$num];
                    unless (($WELLCONTENTS{$old_tester}) || ($PROBLEMS{$old_tester})){
                        if ($old_widget){
                            $old_widget->configure(-background => 'honeydew');
                        }
                    }
		    
		    if ($WELLCONTENTS{$tester}){
#If the well already has prospective data assigned to it, show it.
			&SHOW_ENTRIES($tester,$thiswidget);
			
                        if ($PROBLEMS{$tester}){
                            
                            $thiswidget->configure(-background=>'red');
                            my $id = $tester;
                            if ($vessel_info=~ /Tube Number/){
                                $id =~ /\D+(\d+)/;
                                $id = $1;
                            }
                            &update("Problem $vessel_info $id : - @{$PROBLEMS{$tester}}\n");
                            $select_color = 1;
                            
                        } else {
                            
                            if ($WELLREMARKS{$tester}){
                                &update("$vessel_type $type contents are :- $WELLCONTENTS{$tester} of type $WELLTYPE{$tester} with remark '$WELLREMARKS{$tester}'.");
                                
                            } else {
                                
                                &update("$vessel_type $type contents are :- $WELLCONTENTS{$tester} of type $WELLTYPE{$tester}.");
                                
                            }
                        }
			$update_screen->update('idletasks');
			if ($plate_size == 12) {
			    $tube_no = $c;
			} 
			
                    } else {
                        
			&general_clean(); 
			$thiswidget->configure( -background => 'green3');
			$select_color = 1;
			&update("selection of $type.");
			&update("Empty $vessel_type.");
			$update_screen->update('idletasks');
			
                        #Display the well number when 
                        #you select the box.
			if ($plate_size == 12) {
			    $tube_no = $c;
			} 
			$well_no = $letter.$c;
                        $old_tester = $tester;
		    }
		    
		} );
		
		$entrywidget->[$nrows]->[$c]->bind('<Button-3>' => sub {
		    if ($WELLCONTENTS{$tester}){
                        if ($PROBLEMS{$tester}){
                            $thiswidget->configure(-background=>'red');
                        } else {
                            $thiswidget->configure( -background => 'blue'); 
                        }
			$select_color = 1;  
                    } else {
			$thiswidget->configure( -background => 'honeydew1');
			$select_color = 0;
		    }
		} );
		
	    }
	}
    }
    
}


sub template_gen {
        
    $PROJECT = "Select a project";
    my $proj = lookup->proj_sql($dbh,$id_role);
    
#Get an empty frame to create space
#between the grid and the menus.
    $empty_frame = $mainWindow->Frame(-relief => 'raised', -borderwidth => '0', -height=> '10', -width => '820')->pack(-fill => 'both');
    
#Holds the drop down menus for
#pcr template generation.
    $second_frame = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3')->pack(-side => 'top', -expand => 'no', -fill => 'both');
    
#Set up the frames to hold the menus.
    my $top_display = $second_frame->Frame()->pack(-side => 'top');
    my $left_display = $second_frame->Frame()->pack(-side => 'left');
    my $left_left_display = $second_frame->Frame()->pack(-side => 'left');
    my $right_display= $second_frame->Frame()->pack(-side => 'right');
    my $right_right_display= $second_frame->Frame()->pack(-side => 'right');
    
#holds well information
    $well_lab = $top_display->Label(-font => $label_f,
                                    -text => $vessel_info )->pack(-side => 'left');
    
    if ($plate_size == 12) {
	
	$well = $top_display->Entry(-width => 4,
				    -font => $button_f,
				    -textvariable =>\$tube_no,
				    -state => 'disabled'
				    )->pack(-side => 'left');
	
    } else {   
	
	$well = $top_display->Entry(-width => 4,
				    -font => $button_f,
				    -textvariable =>\$well_no,
				    -state => 'disabled'
				    )->pack(-side => 'left');
    }
    
    my $code = $left_display->Label(-font => $label_f,
				    -text => "Cost-code",
				    "-height" => 1 )->pack(-side => 'top', -anchor => 'w');
    
    my $proj_cost = $left_left_display->BrowseEntry(-width => 25,
						    -font => $button_f,
						    -variable => \$COSTCODE,
						    -state => 'readonly'
						    )->pack(-side => 'top', -anchor => 'w');
    $proj_cost->insert('end',@{$costcodes_per_team});
    my $pc = $proj_cost->Subwidget("entry")->Subwidget("entry");
    $pc->configure(-bg => 'honeydew2');
    
    my $combination = $right_right_display->Label(-font => $label_f,
						  -text => "Is Combinatorial?",
						  "-height" => 1 )->pack(-side => 'top', -anchor => 'w');
    
    $combi = 'No';
    my $is_combi = $right_display->BrowseEntry(-width => 4,
					       -font => $button_f,
					       -variable => \$combi,
					       -state => 'readonly'
					       )->pack(-side => 'top', -anchor => 'w');
    my @choices = ('Yes','No');
    $is_combi->insert('end',@choices);
    my $ic = $is_combi->Subwidget("entry")->Subwidget("entry");
    $ic->configure(-bg => 'honeydew2');
    
#Hold the project information that has the
#status assigned to finisher for this finisher.
    my $pro_lab = $left_display->Label(-font => $label_f,
                                       -text => "Project" )->pack(-side => 'top', -anchor => 'w');
    
    $project = $left_left_display->BrowseEntry(-width => 25,
                                               -font => $button_f,
                                               -variable =>\$PROJECT,
                                               -state => 'readonly'
                                               )->pack(-side => 'top', -anchor => 'w');
    $project->insert('end',@{$proj});
    my $pc = $project->Subwidget("entry")->Subwidget("entry");
    $pc->configure(-bg => 'honeydew2');
    
#Holds the pcr type information.
    $TYPE = "Select the pcr type"; 
    my $pcr_type_src = $right_right_display->Label(-font => $label_f,
                                                   -text => "Type/Source" )->pack(-side => 'top', -anchor => 'w');
    
    $type_src = $right_display->BrowseEntry(-width => 25,
                                            -font => $button_f,
                                            -variable =>\$TYPE,
                                            -state => 'readonly'
                                            )->pack(-side => 'top', -anchor => 'w');
    $type_src->insert('end',@ts);
    my $ts = $type_src->Subwidget("entry")->Subwidget("entry");
    $ts->configure(-bg => 'honeydew2');
    
#Holds the primername to generate the pcr template.    
    $p1 = "Select primer 1."; 
    my $first_primer = $left_display->Label(-font => $label_f,
                                            -text => "Primer 1" )->pack(-side => 'top', -anchor => 'w');
    
    $primer_one = $left_left_display->BrowseEntry(-width => 25,
                                                  -font => $button_f,
                                                  -variable =>\$p1,
                                                  -state => 'normal'
                                                  )->pack(-side => 'top', -anchor => 'w');
    my $po = $primer_one->Subwidget("entry")->Subwidget("entry");
    $po->configure(-bg => 'honeydew2');
    
#Holds the primersequence related to primername where applicable.    
    $ps1 = "Display or enter primerseq1."; 
    my $first_primerseq = $left_display->Label(-font => $label_f,
					       -text => "Primerseq 1" )->pack(-side => 'top', -anchor => 'w');
    
    $primerseq_one = $left_left_display->Entry(-width => 25,
                                               -font => $button_f,
                                               -textvariable =>\$ps1,
                                               -state => 'normal'
                                               )->pack(-side => 'top', -anchor => 'w');
    
    $p2 = "Select primer 2."; 
    my $second_primer = $right_right_display->Label(-font => $label_f,
                                                    -text => "Primer 2" )->pack(-side => 'top', -anchor => 'w');
    
    $primer_two = $right_display->BrowseEntry(-width => 25,
                                              -font => $button_f,
                                              -variable =>\$p2,
                                              -state => 'normal'
                                              )->pack(-side => 'top', -anchor => 'w');
    my $pt = $primer_two->Subwidget("entry")->Subwidget("entry");
    $pt->configure(-bg => 'honeydew2');    
    
    
    $ps2 = "Display or enter primerseq2."; 
    my $second_primerseq = $right_right_display->Label(-font => $label_f,
                                                       -text => "Primerseq 2" )->pack(-side => 'top', -anchor => 'w');
    
    $primerseq_two = $right_display->Entry(-width => 25,
                                           -font => $button_f,
                                           -textvariable =>\$ps2,
                                           -state => 'normal'
                                           )->pack(-side => 'top', -anchor => 'w');
    $primerseq_two->focusForce;
    $primerseq_two->bind ('<Return>' => sub { 
        &mon6;
    } );
    
#Holds the template name generated from 
#project, primername 1 & 2 selected. 
    my $template_name = $left_display->Label(-font => $label_f,
                                             -text => "Template Name" )->pack(-side => 'top', -anchor => 'w');
    
    $template = $left_left_display->Entry(-width => 25,
                                          -font => $button_f,
                                          -textvariable =>\$pcr_temp,
                                          -state => 'disabled'
                                          )->pack(-side => 'top', -anchor => 'w');
    
    
#Remark if any. 
    my $remark_lab = $right_right_display->Label(-font => $label_f,
                                                 -text => "Remark" )->pack(-side => 'top', -anchor => 'w');
    
    $rem_entry = $right_display->Entry(-width => 25,
                                       -font => $button_f,
                                       -textvariable =>\$remark,
                                       -state => 'normal'
                                       )->pack(-side => 'top', -anchor => 'w');    
    $rem_entry->bind ('<Return>' => sub { 
        &mon8;
    } );
    
    
}


sub selection {
    
    # Map view and some buttons
    my $this_map = $mainWindow->Frame(-relief => 'groove', -borderwidth => '3');
    $this_map->pack(-side => 'bottom', -expand => 'no', -fill => 'both');
    
    # And some next/prev buttons
    my $downButton = $this_map->Button(-text => 'PREV',
                                       -command => sub { &goprev($well_no)}
                                       );
    $downButton->pack(-side => 'left');
    
    
    my $upButton = $this_map->Button(-text => 'NEXT',
                                     -command => sub { &gonext($well_no)}
                                     ); 
    $upButton->pack(-side => 'left');
    
    # Clear everything
    my $clearButton = $this_map->Button(-text => 'Clear' ,
                                        -command => sub { 
                                            my $c;
                                            for ($nrows=1;$nrows<$height+1;$nrows++) {
                                                foreach $c (1 .. ($width)){
                                                    %WELLCONTENTS=();
                                                    %WELLREMARKS=();
                                                    %WELLTYPE=();
                                                    %WELLSEQ1=();
                                                    %WELLSEQ2=();
						    %WELLCOSTCODE=();
						    %WELLCOMBI=();
                                                    %PROBLEMS=();
                                                    
                                                    $PROJECT = "Select a project";
                                                    $TYPE = "Select the pcr type";
                                                    $p1 = "Select primer 1.";
                                                    $p2 = "Select primer 2.";
						    $ps1 = "";
                                                    $ps2 = "";
						    $combi = 'No';
                                                    &general_clean();
                                                    $entrywidget->[$nrows]->[$c]->configure (-background => 'honeydew1');
                                                    $select_color = 0;
                                                }
                                            }
#Empty the well number box when clearing
#the selections from the grid.
                                            $well_no="";
                                            $tube_no="";
                                        });
    $clearButton->pack(-side => 'left');
    
#    # clear wells that have no entries
#    my $clearunfButton = $this_map->Button(-text => 'Clear Unfilled Wells' ,
#                                        -command => sub { 
#                                            my $c;
#                                            for ($nrows=1;$nrows<$height+1;$nrows++) {
#                                                foreach $c (1 .. ($width)){
#                                                    my $letter = $hash->{$nrows};
#                                                    my $tester=$letter.$c;
#                                                    unless (($WELLCONTENTS{$tester}) || ($PROBLEMS{$tester})){ 
#                                                        $entrywidget->[$nrows]->[$c]->configure (-background => 'honeydew1');
#                                                        $select_color = 0;
#                                                    }
#                                                }
#                                            }
#Empty the well number box when clearing
#the selections from the grid.
#                                            $well_no="";
#                                        });
#    $clearunfButton->pack(-side => 'left');
    
    # clear indiv. wells with entries no longer needed
    my $clearwellButton = $this_map->Button(-text => 'Clear Selected Well' ,
                                            -command => sub { 
                                                $well_no =~ /(\D+)(\d+)/;
                                                my $letter = $1;
                                                my $c = $2;
                                                %REVERSE = reverse %$hash;
                                                my $check = $REVERSE{$letter};
                                                delete($WELLCONTENTS{$well_no});
                                                delete($WELLREMARKS{$well_no});
                                                delete($WELLTYPE{$well_no});
                                                delete($WELLSEQ1{$well_no});
                                                delete($WELLSEQ2{$well_no});
						delete($WELLCOMBI{$well_no});
                                                delete($PROBLEMS{$well_no});
                                                $PROJECT = "Select a project";
                                                $TYPE = "Select the pcr type";
                                                $p1 = "Select primer 1.";
                                                $p2 = "Select primer 2.";
                                                $ps1 = "";
                                                $ps2 = "";
                                                $pcr_temp = '';
                                                $remark = '';
						$combi = 'No';
                                                $entrywidget->[$check]->[$c]->configure (-background => 'honeydew1');
                                                $select_color = 0;
                                                $well_no="";
                                            });
    $clearwellButton->pack(-side => 'left');
    
    # commit to database button
    $commitButton = $this_map->Button(-text => 'Commit',
                                      -command => sub { 
                                          %PROBLEMS=();
                                          foreach my $keys (keys %WELLCONTENTS){
                                              $keys=~ /(\D+)(\d+)/;
                                              my $let = $1;
                                              my $num = $2;
                                              %REVERSE = reverse %$hash;
                                              my $check = $REVERSE{$let};
                                              $entrywidget->[$check]->[$num]->configure(-background=>'blue');
                                          }
					  
                                          unless ($WELLCONTENTS{$well_no}){ 
                                              if ($well_no){
                                                  $well_no=~ /(\D+)(\d+)/;
                                                  my $let = $1;
                                                  my $num = $2;
                                                  %REVERSE = reverse %$hash;
                                                  my $check = $REVERSE{$let}; 
                                                  $entrywidget->[$check]->[$num]->configure (-background => 'honeydew1');
                                                  $select_color = 0;
                                              }
                                          }
                                          
                                          print "----------------------------------------->\n";
                                          print Data::Dumper::Dumper(\%WELLCONTENTS);
                                          print "----------------------------------------->\n";
                                          
                                          my $contents_count = scalar(keys %WELLCONTENTS);
                                          print "Entries to be commited = $contents_count\n";
                                          if ($contents_count == 0){
                                              popup ($mainWindow,"STOP", ["There are no entries to be commited to the database. \n"]);
                                              return();
                                              
                                          } else { 
					      
					      my ($probs,$unordpri,$pspec,$costproj,$newid);
					      my %UNORDERED_PRIMERS; 
					      my %PROJ_SPEC;
					      my %COSTCODE_PROJ;
					      my %NEW_IDS;
					      
					      eval {
						  
						  ($probs,$unordpri,$pspec,$costproj,$newid) = newrecords->extra_reply($dbh,$plate_size,$FSNAME,$ID_TEAM_FINSERV,$who,$id_role,$teamname,$session_id,$prog,\%WELLCONTENTS,\%WELLREMARKS,\%WELLTYPE,\%WELLSEQ1,\%WELLSEQ2,\%WELLCOSTCODE,\%WELLCOMBI,\%PROBLEMS);
						  
					      };
					      if ($@){
						  my $error = $@;
						  &update("Problems occured in submitting the data.");
						  &update("Error occured at : - $error");
						  &update("The entries have been rolled back, please contact bug");
						  $update_screen->update('idletasks');
						  $dbh->rollback();
						  
					      } else {
						  
						  %PROBLEMS = %$probs;
						  my $prob_count = scalar(keys %PROBLEMS);
						  if ($prob_count > 0) {
						      &update("Problems occured in submitting the data.");
						      &update("The offending entries are highlighted in red for correction.");
						      $update_screen->update('idletasks'); 
						      
						      foreach my $keyprob (keys %PROBLEMS){
							  print ">>my key of problems is :- $keyprob<<\n";
							  $keyprob=~ /(\D+)(\d+)/;
							  my $let = $1;
							  my $num = $2;
							  %REVERSE = reverse %$hash;
							  my $check = $REVERSE{$let};
							  print "the check alt is $check\n";
							  $entrywidget->[$check]->[$num]->configure(-background=>'red');
							  my $id = $keyprob;
							  if ($vessel_info=~ /Tube Number/){
							      $id = $num;
							  }
							  &update("Problem $vessel_info $id : - @{$PROBLEMS{$keyprob}}\n");
						      }
						      
						  } else {
						      
						      $dbh->commit();
						      
						      %WELLCONTENTS=();
						      %WELLREMARKS=();
						      %WELLTYPE=();
						      %WELLSEQ1=();
						      %WELLSEQ2=();
						      %WELLCOSTCODE=();
						      %WELLCOMBI=();
						      %PROBLEMS=();
						      
						      $PROJECT = "Select a project";
						      $TYPE = "Select the pcr type";
						      $p1 = "Select primer 1.";
						      $p2 = "Select primer 2.";
						      $ps1 = "Display or enter primerseq1.";
						      $ps2 = "Display or enter primerseq2.";
						      $pcr_temp = '';
						      $remark = '';
						      $combi = 'No';
						      $well_no ="";
						      $tube_no ="";
						      
						      %UNORDERED_PRIMERS=%$unordpri;
						      %PROJ_SPEC=%$pspec;
						      %COSTCODE_PROJ=%$costproj;
						      %NEW_IDS=%$newid;
						      
						      my $c;
						      for ($nrows=1;$nrows<$height+1;$nrows++) {
							  foreach $c (1 .. ($width)){
							      $entrywidget->[$nrows]->[$c]->configure (-background => 'honeydew1');
							      $select_color = 0;
							  }
						      }
						      
						      &update("No problems detected entries have been entered into the database.");
						      &update("Entries for :-");
						      foreach my $nkeys (sort {$a <=> $b} keys %NEW_IDS){
							  &update("$NEW_IDS{$nkeys}");
						      }
						      &update("have been entered into the database, please make a note of these id's in case or problems.");
						      
						      
						      &update("If any new primer entries were added an email will shortly be sent to oligo\@sanger.ac.uk for processing.");
						      $update_screen->update('idletasks');
						      
						      my @r_cs;
						      my $table1 = SDTable->new('format' => 'gaudy');
						      $table1->set('title'=> "PCR Oligo orders", 'titles' => ["Costcode","Species","Primername","Sequence"]);
						      
						      my $new_oligocount = scalar (keys %UNORDERED_PRIMERS);
						      if ($new_oligocount >0){
							  
							  foreach my $keys (keys %UNORDERED_PRIMERS){
							      $keys=~ /(\S+)\.\S+/;
							      my $proj_key = $1;
							      my @cs=("$COSTCODE_PROJ{$keys}","$PROJ_SPEC{$proj_key}", "$keys","$UNORDERED_PRIMERS{$keys}");
							      push (@r_cs,\@cs);
							  }
							  
							  foreach my $rc (@r_cs){
							      $table1->add(@$rc);
							  }
							  
                                                          #my $recipients = $who,'oligo','dn1g';
                                                          my $recipients = $who;
							  open (MAIL, "| sendmail $recipients") || die "Can't open pipe to sendmail: $!\n";
							  print MAIL "To: $recipients\n";
							  print MAIL "From: create_pcr\n";
							  print MAIL "Subject: Oligo orders for a pcr through crusade.\n";
							  print MAIL "Below are the orders for oligo's for pcr products.\n\n";
							  print MAIL "The order is for $who from team $teamname for destination $FSNAME.\n\n";
							  print MAIL $table1->format();
							  print MAIL "\n\n";
							  close MAIL;
							  
						      } 
						      %UNORDERED_PRIMERS=(); 
						      %PROJ_SPEC=();
						      %COSTCODE_PROJ=(); 
						      %NEW_IDS=();
						  }
						  
					      }
					  }     
					  
				      });
    $commitButton->pack(-side => 'right');
    
    
}



sub reply {
    
    print "CHECKING COMMIT BUTTON \n";
    print "Here is the output from data entered\n";
    print "Vessel type :- $plate_size\n";
    print "finservice :- $FSNAME & id :-$ID_TEAM_FINSERV\n";
    print "Finisher in question : - $who\n";
    print "Teamname :- $teamname\n"; 
    
    my $count = scalar (keys %WELLCONTENTS);
    print "count entries :- $count\n";
    print "\n";
    
    foreach my $keys (sort keys %WELLCONTENTS){
        print "For Well number : $keys\n";
        print "Well Contents ----------------------------------------->\n";
        print $WELLCONTENTS{$keys};
        print "----------------------------------------->\n";
        print "Well Remarks ----------------------------------------->\n";
        print $WELLREMARKS{$keys};
        print "----------------------------------------->\n";
        print "Well Type ----------------------------------------->\n";
        print $WELLTYPE{$keys};
        print "----------------------------------------->\n";    
        print "Primer contents 1 ----------------------------------------->\n";
        print $WELLSEQ1{$keys};
        print "----------------------------------------->\n";    
        print "Primer contents 2 ----------------------------------------->\n";
        print $WELLSEQ2{$keys};
        print "----------------------------------------->\n"; 
	print "Is combinatorial? ----------------------------------------->\n";
        print $WELLCOMBI{$keys};
        print "----------------------------------------->\n";
        print "\n";
    }
    
    %WELLCONTENTS=();
    %WELLREMARKS=();
    %WELLTYPE=();
    %WELLSEQ1=();
    %WELLSEQ2=();
    %WELLCOSTCODE=();
    %WELLCOMBI=();
    
    
    $PROJECT = "Select a project";
    $TYPE = "Select the pcr type";
    $p1 = "Select primer 1.";
    $p2 = "Select primer 2.";
    $ps1 = "Display or enter primerseq1.";
    $ps2 = "Display or enter primerseq2.";
    $pcr_temp = '';
    $remark = '';
    $combi = 'No';
    $well_no ="";
    $tube_no ="";
    
    my $c;
    my $nrows;
    for ($nrows=1;$nrows<$height+1;$nrows++) {
	foreach $c (1 .. ($width)){
	    $entrywidget->[$nrows]->[$c]->configure (-background => 'honeydew1');
	    $select_color = 0;
	}
    }
    
}


sub goprev {
    my ($well) = @_;
    
#    print ">>WELL $well<<\n";
    if ($well=~ /(\D)(\d+)/g){
        my $let = $1;
        my $num = $2;
#        print ">>letter $let & number $num<<\n";
        
        #invert the hash
        %REVERSE = reverse %$hash;
        
        my $check = $REVERSE{$let};
        
        unless (($let eq 'a') && ($num == 1)) {
            unless (($WELLCONTENTS{$well}) || ($PROBLEMS{$well})){        
                $entrywidget->[$check]->[$num]->configure (-background => 'honeydew1');
                $select_color = 0;
            }
            
            #if the number is 1 go up to the previous row if there is one
            #if the number isn't one got to the previous number.
            if ($num == 1){
                $check--;
                $num = $width;
                $entrywidget->[$check]->[$num]->configure (-background => 'green3');
                $select_color = 1;
            } else {
                $num--;
                $entrywidget->[$check]->[$num]->configure (-background => 'green3');
                $select_color = 1;
            }
        }      
        $thiswidget = $entrywidget->[$check]->[$num];
           
        #Well number should contain 
        #the new well information.
        $well_no=$hash->{$check}.$num;
        $old_tester=$well_no;

        #Tube information should
        #contain new tube information.
        $tube_no=$num;
#        print "OLD TESTER (goprev):- $old_tester\n";
      
        &SHOW_ENTRIES($well_no,$thiswidget);
        
    }   
    
}


sub gonext {
    my ($well) = @_;
    
#    print ">>WELL $well<<\n";
    if ($well=~ /(\D)(\d+)/g){
        my $let = $1;
        my $num = $2;
#        print ">>letter $let & number $num<<\n";
        
        #invert the hash again
        %REVERSE = reverse %$hash;
        
        my $check = $REVERSE{$let};  
        
        my $last_let = $hash->{$height};
        
        unless (($let eq $last_let) && ($num == $width)) {
            
            unless (($WELLCONTENTS{$well}) || ($PROBLEMS{$well})){        
                $entrywidget->[$check]->[$num]->configure (-background => 'honeydew1');
                $select_color = 0;
            }
            
            if ($num == $width){
                $check++;
                $num = 1;
                $entrywidget->[$check]->[$num]->configure (-background => 'green3');
                $select_color = 1;
            } else {
                $num++;
                $entrywidget->[$check]->[$num]->configure (-background => 'green3');
                $select_color = 1;
            }   
        }
        $thiswidget = $entrywidget->[$check]->[$num];
        
        #Well number should contain 
        #the new well information.
        $well_no=$hash->{$check}.$num ;
        $old_tester=$well_no;

        #Tube information should
        #contain new tube information.
        $tube_no=$num;
#        print "OLD TESTER (goprev):- $old_tester\n";

        &SHOW_ENTRIES($well_no,$thiswidget);
           
    }    
    
}


sub SHOW_ENTRIES {
    my($well_no,$thiswidget)=@_;
    
    if ($WELLCONTENTS{$well_no}){
        if ($PROBLEMS{$well_no}){
            $thiswidget->configure( -background => 'red');
        } else {
            $thiswidget->configure( -background => 'blue');
        }
        $select_color = 1;
        $pcr_temp = '';
        $COSTCODE='';
        $p1= '';
        $ps1= '';
        $p2= '';
        $ps2= ''; 
        $TYPE=''; 
        $remark=''; 
        $COSTCODE=$WELLCOSTCODE{$well_no};
        $combi=$WELLCOMBI{$well_no};
        my $contents = $WELLCONTENTS{$well_no};
        $pcr_temp = $contents;
        $pcr_temp =~ /(\S+)\_(\S+)\_(\S+)/;
        $PROJECT=$1;
        my $pshow1 = $WELLSEQ1{$well_no};
        my $pshow2 = $WELLSEQ2{$well_no};
        $pshow1 =~ /(\S+)\_(\S+)/;
        $p1 = $1;
        $ps1= $2;
        $pshow2 =~ /(\S+)\_(\S+)/;
        $p2 = $1;
        $ps2= $2;
        if ($WELLTYPE{$well_no}){
            $TYPE = $WELLTYPE{$well_no};
        }
        if ($WELLREMARKS{$well_no}){
            $remark = $WELLREMARKS{$well_no};
            
        } 
    }
}


sub update_clear{
    $update_screen->delete ('0', 'end');
    &update("Window cleared.");
}

sub update {
    my (@update_contents)=@_;
    $update_screen->insert('end', @update_contents);
    $update_screen->see('end'); 
    $update_screen->pack(-side => 'left', -expand => 1, -fill => 'both');
}


END {
    if ($dbh){
	eval {
	    $dbh->rollback();
	    $dbh->disconnect();
	}
    }
};




__END__


