#!/usr/local/bin/perl5.6.1 -w
# $Id: BoxScanrV.pm,v 1.2 2003/10/24 10:49:26 jx1 Exp $

package BoxScanrV;

use strict;
use warnings;
use Carp qw(croak cluck carp);
use Class::Struct;
use sigtrap qw(die untrapped normal-signals
               stack-trace any error-signals);

use Tk;
use BoxDataM;
#require "./BoxDataM.pm";

my $setup = { title_f       => "*-times-bold-r-normal--*-180-*-*-p-*-*-*",
	      entry_f       => "-adobe-helvetica-medium-r-normal--17-120-100-100-p-88-iso8859-1",
	      button_f      => "-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1",
	      menu_f        => "-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1",
	      label_f       => "-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1",
	      active_entry  => "pale green",
	      disabled_entry=> "grey85",
	      other_entry   => "white",
	      frame_bordrw  => '2',
	  };

my $titles = ['Position', 'Barcode', 'Content', 'Comments'];

my $pageLayout = { Column   => scalar @{$titles},
		   CWidth   => 15,
		   Row      => 96,
		   PageSz => 12,
		   #TotalPg => 8,
		   MaxPage => 8, 
		 };

my $BITMAP_DIR = "$ENV{'BADGER'}/lib/platetrack/bitmaps";  
#my $SCANNER = "ABgene38"; # could use env for particular user
my $SCANNER = "$ENV{'ABGENE_HOST'}";


###########################################################################
 
unless (caller)
{
    use BoxScanrV;
    use BoxDataM;
#    require "./BoxDataM.pm";

    my $mw = MainWindow->new();
    my $front = BoxScanrV -> new();
    $front -> init( $mw );

    $front-> TopFrame() -> pack( -side     => 'top',
				-anchor   => 'n',
				-expand   => 1,
				-fill     => 'x' );     
    MainLoop;
} 


####    object definition    ####

struct BoxScanrV =>
{
    Leader  => '$', #ref to base GUI object
    OpFrame => '$',
    BoxIdEntry => '$',
    PageNum => '$',
    DbButton => '$', 
    DataEntry => '$',
    DataPos => '$',
    DataSource => '$', 
};


####    public methods    ####

sub init
{
    my $self = shift;

    my $parentw = shift; # as para
    my $op_frame = $parentw -> Frame( -relief	   => 'ridge', 
				      -borderwidth => $setup->{frame_bordrw},
				      -label => "Scan ABgene box",
				      -labelFont => $setup->{title_f},
				      -labelPack => [ -side => 'top'] );

    $self -> OpFrame( $op_frame );
    $self -> BoxIdEntry( createBoxIdEntry( $self ) );
    $self -> PageNum( createPageNumE( $self ) );
    createTitleGrid( $self );
    $self -> DataEntry( createDataGrid( $self ) );

    createOpButtons( $self );

    $self -> DataPos( { CurRow => 0,
			CurPage => 1,
			PageCnt => 1,
		      } );

    # set leading Gui object
    my $leader = shift;
    if ( defined $leader )
    {
	$self->Leader( $leader );
    }

    eval
    {
	$self -> DataSource( BoxDataM -> new( VLeader=>$leader ) -> init() );
    };
    if($@)
    {
	#if( $^W )
	{
	    print "$@\n";
	}

	my $msg = (split /\n/, $@)[0];
	print "Create BCreader error: $msg\n";
	#$leader -> updateWarning( $msg );
	croak $msg; #$@;
    }
    #print $self -> DataSource() -> BcReader()->{host}; #ABgeneHost();
    #print "\n";
    # ABgene host could be setup as env for user ...


    return $self;
}


sub updateBoxIdV
{
    my $self = shift;
    my $boxid = shift; #$self -> DataSource() -> BoxId(); 

#    if( @_ ) #clear
#    {
#	$boxid = '';
#    }
#    else
#    {
#	$boxid = $self -> DataSource() -> BoxId(); 
#    }
    
    if( $boxid =~ /clear/  )
    {
	$boxid = '';
    }
    $self->BoxIdEntry() -> configure( -text => $boxid ); 
}


sub updatePageNumV
{
    my $self = shift;
    my $pageLbl = $self->PageNum();
    my $page_var;

    if( @_ ) #clear page info display 
    {
	$page_var = '';
    }
    else
    {
#       my $page_num = $self->DataPos()->{CurPage};
	$page_var = $self->DataPos()->{CurPage}.' of '.$self->DataPos()->{PageCnt};
    }
    print "$page_var\n";

    $pageLbl -> configure( -text => $page_var );
    
}

sub updateDataPos
{
    my $self = shift;
    $self->DataPos()->{CurPage} = 1;

    if( @_ ) #reset
    {
	$self->DataPos()->{PageCnt} = 1;
    }
    else
    {
	$self->DataPos()->{PageCnt} = $pageLayout->{MaxPage};
    }

    print "Page count of data: ";
    print $self->DataPos()->{PageCnt};
    print "\n";
}


sub loadData
{
    my $self = shift;
    my $data = shift; # passed as para, format: [96][4]
    $self->Data() = $data;
    
    return $self;
}


sub updateDataView
{
    my $self = shift;
    my $data;
    my @datapage;

    my $page = $self->DataPos()->{CurPage};
    my $pgsz = $pageLayout->{PageSz};
    my $ncol = $pageLayout->{Column};

    if( @_ ) #clear
    {
	my $dentry = $self->DataEntry();
	my ($irow, $icol);
	my $colour;
	foreach $irow ( 0 .. $pgsz-1 )
	{
	    foreach $icol ( 0 .. $ncol-1 )
	    {
		$dentry->[$irow]->[$icol] -> 
		    configure( -textvariable => \'',
			       -background => $setup->{disabled_entry} );
	    }
	}

    }
    else
    {
	$data = $self -> DataSource() -> BoxContent(); 	
 	print "$page\n";

#    print "Data reference is: $data\n";
#    print "@{$data}\n";
#    print "One of the row data: @{$data->[10]}\n";

	@datapage = (@$data)[ ($page-1)*$pgsz .. $page*$pgsz-1 ]; #array of refs to array

    #print "$#datapage\n";

        # display data page ...
        my $dentry = $self->DataEntry();
        my ($irow, $icol);
        my $colour;
        foreach $irow ( 0 .. $pgsz-1 )
        {
	    #print "row $irow, ", scalar @{$datapage[$irow]};
	    if( $datapage[$irow]->[$ncol] =~ /M/ )
	    {
	        # changed since last scan
	        #print "hit 'change' ", $datapage[$irow]->[$ncol], "\n";
	        $colour = "yellow";
	    }
	    elsif( $datapage[$irow]->[$ncol] =~ /NEW/ )
	    {
	        # new insert
	        $colour = "PaleGreen";
	    }
	    elsif( $datapage[$irow]->[$ncol] =~ /X/ )
	    {
	        # error
	        $colour = "red";
	    }
	    elsif( #$datapage[$irow]->[$ncol-1] =~ /db/ && 
	           $datapage[$irow]->[$ncol] =~ /OK/ )
	    {
	        $colour = "PaleGreen";
	    }
#	    elsif( $datapage[$irow]->[$ncol-1] =~ /db/ && 
#	           $datapage[$irow]->[$ncol-1] =~ /fail/ )
#	    {
#	        $colour = "red";
#	    }
	    else
	    {
	        $colour = "white";
	    }

	    foreach $icol ( 0 .. $ncol-1 )
	    {
	        $dentry->[$irow]->[$icol] -> 
		    configure( -textvariable => \$datapage[$irow]->[$icol],
			       -background => $colour );
	    }
        }
    }	
}


sub end
{
    my $self = shift;
    $self->Leader( undef() );
    $self->DataSource( undef() );

    my $topframe = $self->OpFrame();

    if( defined $topframe )
    {
	$topframe -> packForget();
	$topframe -> parent() -> packPropagate(1);

	$self->OpFrame()->destroy();

	$self->OpFrame( undef() );
	#print "BoxScanrV end process called.\n";
    }

    print "BoxScanrV end process called.\n";
}


sub DESTROY
{
    my $self = shift;
    $self->Leader( undef() );

    print "BoxScanrV destructor called.\n";
}


####    private procedures/functions    ####
sub createBoxIdEntry
{
    my $family = shift;
    my $op_frame = $family -> OpFrame();

    my $boxid_frame = $op_frame -> Frame( -label => "Box ID ",
					  -labelFont => $setup->{button_f},
					  -labelPack => [ -side => 'left'] );

    $boxid_frame -> pack ( -side   => 'top',
			   -expand => 1, 
			   -fill   => 'x');

    #my $boxid = 'unknown';
    my $boxlabel = $boxid_frame -> Label( -width => $pageLayout->{CWidth},
					  -font => $setup->{entry_f},
					  -relief => 'sunken',
					  -background => 'white'
					) -> pack( -side => 'left' );

    return $boxlabel;
}


sub createPageNumE
{
    my $family = shift;
    my $op_frame = $family -> OpFrame();

    my $pnum_frame = $op_frame -> Frame( -label => "Page ",
					 -labelFont => $setup->{button_f},
					 -labelPack => [ -side => 'left'] );

    $pnum_frame -> pack ( -side   => 'top',
			  -anchor => 'e'); 

    #my $curp = 'No Data';
    my $pnum_label = $pnum_frame -> Label( -width => 8,
					   -font => $setup->{entry_f},
					   -relief => 'sunken',
					   -background => 'white'
					 ) -> pack( -side => 'right' );
    return $pnum_label;
}


sub createTitleGrid
{
    my $family = shift;
    my $op_frame = $family -> OpFrame();
    
    my $grid_frame = $op_frame -> Frame( ) -> pack ( -side   => 'top',
						     -expand => 0, 
						     -fill   => 'x');
    my $n_title = scalar @{$titles};
#    my $width = 15;

    my $titleLabel;

    foreach my $title_column (0 .. ($n_title-1))
    {
	$titleLabel->[$title_column] = $grid_frame->Label( -width => $pageLayout->{CWidth},
							   #-wraplength => $width,
							   -relief => 'sunken',
							   -text  => $titles->[$title_column],
							   -font => $setup->{button_f},
							   -background => 'white');

	$titleLabel->[$title_column] -> grid( -row => 0, 
					      -column => $title_column,  
					      -sticky => 'w' );
    }
}

sub createDataGrid
{
    my $family = shift;
    my $op_frame = $family -> OpFrame();
    
    my $data_frame = $op_frame -> Frame( ) -> pack ( -side   => 'top',
						     -expand => 0, 
						     -fill   => 'x');
    
    my $datalabel;
    my $n_col = $pageLayout->{Column};
    foreach my $rowi (0 .. $pageLayout->{PageSz}-1)
    {
	foreach my $coli (0 .. ($n_col-1))
	{
	    $datalabel->[$rowi][$coli] = $data_frame->Label( -width => $pageLayout->{CWidth},
							     -relief => 'sunken',
							     -font => $setup->{entry_f},
							     -background => $setup->{disabled_entry});
	    $datalabel->[$rowi][$coli] -> grid( -row    => $rowi, 
						-column => $coli,
						-sticky => 'w' );
	}
    } # end outter 'foreach' loop 	

    return $datalabel;

} # End sub createDateGrid


sub createOpButtons
{
    my $family = shift;

    my $parentf = $family -> OpFrame();
    my $buttonf = $parentf -> Frame() ->  pack( -side     => 'bottom',
						-anchor   => 'n',
						-expand   => 1,
						-fill     => 'x' );

    my $quitB = $buttonf -> Button( -font             => $setup->{button_f},
				    -fg               => 'purple',
				    -activebackground => 'black',
				    -activeforeground => 'white',   
				    -text             => "Quit",
				    -command          => [\&quitButtonPressed, $family]
				  ) -> pack( -side => 'right' );  

    my $clearB = $buttonf -> Button( -font             => $setup->{button_f},
				     -fg               => 'purple',
				     -activebackground => 'black',
				     -activeforeground => 'white',   
				     -text             => "Clear",
				     -command          => [\&clearButtonPressed, $family]
				   ) -> pack( -side => 'right' );  

    my $updateB = $buttonf -> Button( -font             => $setup->{button_f},
				      -state            => 'disabled',
				      -fg               => 'purple',
				      -activebackground => 'black',
				      -activeforeground => 'white',   
				      -text             => "Update",
				      -command          => [\&updateButtonPressed, $family]
				    ) -> pack( -side => 'right' );  

    my $imgUpArrow = $buttonf -> Bitmap( -file => "$BITMAP_DIR/uarrw.xbm",
					 -maskfile => "$BITMAP_DIR/uarrw.xbm"
				        );
    my $upButton = $buttonf -> Button( -image   => $imgUpArrow,
				       -command => [\&upButtonPressed, $family]
				     )->pack(-side => 'left'); 

    my $imgDnArrow = $buttonf -> Bitmap( -file => "$BITMAP_DIR/darrw.xbm",
					 -maskfile => "$BITMAP_DIR/darrw.xbm"
				        );
    my $dnButton = $buttonf -> Button( -image   => $imgDnArrow, 
				       -command => [\&downButtonPressed, $family]
				     )->pack(-side => 'left'); 

    my $scanB = $buttonf -> Button( -font             => $setup->{button_f},
				    -fg               => 'purple',
				    -activebackground => 'black',
				    -activeforeground => 'white',   
				    -text             => "Scan",
				    -command          => [\&scanButtonPressed, $family]
				  ) -> pack( -side => 'left' );  

    $family->DbButton( $updateB );

    return;
}


sub enableDbUpdate
{
    my $updateB = shift;

    if( @_ ) #disabling
    {
	$updateB->configure( -state => 'disabled' );
    }
    else
    {
	$updateB->configure( -state => 'normal' );
    }
}


####    callbacks    ####
sub upButtonPressed
{
    my $family = shift;
    my $curP = $family->DataPos();

    if( $curP->{CurPage} > 1 )
    {
	print "Current display page: $curP->{CurPage} \n";
	$curP->{CurPage} --;
	print "Updated display page: ", $family->DataPos()->{CurPage}, "\n";
	
	$family -> updateDataView(); 
	$family -> updatePageNumV();
    }
    
}


sub downButtonPressed
{
    my $family = shift;
    my $curP = $family->DataPos();

    if ( $curP->{PageCnt} > $curP->{CurPage} )
    {
	print "Current display page: $curP->{CurPage} \n";
	$curP->{CurPage} ++;
	print "Updated display page: ", $family->DataPos()->{CurPage}, "\n";
	
	$family -> updateDataView();
	$family -> updatePageNumV();
    }
}


sub scanButtonPressed
{
    my $family = shift;
    my $scanner = $family -> DataSource();
    my $leader = $family -> Leader();
    my $boxid;

    eval
    {
	$boxid = $scanner -> read2DBox( $SCANNER );
    };

    if( $@ )
    {
	#if( $^W )
	{
	    print "$@\n";
	}
	
	my $msg = (split /\n/, $@)[0];
	$leader->updateWarning( $msg );
	return;
    }

    $family -> updateDataPos();
    $family -> updateBoxIdV( $boxid );
    $family -> updateDataView();
    $family -> updatePageNumV();

    enableDbUpdate( $family->DbButton() );

    return;
}


sub clearButtonPressed
{
    # when 'clear', just clear the display and 
    # leave the DataSource intact

    my $family = shift;

    print "Clearing display ...\n";

    $family -> updateDataPos( 'clear' );
    $family -> updateBoxIdV( 'clear' );
    $family -> updatePageNumV( 'clear' );
    $family -> updateDataView( 'clear' );

    enableDbUpdate( $family->DbButton(), 'clear' );

    $family -> DataSource() -> resetData();
}


sub updateButtonPressed
{
    my $family = shift;
    my $datasrc = $family->DataSource();
    
    print "Updating data ...\n";

    $datasrc->recordBoxData();
    $family -> updateDataView();
}


sub quitButtonPressed
{
    my $family = shift;

    $family->Leader()->handleOpQuit();
    $family->end();

    return;
}

1;   # just to keep perl happy
