use strict;
use warnings;
use Tk;

my(@Word, @Guess);
my $wordmax = 6;
my $colmax  = 9;

my $mw = tkinit;

my $f0 = $mw->Frame(-relief => 'groove', -bd => 2)->pack(-padx => 4, -pady => 4);
my $f  = $f0->Frame()->pack(-padx => 4, -pady => 4);

$f->Label(-text => 'Word'   )->grid(-row => 0, -column => 0, -sticky => 'e');
$f->Label(-text => 'Letter' )->grid(-row => 0, -column => 2, -sticky => 'e');
$f->Label(-text => 'Forward')->grid(-row => 0, -column => 3, -sticky => 'we');
$f->Label(-text => 'Reverse')->grid(-row => 0, -column => 4, -sticky => 'we');
for (1 .. $wordmax) {
   $f->Label(
      -text => $_,
   )->grid(-row => $_, -column => 0, -sticky => 'e', -padx => 2);
   $f->Entry(
      -textvariable    => \$Word[$_ - 1],
      -width           => 12,
      -validate        => 'focusout',
      -validatecommand => \&Compute,
   )->grid(-row => $_, -column => 1, -sticky => 'w', -padx => 2);
}
$f->Button(
   -text    => 'Compute',
   -command => \&Compute,
)->grid(-row => $wordmax + 1, -column => 1, -sticky => 'we');

my @options = (
   -width  => 7,
   -bg     => '#E8E8E8',
   -relief => 'sunken',
   -bd     => 2,
   -font   => 'Courier',
);
for (1 .. ($colmax + 3)) {
   my $label = $_;
   if ($label == $colmax + 1) {
      $label = 'Last';
   } elsif ($label == $colmax + 2) {
      $label = 'NW';
   } elsif ($label == $colmax + 3) {
      $label = 'SW';
   }
   $f->Label(-text => $label)->grid(-row => $_, -column => 2, -sticky => 'e', -pady => 2);
   $f->Label(@options, -textvariable => \$Guess[0][$_ - 1])->grid(-row => $_, -column => 3, -sticky => 'we', -padx => 2);
   $f->Label(@options, -textvariable => \$Guess[1][$_ - 1])->grid(-row => $_, -column => 4, -sticky => 'we', -padx => 2);
}

Compute();
$mw->bind('<Return>', \&Compute);

MainLoop;

sub Compute {
   my $w;
   for my $col (0 .. ($colmax - 1)) {
      $w = '';
      for my $word (0 .. ($wordmax - 1)) {
         $w .= Letter($word, $col);
      }
      Load($col, $w);
   }

   $w = '';
   for my $word (0 .. ($wordmax - 1)) {
      my $col = length($Word[$word] || '') - 1;
      $w .= Letter($word, $col);
   }
   Load($colmax, $w);

   my $r = $w = '';
   for my $word (0 .. ($wordmax - 1)) {
      $w .= Letter($word, $word);
      $r .= Letter($wordmax - 1 - $word, $word);
   }
   Load($colmax + 1, $w);
   Load($colmax + 2, $r);
   return(1);
}

sub Load {
   my($i, $s) = @_;
   $Guess[0][$i] = $s;
   $Guess[1][$i] = reverse($s);
}

sub Letter {
   my($word, $col) = @_;
   my $w = $Word[$word] || '';
   my $l = length($w);
   return(uc(substr($w, ($col < $l) ? $col : $l, 1) || '-'));
}