#!/usr/bin/perl

use Tk;

sub insert {
 my $self = shift;
 my ($key) = @_;
 if ($key eq "") {
   $self->[0] = 1;
   return;
 }
 my ($car, $cdr) = ($key =~ /(.)(.*)/);
 my $i = (ord $car) - (ord 'A') + 1;
 $self->[$i] = [] unless ref $self->[$i];
 insert($self->[$i], $cdr);
}

sub valid_words {
 my ($x, $y, $str, %seen) = @_;
 my @vw = ();
 return if $seen{"$x,$y"};
 $seen{"$x,$y"} = 1;
 $str .= $board[$x * 4 + $y];
 push @vw, $str if $w{$str};
 if ($p{$str}) {
  push @vw, valid_words($x-1, $y-1, $str, %seen) if ($x > 0 && $y > 0);
  push @vw, valid_words($x, $y-1, $str, %seen) if ($y > 0);
  push @vw, valid_words($x+1, $y-1, $str, %seen) if ($x < 3 && $y > 0);
  push @vw, valid_words($x-1, $y, $str, %seen) if ($x > 0);
  push @vw, valid_words($x+1, $y, $str, %seen) if ($x < 3);
  push @vw, valid_words($x-1, $y+1, $str, %seen) if ($x > 0 && $y < 3);
  push @vw, valid_words($x, $y+1, $str, %seen) if ($y < 3);
  push @vw, valid_words($x+1, $y+1, $str, %seen) if ($x < 3 && $y < 3);
 }
 return @vw;
}

sub endgame {
 print "Score: $score/", scalar keys %valid_word, " ", 100 * ($score / keys %valid_word), "%\n";
 print join(", ", keys %valid_word), "\n";
 exit;
}

sub check_word {
my $wrd = uc $e->get();
$e->delete(0,"end");
if ($seen_word{$wrd}) { print "Seen: $wrd\n"; return }
if (!$valid_word{$wrd}) { print "Invalid: $wrd\n"; return }
print "$wrd\n";
$seen_word{$wrd} = 1;
$score++;
}

$mw = MainWindow->new();

@dice = ("ednosw", "aaciot", "acelrs", "ehinps",
         "eefhiy", "elpstu", "acdemp", "gilruw",
         "egkluy", "ahmors", "abilty", "adenvz",
         "bfiorx", "dknotu", "abjmoq", "egintv");

@board = 
  map {$_ eq "Q" ? "Qu" : $_}
  map {uc(substr($_->[0],rand(6),1))} 
  sort {$a->[1]<=>$b->[1]} 
  map {[$_,rand()]} 
  @dice;
#@board = map {$_->[0]} sort {$a->[1]<=>$b->[1]} map {[$_,rand()]} @dice;
$c = $mw->Canvas(-width => 400, -height => 400, -background => "white")->pack();
$e = $mw->Entry()->pack(-expand => 1, -fill => x);
$sl = $mw->Label(-textvariable => \$score)->pack();
$t = $mw->Label(-textvariable => \$time)->pack();
$score = 0;
$time = 180;
$mw->repeat(1000,sub{endgame() unless (--$time)});
$e->focus();
$e->bind("<Key-Return>", \&check_word);
for $i (0..3) {
for $j (0..3) {
$c->createText($i * 100 + 50, $j * 100 + 50, -text => $board[$i + 4 * $j], 
-justify => "center", -anchor => "c",
-font => '-*-charter-bold-r-*-*-60-*-*-*-*-*-*-*');
}}

$|=1;
print "Loading dictionary...";
open(IN, "/usr/share/dict/words") or die $!;
for(<IN>) {
chomp;
next if /^[A-Z]/;
next if /[^a-zA-Z]/;
next if length == 2;
$s = uc $_;
foreach(1..((length $s)-1)) {
 $p{substr($s,0,$_)}=1;
}
$w{$s}=1;
$foo++;
print "." unless ($foo % 5000);
}
print "\nDone.\n";
for $i (0..3) {
for $j (0..3) {
$valid_word{$_} = 1 for valid_words($i, $j);
}}
MainLoop();