#######################################################################
# 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
######################################################################
# Interface to allow full or partial plate creation (import -> Finch)
######################################################################

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

# Globals
my $entrycolour = 'lemonchiffon2';
my $titlecolour = 'honeydew2';
my ($plate, $suffix, $start, $end, $runtype);
my ($start_row, $start_col, $end_row, $end_col);
my $code;
my $runtype_list;
my $platedata;
my ($db_database, $db_user, $db_pass);

# Fonts
#my $title_f = "-adobe-helvetica-bold-r-normal--24-180-100-100-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";

my $title_f = "-adobe-courier-bold-r-normal--24-240-75-75-m-150-iso8859-1";
my $entry_f = "-adobe-courier-medium-r-normal--18-180-75-75-m-110-iso8859-1";
my $button_f = "-adobe-courier-bold-r-normal--18-180-75-75-m-110-iso8859-1";
my $label_f = "-adobe-courier-medium-r-normal--10-100-75-75-m-60-iso8859-1";


package plate_entry;

sub start_interface {
    my ($type, $mw);
    ($type, $mw, $code, $runtype_list, $platedata, $db_database, $db_user, $db_pass) = @_;
    my $window = MyWindow->new($mw);
}

package MyWindow;

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

    # Set up the screen object
    $self->makeWindow($mw);
    $self->makeFrames();
    $self->label();
    $self->setupentry();
    $self->buttons();
    return $self;

}

sub makeWindow {
    my ($self, $mw) = @_;
    $self->{mainWindow} = $mw->Toplevel;
    $self->{mainWindow}->configure(cursor  => 'hand2');
    $self->{mainWindow}->wm('minsize', 600, 250); 
    $self->{mainWindow}->wm('maxsize', 600, 250);
    $self->{mainWindow}->packPropagate(0);
    $self->{mainWindow}->idletasks();
    $self->{mainWindow}->configure (-font=> $button_f, -title => "Plate entry tool.");
}

sub makeFrames {
    my ($self) = @_;
    $self->{top_frame} = $self->{mainWindow}->Frame()->pack(side => 'top', fill => 'both');
    $self->{middle_frame} = $self->{mainWindow}->Frame(-relief => 'groove', -borderwidth => '6' )->pack(side => 'top', -fill => 'none', -expand => 'n');
    $self->{middle_frame_1} = $self->{middle_frame}->Frame()->pack(side => 'top');
    $self->{middle_frame_2} = $self->{middle_frame}->Frame()->pack(side => 'top');
    $self->{middle_frame_3} = $self->{middle_frame}->Frame()->pack(side => 'top');
    $self->{middle_frame_4} = $self->{middle_frame}->Frame()->pack(side => 'top');
    $self->{middle_frame_5} = $self->{middle_frame}->Frame()->pack(side => 'top');
    $self->{bottom_frame} = $self->{mainWindow}->Frame()->pack(side => 'top', fill => 'both');
    $self->{bottom_frame_1} = $self->{bottom_frame}->Frame()->pack(side => 'left', fill => 'both');
    $self->{bottom_frame_2} = $self->{bottom_frame}->Frame()->pack(side => 'right', fill => 'both');
}

sub label {
    my ($self) = @_;
    $self->{top_frame}->Label(
			      #-font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
			      -font => $title_f, 
			      text => 'Please enter your plate information.')->pack(-side => 'top');
}

sub setupentry {
    my ($self) = @_;

    my %titles = (
	"plate" => "Platename",
	"suffix" => "Suffix",
	"start" => "Start",
	"end" => "End", 
	"runtype" => "Runtype"
	);

    $self->{t1} = $self->{middle_frame_1}->Entry(
						 -font => $button_f,
						 -state => 'disabled',
						    -width => 12,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    -bg => $titlecolour,
						    -textvariable => \$titles{plate},
						    )->pack(side => 'left');
    
    $self->{t2} = $self->{middle_frame_2}->Entry(-font => $button_f,
						    -state => 'disabled',
						    -width => 12,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    -bg => $titlecolour,
						    -textvariable => \$titles{suffix},
						    )->pack(side => 'left');

    $self->{t3} = $self->{middle_frame_3}->Entry(-font => $button_f,
						    -state => 'disabled',
						    -width => 12,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    -bg => $titlecolour,
						    -textvariable => \$titles{start},
						    )->pack(side => 'left');

    $self->{t4} = $self->{middle_frame_4}->Entry(-font => $button_f,
						    -state => 'disabled',
						    -width => 12,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    -bg => $titlecolour,
						    -textvariable => \$titles{end},
						    )->pack(side => 'left');

    $self->{t5} = $self->{middle_frame_5}->Entry(-font => $button_f,
						    -state => 'disabled',
						    -width => 12,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    -bg => $titlecolour,
						    -textvariable => \$titles{runtype},
						    )->pack(side => 'left');

    $self->{e1} = $self->{middle_frame_1}->Entry(-font => $entry_f,
						    -state => 'normal',
						    -width => 25,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    #-bg => $entrycolour,
						    -textvariable => \$plate,
						    )->pack(-side => 'left' );

    $self->{e2} = $self->{middle_frame_2}->Entry(-font => $entry_f,
						    -state => 'normal',
						    -width => 25,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    #-bg => $entrycolour,
						    -textvariable => \$suffix,
						    )->pack(side => 'left');
    
    $self->{e3} = $self->{middle_frame_3}->Entry(-font => $entry_f,
						    -state => 'normal',
						    -width => 25,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    #-bg => $entrycolour,
						    -textvariable => \$start,
						    )->pack(side => 'left');

    $self->{e4} = $self->{middle_frame_4}->Entry(-font => $entry_f,
						    -state => 'normal',
						    -width => 25,
						    #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						    #-bg => $entrycolour,
						    -textvariable => \$end,
						    )->pack(side => 'left');

    $self->{e5} = $self->{middle_frame_5}->BrowseEntry(-font => $entry_f,
						       -width => 22,
						       #-font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
						       #-bg => $entrycolour,
						       -variable => \$runtype, 
						       -state => 'readonly'
						       )->pack(-side => 'left');
    # Fill up the available runtype-options
    my $next;
    foreach $next (@$runtype_list){
	$self->{e5}->insert('end', $next);
    }
    # default
    $runtype = $runtype_list->[5];

}

sub buttons {
    my ($self) = @_;
    $self->{cancel_button} = $self->{bottom_frame_1}->Button(-font => $button_f,
							     -text => 'Cancel',
							     -width => 10,
							     -command => sub {
								 &$code;
								 $self->{mainWindow}->destroy(); 
							     }
						       );
    $self->{cancel_button}->pack(-side => 'right');
    
    $self->{ok_button} = $self->{bottom_frame_2}->Button(-font => $button_f,
							 -text => 'OK',
							 -width => 10,
							 -command => sub {

							     ###########################################
							     # There must be an entry made in all cases
							     # From and To must be letterdigit format
							     ###########################################

		      if ( ($plate eq '') || ($suffix eq '') || ($start eq '') || ($end eq '') || $runtype eq '') {
			main::popup ("Warn", ["Sorry, you must fill in all fields to continue."]);
			} else {
			    ################
			    # Check 'Start'
			    ################
			    if ($start =~ /^([a-h])(\d+)/) {
				$start_row = $1;
				$start_col = $2;
			    } else {
				&well("Start");
				return();
			    }
			    if ( ($start_col > 12) || ($start_col < 1) ){
				&well("Start");
				return();
			    }
			    ##############
			    # Check 'End'
			    ##############
			    if ($end =~ /^([a-h])(\d+)/) {
				$end_row = $1;
				$end_col = $2;
			    } else {
				&well("End");
				return();
			    }
			    if ( ($end_col > 12) || ($end_col < 1) ){
				&well("End");
				return();
			    }
			    #######################################
			    # Make sure 'Start' comes before 'End'
			    #######################################
			    # db connection
			    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
			    my ($start_no) = SQL->rowcol2ID($start_row, $start_col, $dbh);
			    my ($end_no) = SQL->rowcol2ID($end_row, $end_col, $dbh);
			    $dbh->disconnect();
			    if ($end_no < $start_no){
			      main::popup ("Warn", ["Sorry, 'Start' must come before 'End'."]);
				return();
			    }
			    if ($end_no == $start_no){
			      main::popup ("Warn", ["Sorry, 'Start' must not be equal to 'End'."]);
				return();
			    }

			  # We need to make something to return to ?Finch?
			    my ($return) = &make_list($start_no, $end_no);
			  
			  #########################################
			  # Callback to update interface with data
			  &$platedata($return);
			  #########################################

			  $self->{mainWindow}->destroy();
			  &$code;
			  # we should also deref our interface updaty code here to

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

}

sub make_list {
    my ($start_no, $end_no) = @_;
    my @array = ();

    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    my $next;
    foreach $next ($start_no .. $end_no){
	# convert $next to rowcol
	my ($row, $col) = SQL->ID2rowcol($next, $dbh);
	my @platedata = ("$plate$row$col" , "$suffix", "", "", "$runtype");
	push @array, \@platedata;
    }
    $dbh->disconnect();
    return (\@array);    
}

sub well {
    my ($problem, $stuff) = @_;
    main::popup ("Warn", ["Sorry, $problem must be in rowcolumn format (eg. a12)"]);
}

package SQL;

sub rowcol2ID {
    my ($type, $start_row, $start_col, $dbh) = @_;
    my $statement = "
select ID_MAP
from rowcol_map 
where MAPROW = \'$start_row\'
and MAPCOL = \'$start_col\'
";
    my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    my ($return) = $sth->fetchrow();
    $sth->finish();
    return ($return);
}

sub ID2rowcol {
    my ($type, $id, $dbh) = @_;
    my $statement = "
select MAPROW, MAPCOL
from rowcol_map
where ID_MAP = \'$id\'
";
    my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    my ($row, $col) = $sth->fetchrow();
    $sth->finish();
    return ($row, $col);
}


1;


