package ATR::Proto; # XXX: Various references to this e.g. "if (ATR::Proto->can('foo')) ..."

use strict;
use warnings;

use Tk::Toplevel;
use Tk::TList;

# $Id: Proto.pm,v 1.6 2005/04/18 17:25:06 mca Exp $

#----------------------------------------------------------------------------

my ($mseEd, $list);
sub _list { $list }

sub showMouseEditor {
    my ($guiCard, $mouseName, $mouse) = @_; # $mouse may be undef, for invented mouse...  then we should refuse it

    my $already = 0;
    if (!Tk::Exists($mseEd)) {
	my $main = $guiCard->toplevel;
	$mseEd = $main->Toplevel(Name => 'mouse_editor');
	$mseEd->transient($main);
	$mseEd->minsize(350, 350);
	$mseEd->title("[PROTOTYPE] Mouse editor");
	$list = $mseEd->TList(-orient => 'horizontal', -border => 2, -relief => 'sunken', -height => 2)
	  ->pack(-side => 'top', -fill => 'x');

	my $op_f = btnFrame($mseEd);
    } else {
	$already = 1;
    }

    _list->insert('end', -itemtype => 'text', -text => $mouseName, -data => $mouse);
    return if $already;

    my $info_f = $mseEd->Frame(Name => 'info', -border => 2, -relief => 'raised')
	->pack(-side => 'top', -fill => 'x', -padx => 2, -pady => 2);
    $info_f->Label(-class => 'title', -text => 'Information')
      ->grid(-col => 0, -columnspan => 2, -row => 0);
    my @types = qw( Sex DOB Geno Pheno Ear Coat DNAnum );
    for (my $r=0; $r<@types; $r++) {
	my @lpos = (-labelpos => ($r == 0 ? 'n' : 'none'));
	my @ue = ($info_f->UpdateEntry(-label => 'Date', @lpos),
		  $info_f->UpdateEntry(-label => 'Type', @lpos),
		  $info_f->UpdateEntry(-label => 'Value', @lpos),
		 );
	$ue[0]->setFieldDisplay('label');
	$ue[1]->setFieldDisplay($r+1 == @types ? 'entry' : 'label');
	$ue[2]->setFieldDisplay('entry');
	$ue[0]->setFieldAccessors(-load => sub { $r+1 == @types ? '' : rndDate() });
	$ue[1]->setFieldAccessors(-load => sub { $r+1 == @types ? '' : $types[$r] });
	$ue[2]->setFieldAccessors(-load => sub { $r+1 == @types ? '' : rndString() },
				  -save => sub { },
				  -finish => sub { undef },
				 );

	for (my $c=0; $c<@ue; $c++) {
	    $ue[$c]->grid(-row => $r+1, -col => $c, -stick => 'nsew');
	    $ue[$c]->update;
	}
    }

    my $comm_f = $mseEd->Frame(Name => 'comments', -border => 2, -relief => 'raised')
	->pack(-side => 'top', -fill => 'x', -padx => 2, -pady => 2);
    $comm_f->Label(-class => 'title', -text => 'Comments')->grid(-col => 0, -columnspan => 2, -row => 0);
    my $rows = 7;
    for (my $r=0; $r<$rows; $r++) {
	my @lpos = (-labelpos => ($r == 0 ? 'n' : 'none'));
	my @ue = ($comm_f->UpdateEntry(-label => 'Date', @lpos),
		  $comm_f->UpdateEntry(-label => 'Author', @lpos),
		  $comm_f->UpdateEntry(-label => 'Comment', @lpos),
		 );
	$ue[0]->setFieldDisplay('label');
	$ue[1]->setFieldDisplay('label');
	$ue[2]->setFieldDisplay('entry');
	$ue[0]->setFieldAccessors(-load => sub { $r+1 == $rows ? '' : rndDate() });
	$ue[1]->setFieldAccessors(-load => sub { $r+1 == $rows ? '' : lc(rndWord()) });
	$ue[2]->setFieldAccessors(-load => sub { $r+1 == $rows ? '' : rndString() },
				  -save => sub { },
				  -finish => sub { undef },
				 );

	for (my $c=0; $c<@ue; $c++) {
	    $ue[$c]->grid(-row => $r+1, -col => $c, -stick => 'nsew');
	    $ue[$c]->update;
	}
    }

    my $fate_f = $mseEd->Frame(Name => 'fate', -border => 2, -relief => 'raised')
      ->pack(-side => 'top', -fill => 'x', -padx => 2, -pady => 2);
    $fate_f->Label(-class => 'title', -text => 'Fate')->grid(-col => 0, -columnspan => 2, -row => 0);
    $rows = 3;
    for (my $r=0; $r<$rows; $r++) {
	my @lpos = (-labelpos => ($r == 0 ? 'n' : 'none'));
	my @ue = ($fate_f->UpdateEntry(-label => 'Date', @lpos),
		  $fate_f->UpdateEntry(-label => 'Event', @lpos),
		 );
	$ue[0]->setFieldDisplay('label');
	$ue[1]->setFieldDisplay('entry');
	$ue[0]->setFieldAccessors(-load => sub { $r+1 == $rows ? '' : rndDate() });
	$ue[1]->setFieldAccessors(-load => sub { $r+1 == $rows ? '' : rndString() },
				  -save => sub { },
				  -finish => sub { undef },
				 );

	for (my $c=0; $c<@ue; $c++) {
	    $ue[$c]->grid(-row => $r+1, -col => $c, -stick => 'nsew');
	    $ue[$c]->update;
	}
    }

}

sub rndWord {
    my $len = 2 + int(rand(4));
    my $str = "";
    for (my $c=0; $c<$len; $c++) {
	$str .= chr(65 + int(rand(26)));
    }
    return $str;
}

sub rndString {
    my $len = 3 + int(rand(3));
    my @str;
    for (my $c=0; $c<$len; $c++) {
	push @str, rndWord();
    }
    return ucfirst(lc(join " ", @str));
}

sub rndDate {
    my $d = int(rand(27)) + 1; # 1 - 28 [incomplete range, but ok for Feb]
    my $m = int(rand(11)) + 1; # 1 - 12
    my $y = int(rand( 4)) + 1; # 1 - 5
    return sprintf("%02d/%02d/%02d", $d, $m, $y);
}

sub rndAtrDate {
    my ($h, $m, $s) = (int(rand(24)),
		       int(rand(60)),
		       int(rand(60)));
    my $date = rndDate();
    return ATR::Date->new_GuessDate($date, sprintf("%02d:%02d:%02d", $h, $m, $s));
}

sub btnFrame {
    my ($parentWidget) = @_;

    my $op_f = $parentWidget->Frame(Name => 'buttons_f')->pack(-side => 'bottom', -fill => 'x');
    $op_f->Button(-text => 'Update',
		  -state => 'disabled')
      ->pack(-side => 'right');
    $op_f->Button(-text => 'Cancel',
		  -command => sub { $parentWidget->toplevel->destroy })
      ->pack(-side => 'right');
    $op_f->Button(-text => 'Print?',
		  -state => 'disabled')
      ->pack(-side => 'right');

    return $op_f;
}

sub ATR::Tk::UpdateFieldDate::prototypeHook {
    my $self = shift;
    my $bal = $self->findAtrCard->tlBalloon;
    my $msg;
    $bal->attach($self,
		-msg => \$msg,
		 -postcommand => sub {
		     if ($self->get eq '') { # plain text
			 $msg = "";
		     } else {
			 my $when = eval { $self->getDate };
			 if ($when) {
			     $msg = $when->getDaysOld ." days ago";
			 } else {
			     $msg = "Invalid date: $@";
			 }
		     }
		 });
}

1;
