$APE::Tk::Tools::FileUpload::VERSION = '1.0';

package APE::Tk::Tools::FileUpload;

use Tk::widgets qw/Button LabFrame Label Entry FileSelect/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use warnings;

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


Construct Tk::Widget 'FileUpload';


my %formats =
  (96  => {'rows' => 8,
	   'cols' => 12},
   384 => {'rows' => 16,
	   'cols' => 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->SUPER::Populate($args);
    $self->_populateFrame;
    $self->ConfigSpecs
      (-state => [[$self->{_text}  ,$self->{_browseBttn},
		   $self->{_loadBttn},
		   $self->{_goBttn},$self->{_fileEntry}],
		  'state','State']);
}


########################################################################
## Method to populate the main frame with the mega widgets child
## widgets
########################################################################
sub _populateFrame {
    my $self = shift;

    my $fileUploadFrame = $self->Frame->pack(-fill=>'x');
    $fileUploadFrame->Label(-text=>'File path:')
	->pack(-side=>'left');

    $self->{_fileEntry} =
      $fileUploadFrame->Entry(-width=>40,-state=>'normal',-textvariable=>\$self->{_f})
	->pack(-side=>'left');

    $self->{_browseBttn} =
      $fileUploadFrame->Button(-text=>'Browse...',-width=>10,-command=>[\&_browseFiles,$self])
	->pack(-side=>'left');

    $self->{_loadBttn} =
      $fileUploadFrame->Button
	(-text=>'Load',-width=>10,
	 -command=>sub{$self->{_clearBttn}->invoke(); $self->_loadFile();})
	->pack(-side=>'left');

    $self->{_text} =
      $self->Scrolled('Text',-scrollbars=>'osoe',-width=>20,-bg=>'white')
	->pack(-fill=>'both',-expand=>1);

    $self->_createFormatOptions($self);

    $self->{_clearBttn} =
      $self->Button
	(-text=>'Clear',-width=>10,-command=>
	 sub{ 
	     $self->{_text}->delete('1.0','end');
	     $self->{_lastFormat} = undef;
	     foreach my $rb (@{$self->{_rbList}}) {
		 $rb->deselect();
	     }
	 })
	->pack(-side=>'left');

    $self->{_goBttn} =
	$self->Button(-text=>'Go',-width=>10,-command=>[\&passToInterestedWidgets,$self])
	->pack(-side=>'right');
}


=item _createFormatOptions(Tk::Frame)

Creates the formats option frame inside the passed frame and poplates
it with the formatting options. Current options are:

96 well - rows to columns (assumes data is in row format and sorts it into column format).
96 well - columns to rows (assumes data is in column format and sorts it into row format).

=cut

sub _createFormatOptions {
    my ($self,$frame) = @_;
    my $lframe =
      $frame->LabFrame
	(-label     => 'Formatting options',
	 -labelside => 'acrosstop')
	  ->pack(-fill => 'x');
    my @options =
      ({ key => '96-row2col',label => '96 well - Rows to columns (converts 96 well row to 96 well column format)' },
       { key => '96-col2row',label => '96 well - Columns to rows (converts 96 well columns to 96 well row format)'});
    my $row=0;
    foreach my $opt (@options) {
	my $key   = $opt->{key};
	my $label = $opt->{label};
	push(@{$self->{_rbList}},
	     $lframe->Radiobutton
	     (-text     => $label,
	      -variable => \$self->{_format},
	      -value    => $key,
	      -command  => [\&convertFormat,$self])
	     ->grid(-column => 0,
		    -row    => $row++,
		    -sticky => 'w'));
    }
}


=item

Callback method from the Tk::Radiobutton widgets in the format frame -
see _createFormatOptions() method.

Calls the sortData() method with the correct parameters for the chosen
formatting option. Repopulates the text area with the sorted data.

=cut

sub convertFormat {
    my $self = shift;
    my $action = $self->{_format};
    return if $self->{_lastFormat}
      && $self->{_lastFormat} eq $self->{_format};
    $self->{_lastFormat} = $action;
    my ($format,$actionName) = $action =~ /^(\d+)-(.*)$/;
    my %sortedContents;
    my @content = $self->getContentByLine();
    if($actionName eq 'row2col') {
	%sortedContents =
	  $self->sortData
	    (\@content,
	    $formats{$format}{cols},
	    $formats{$format}{cols});
    }
    elsif($actionName eq 'col2row') {
	%sortedContents =
	  $self->sortData
	    (\@content,
	     $formats{$format}{cols},
	     $formats{$format}{rows});
    }
    $self->setCurrentContent
      (\%sortedContents);
}



=item sortData(['a','b',..?],$incrementBy,$restartAt)

Sorts the passed data from rows to columns or vice versa. Creates a
start index to represent the new position of the first elemen and
stores it. Subsequent loops create a new index for that element based
on previous index plus $incrementBy. Continues this process until loop
count is not less than $restartAt, then increments the start index by
one and starts again. Produces the following:

Row to column:

old_index  new_index  coordinate
---------- ---------- -----------
    0       1          a1
    12      2          b1
    24      3          c1
    36      4          d1
    48      5          e1
    60      6          f1
    72      7          g1
    84      8          h1
    1       13         a2
    13      14         b2
    25      15         c2
    37      16         d2

etc

Column to row:

old_index  new_index  coordinate
---------- ---------- -----------
    0       1          a1
    8       2          a2
    16      3          a3
    24      4          a4
    32      5          a5
    40      6          a6
    48      7          a7
    56      8          a8
    64      9          a9
    72      10         a10
    80      11         a11
    88      12         a12
    1       13         b1
    9       14         b2
    17      15         b3

=cut

sub sortData {
    my ($self,$data,$incrementBy,$restartAt) = @_;
    my %newContent = ();
    ## This assumes the data is already in row format.
    my $newIndex   = 1;
    my $startIndex = 0;
    for(my $i=0; $i < scalar @$data; $i++) {
	my $value = $data->[$i];
	if(($i % $restartAt) == 0) {
	    $newIndex = ++$startIndex;
	}else{
	    $newIndex += $incrementBy;
	}
	$newContent{$newIndex} = $value;
    }
    return %newContent;
}


=item $fileUpload->setCurrentContent({1 => 'data1',2 => 'data2',...?})


=cut

sub setCurrentContent {
    my ($self,$dataToSet) = @_;
    return unless $dataToSet;
    $self->{_text}->delete('1.0','end');
    foreach my $key (sort{ $a <=> $b } keys %$dataToSet) {
	my $line = $dataToSet->{$key};
	$self->{_text}->insert('end',"$line");
    }
}


=item $fileUpload->getContentByLine()

Extracts the content of the Tk::Text widget and splits it by new line
into a new array. Returns the resulting array with each element
containing a line of data from the widget.

=cut

sub getContentByLine {
    my $self  = shift;
    my $data  = $self->{_text}->get('1.0','end');
    my @lines = split(/\n/,$data);
    my @cLines = map { "$_\n" } @lines;
    return @cLines;
}


########################################################################
## Method to show a FileSelect dialog widget that requests the user to 
## select a file that contains their data to pass.
########################################################################
sub _browseFiles {
    my $self = shift;
    my $home = $ENV{HOME}; #."/badger-svn/APE/bin" || "/nfs/";
    my $file = $self->FileSelect(-directory=>$home)->Show;
    if($file) {
	$self->{_fileEntry}->delete(0,'end');
	$self->{_f} = $file;
    }else{
	$self->{_f} = undef;
    }
}


sub _loadFile {
    my $self = shift;
    if($self->{_f} && -e $self->{_f}) {
	open(FILE,$self->{_f})
	    || die "failed to open file '$self->{_f}': $!";
	my %content = ();
	my $index   = 1;
	while(my $line = <FILE>) {
	    $content{$index++} = $line;
	}
	$self->setCurrentContent(\%content);
    }
}

sub passToInterestedWidgets {
    my $self = shift;
    my @contentLines = $self->getContentByLine();
    return unless scalar @contentLines;
    for(my $i=0; $i < scalar(@contentLines); $i++) {
	if(exists($self->{_interestedWidgets}[$i]) &&
	   $self->{_interestedWidgets}[$i]->isa('Tk::Entry')) {
	    chomp($contentLines[$i]);
	    $contentLines[$i] =~ s/\s+//;
	    $self->{_interestedWidgets}[$i]->insert('end',$contentLines[$i]);
	}else{
	    last;
	}
    }
}

sub setInterestedWidgets {
    my ($self,$widgetList) = @_;
    $self->{_interestedWidgets} = $widgetList;
}
