$APE::Tk::PlateSelector::VERSION = '1.0';

package APE::Tk::PlateSelector;

use Tk::widgets qw /Entry Table/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use warnings;
use Carp;

use APE::Tk::PlateCell;

Construct Tk::Widget 'PlateSelector';

use constant TRUE  => 1;
use constant FALSE => 0;

my %format = ( 96  => { rows => 8,  columns => 12 },
	       384 => { rows => 16, columns => 24 });


########################################################################
## Standard Tk mega widget method for creating this mega widget and 
## initialising the super class widget.
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
}


########################################################################
## Standard Tk mega widget method for defining mega widget characteristics
## and capturing arguments unknown to Tk.
########################################################################
sub Populate {
    my ($self,$args) = @_;
    
    $self->{_plateName}   = delete $args->{-name};
    $self->{_format}      = delete $args->{-format} || croak "ERROR: argument -format is missing";
    $self->{_select}      = delete $args->{-select} || ['row','column'];
    $self->{_incCommand}  = delete $args->{-incrementCommand};
    $self->{_decCommand}  = delete $args->{-decrementCommand};

    ref($self->{_incCommand}) eq 'CODE' or croak "ERROR: -incrementCommand must be a code ref" if $self->{_incCommand};
    ref($self->{_decCommand}) eq 'CODE' or croak "ERROR: -decrementCommand must be a code ref" if $self->{_decCommand};
    
    exists($format{ $self->{_format} }) or croak "ERROR: format '$self->{_format}' is unsupported.";
    ref($self->{_select}) eq 'ARRAY'    or croak "ERROR: argument -select must be an array ref of selection types.";

    $self->{_ab}       = delete $args->{-activebackround}     || 'blue';
    $self->{_sb}       = delete $args->{-selectbackground}    || 'red';
    $self->{_b }       = delete $args->{-background}          || 'grey';
    $self->{_ib}       = delete $args->{-indicatorbackground} || 'lightgrey';
    
    $self->{_columnBound} = FALSE;
    $self->{_rowBound}    = FALSE;
    $self->{_singleBound} = FALSE;
    $self->{_selectCount} = 0;
    
    my $table = $self->Table(-rows         => $format{ $self->{_format} }{rows}+1,
			     -columns      => $format{ $self->{_format} }{columns}+1,
			     -fixedrows    => 1,
			     -fixedcolumns => 1,
			     -takefocus    => 1,
			     -scrollbars   =>'os',
			     )->pack;

    $self->_populateTable($table);
    
    #$self->Button(-text=>'Debug',-command=>[\&debug,$self])->pack(-pady=>10);

    foreach my $select (@{$self->{_select}}) {
	if(my $subRef = $self->can("_add" . ucfirst($select) ."Binds")) {
	    $subRef->($self,$table);
	}else{ $self->Tk::Error("ERROR: select option '$select' is not valid."); }
    }

    $self->Advertise('table' => $table);

    $self->ConfigSpecs(-state       => [[@{$self->{_plateCells}}],qw/state State normal/],
		       -selectstate => [[@{$self->{_plateCells}}],qw/selectstate SelectState normal/],
		       -inccommand  => [qw/CALLBACK inccommand IncCommand/],
		       -deccommand  => [qw/CALLBACK deccommand DecCommand/]);

    $self->SUPER::Populate($args);

}

sub debug {
    my $self = shift;
    my $plateCellList = $self->getPlateCells;
    foreach my $plateCell (@{$plateCellList}) {
	print STDERR $plateCell->getCoordString, " - isSelected:",$plateCell->isSelected ? "TRUE" : "FALSE",
	" SelectCount: ",$plateCell->getSelectionCount,"\n";
    }
}

########################################################################
## Method to populate the table widget created in the Populate method
## so that it represents a plate of format _format as defined in
## %format.  Cell at row 0 (zero) and column 0 (zero) is a button that
## will clear/ reset the table PlateCell widgets. The top row of
## widgets are label types (see method _addColumnBinds).  The left most
## column of widgets are label types (see method _addRowBinds). The
## cells of the table that represent the cells on the plate are
## PlateCell type widgets. A PlateCell widget is derived from a
## Checkbutton widget.
########################################################################
sub _populateTable {
    my ($self,$table) = @_;
    my $totalRows = $format{ $self->{_format} }{rows};
    my $totalCols = $format{ $self->{_format} }{columns};
    foreach my $row (0..($totalRows)) {
	foreach my $col (0..($totalCols)) {
	    if($row == 0 && $col == 0) { $table->put($row,$col,$table->Button(-text=>'clr',
									      -highlightthickness=>0,
									      -command=>sub{$self->clearTable();})); }
	    elsif($row == 0 && $col > 0 ) { $table->put($row,$col,$col); }
	    elsif($col == 0 && $row > 0 ) { $table->put($row,$col,_getRowChr($row)); }
	    else{ my $plateCell;
		  $plateCell = $table->PlateCell(-coord            => [$row,$col],
						 -bg               => $self->{_b},
						 -activebackground => $self->{_ab},
						 -selectcolor      => $self->{_sb},
						 -relief           => 'raised',
						 -command          => sub { $self->_cellUpdated($plateCell); },
						 -border           => 1,
						 -width            => 1,
						 -height           => 1);    
		  $self->{_callbackCount}{$plateCell} = 0;
		  push(@{$self->{_plateCells}},$plateCell);
		  $table->put($row,$col,$plateCell); 
		  next; 
	      }
	    
	    $table->get($row,$col)->configure(-relief => 'raised',
					      -border => 1,
					      -width  => 2,
					      -height => 2);
	}
    }
}


########################################################################
## Callback method passed to each PlateCell in the table widget. This
## method is called everytime a PlateCell widget receives Button-1
## event message. The method is passed the PlateCell reference. If the
## PlateCell has been switched on then an insert into the _activeCell
## hash of self is made using the PlateCell reference as the key and
## the PlateCell reference as the value. If the PlateCell has been
## switched off then it must have been switched on and that entry is
## deleted from the _activeCell hash in self.
########################################################################
sub _cellUpdated {
    my ($self,$plateCell) = @_;
    if($plateCell->isSelected) {
	if($plateCell->getSelectionCount >= $self->{_callbackCount}{$plateCell}) {
	    #print STDERR "Incrementing the count\n";
	    $self->Callback(-inccommand);
	}else{
	    #print STDERR "1: Decrementing the count\n";
	    $self->Callback(-deccommand);
	}
	$self->{_callbackCount}{$plateCell} = $plateCell->getSelectionCount;
    }else{
	#print STDERR "2: Decrementing the count\n";
	$self->Callback(-deccommand);
    }
}


########################################################################
## Method to add binds to the columns of the table widget. The bind is
## for a Button-1 event on the top row (row=0) of the table. When a
## label widget packed into the first row of the table is depressed,
## each of the PlateCell widgets in the column is invoked. If one of
## the PlateCell widgets is already selected then all of the remaining
## PlateCell widgets are switched on. If all of the PlateCell widgets
## in the selected column are switched on then they are switched off
## and vice-versa.
########################################################################
sub _addColumnBinds {
    my ($self,$table) = @_;
    $self->{_columnBound} = TRUE;
    my $totalRows    = ($table->totalRows    - 1);
    my $totalColumns = ($table->totalColumns - 1);
    foreach my $column (1..$totalColumns) {
	$table->get(0,$column)->bind
	    ('<Button-1>' => sub{ 
		my $ALL_ON = TRUE;
		foreach my $row (1..$totalRows) {
		    $ALL_ON = FALSE unless $table->get($row,$column)->isSelected;
		}
		foreach my $row (1..$totalRows) {
		    my $w = $table->get($row,$column);
		    if($ALL_ON)           { $w->select; }
		    elsif(!$w->isSelected){ $w->select; } 
		}
	    });
    }
}


########################################################################
## Method to add binds to the rows of the table widget. The bind is for
## a Button-1 event on the first column (column=0) of the table. When a
## label widget packed into the first column of the table is depressed,
## each of the PlateCell widgets in the row is invoked. If one of the
## PlateCell widgets is already selected then all of the remaining
## PlateCell widgets are switched on. If all of the PlateCell widgets
## in the selected row are switched on then they are switched off and
## vice-versa.
########################################################################
sub _addRowBinds {
    my ($self,$table) = @_;
    $self->{_rowBound} = TRUE;
    my $totalRows    = ($table->totalRows    - 1);
    my $totalColumns = ($table->totalColumns - 1);
    foreach my $row (1..$totalRows) {
	$table->get($row,0)->bind
	    ('<Button-1>' => sub{ 
		my $ALL_ON = TRUE;
		foreach my $column (1..$totalColumns) {
		    $ALL_ON = FALSE unless $table->get($row,$column)->isSelected;
		}
		foreach my $column (1..$totalColumns) {
		    my $w = $table->get($row,$column);
		    if($ALL_ON)           { $w->select; }
		    elsif(!$w->isSelected){ $w->select; }
		}
	    });
    }
}


########################################################################
## Method to return a list of the selected PlateCell coordinates in the
## form rowcolumn e.g. a1 or h12. 
########################################################################
sub getSelectedCoords {
    my $self   = shift;
    my @coords = ();    
    foreach my $plateCell (@{$self->{_plateCells}}) {
	if($plateCell->isSelected) {
	    push(@coords,$plateCell->getCoordString);
	}
    }
    return \@coords;
}


########################################################################
## Method to return a list of the selected columns. A column is
## selected if all of the PlateCells in the column are
## PlateCell->isSelected = TRUE. If a single PlateCell is
## PlateCell->isSelected = FALSE then the column is ignored and not
## added to the list of selected columns. The column number is added to
## the list if it is selected.
########################################################################
sub getSelectedColumns {
    my $self = shift;
    my $table        = $self->Subwidget('table');
    my $totalRows    = ($table->totalRows    - 1);
    my $totalColumns = ($table->totalColumns - 1);
    my @columns      = ();
    foreach my $column (1..$totalColumns) {
	my $allSelected = TRUE;
	foreach my $row (1..$totalRows) {
	    $allSelected = FALSE unless $table->get($row,$column)->isSelected;
	}
	push(@columns,$column) if $allSelected;
    }
    return \@columns;
}


########################################################################
## Method to return a list of the selected rows. A row is selected if
## all of the PlateCells in the row are PlateCell->isSelected =
## TRUE. If a single PlateCell is PlateCell->isSelected = FALSE then
## the row is ignored and not added to the list of selected rows. The
## row letter is added to the list if it is selected.
########################################################################
sub getSelectedRows {
    my $self = shift;
    my $table        = $self->Subwidget('table');
    my $totalRows    = ($table->totalRows    - 1);
    my $totalColumns = ($table->totalColumns - 1);
    my @columns      = ();
    foreach my $row (1..$totalRows) {
	my $allSelected = TRUE;
	foreach my $column (1..$totalColumns) {
	    $allSelected = FALSE unless $table->get($row,$column)->isSelected;
	}
	push(@columns,_getRowChr($row)) if $allSelected;
    }
    return \@columns;
}


########################################################################
## Method to clear the table. This is the equivalent of deselecting all
## of the selected PlateCell widgets in the table.
########################################################################
sub clearTable {
    my $self = shift;
    my $table = $self->Subwidget('table');
    foreach my $plateCell (@{$self->{_plateCells}}) {
	if($plateCell->isSelected) {
	    $plateCell->clear;
	}
    }
}


########################################################################
## Method to return a list containing the PlateCell widgets used to
## create the table. The list is populated with the PlateCell widgets
## from each row of the table left to right e.g. list[0] = PlateCell
## from a1 list[12] = PlateCell from b1.
########################################################################
sub getPlateCells {
    my $self = shift;
    return $self->{_plateCells};
}


########################################################################
## Method to return the plate name that this PlateSelector represents. 
########################################################################
sub getPlateName {
    my $self = shift;
    return $self->{_plateName};
}


########################################################################
## Static method to convert the passed integer to a char. The passed
## int is most likely a number representing a row on the table
## e.g. passed = 1 row = 'a'.
########################################################################
sub _getRowChr {
    return chr((shift)+96);
}


1;


