#!/usr/bin/perl -w
use strict qw(subs refs vars);
use Tk;
use Tk::LabEntry;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );

my $thePhrase='';
my $theWords='';
my @theWordList=();
my $theLetters='';
my $theDictionaryFile='/net/noarch/share/dict/anagram';
my $theMinWordLen=1;
my $theMaxWords=10;
my $theMaxNum=100000;
my $theConfigBoxVisible=0;
my $theNumWords='#words/time';
my $theNumAnagrams='#grams/time';


my $mainWindow=MainWindow->new;
$mainWindow->title("An Affront!");

my $tlConfig;

my $pPhrase=$mainWindow->Frame;
my $lPhrase=$pPhrase->Label(-text => 'Phrase:');
my $ePhrase=$pPhrase->Entry(-textvariable => \$thePhrase, -exportselection => 1);

my $pWords=$mainWindow->Frame;
my $lWords=$pWords->Label(-text => 'Words:');
my $eWords=$pWords->Entry(-textvariable => \$theWords, -exportselection => 1);
my $bvDelWord=0;
my $bDelWord=$pWords->Checkbutton(-text=>'delete', 
                                  -indicatoron=>0, 
                                  -variable=>\$bvDelWord,
                                  -command=>sub { $theWords =~ s/\s*\S+\s*$//; $bvDelWord=0; });

my $pAction=$mainWindow->Frame;
my $bvGetDict=0;
my $bGetDict=$pAction->Checkbutton(-text=>'Get Words!', 
                                   -indicatoron=>0, 
                                   -variable=>\$bvGetDict,
                                   -command=>\&getDict);
my $lNumWords=$pAction->Label(-textvariable => \$theNumWords);
my $cbConfigure=$pAction->Checkbutton(-text=>'Configuration', 
                                      -indicatoron=>0, 
                                      -variable=>\$theConfigBoxVisible, 
                                      -command=>\&configure);
my $lNumAnagrams=$pAction->Label(-textvariable => \$theNumAnagrams);
my $bvGetAnagrams=0;
my $bGetAnagrams=$pAction->Checkbutton(-text=>'Get Anagrams', 
                                       -indicatoron=>0, 
                                       -variable=>\$bvGetAnagrams,
                                       -command=>\&getAnagrams);

my $pDict=$mainWindow->Frame;
my $pFilter=$pDict->Frame;
my $eWContains=$pFilter->Entry(-textvariable => \$theLetters, -width=>4);
#my $bvFilter=0;
#my $cbFilter=$pFilter->Checkbutton(-text=>'Filter',
#                                   -indicatoron=>0,
#                                   -variable=>\$bvFilter,
#                                   -command=>\&filterDict);
my $bFilter=$pFilter->Button(-text=>'Filter',
                             -padx=>0, -pady=>0,
                             -command=>\&filterDict);
my $slDict=$pDict->Scrolled('Listbox', -scrollbars => 'e', -selectmode => "single");
$slDict->bind('<Double-Button-1>', \&selectWord);

my $slAnag=$mainWindow->Scrolled('Listbox', -scrollbars => 'e', -selectmode => "single");
$slAnag->bind('<Double-Button-1>', sub { print $slAnag->get($slAnag->curselection()); });



$lPhrase->pack(-side=>'left');
$ePhrase->pack(-side=>'right', -expand=>1, -fill=>'x');
$pPhrase->pack(-side=>'top', -fill=>'x');

$lWords->pack(-side=>'left');
$bDelWord->pack(-side=>'right');
$eWords->pack(-side=>'left', -expand=>1, -fill=>'x');
$pWords->pack(-side=>'top', -fill=>'x');

$lNumWords->pack(-side=>'left');
$bGetDict->pack(-side=>'left');
$lNumAnagrams->pack(-side=>'right');
$bGetAnagrams->pack(-side=>'right');
$cbConfigure->pack(-side=>'left');
$pAction->pack(-side=>'top');

$bFilter->pack(-side=>'left');
$eWContains->pack(-side=>'left');
$pFilter->pack(-side=>'top');
$slDict->pack(-side=>'left', -fill=>'y');
$pDict->pack(-side=>'left', -fill=>'y');
$slAnag->pack(-side=>'right', -fill=>'both', -expand=>1);


sub filterDict
{
    $slDict->delete(0,'end');
    if($theLetters ne '') 
    {
        my $letterre=join('.*',sort(split('',$theLetters)));
        my $word;
        my @fdict=grep { $word=join('',sort(split('',$_))); $word=~m/$letterre/i; } @theWordList;
        $slDict->insert('end',@fdict);
    }
    else
    {
        $slDict->insert('end',@theWordList);
    }
}


sub getDict
{
    if($bvGetDict && -r $theDictionaryFile)
    {
        my $dict    =$theDictionaryFile?" -d '$theDictionaryFile'":'';
        my $used    =$theWords?" -u '$theWords'":'';
        my $minlen  =$theMinWordLen>1?" -m $theMinWordLen":'';
        my $time = [gettimeofday];
        my $phrase=$thePhrase; 
        $phrase=~s/[^[:alpha:]]//g;
        @theWordList=();
        if(open(AN, "an $dict$used$minlen -w '$phrase'|"))
        {
            while(<AN>) { chomp; push(@theWordList, $_); }
            close(AN);
        }
        else
        {
            print STDERR "Command failed: $@\nan $dict$used$minlen -w '$phrase'|";
        }    
        filterDict();
        my $elapsed = int(100*tv_interval( $time, [gettimeofday])+.5)/100;
        $theNumWords = scalar(@theWordList)."w in ${elapsed}s.";
    }
    $bvGetDict=0;
}

sub getAnagrams
{
    if($bvGetAnagrams && -r $theDictionaryFile)
    {
        my $dict    =$theDictionaryFile?" -d '$theDictionaryFile'":'';
        my $used    =$theWords       ?" -c '$theWords'":'';
        my $maxnum  =$theMaxNum      ?" -n $theMaxNum":'';
        my $maxwords=$theMaxWords<10 ?" -l $theMaxWords":'';
        my $time = [gettimeofday];
        my $phrase=$thePhrase; 
        $phrase=~s/[^[:alpha:]]//g;
        open(AN, "an $dict$used$maxnum$maxwords '$phrase'|");
        my @grams=();
        while(<AN>) { chomp; push(@grams, $_); }
        close(AN);
        my $elapsed = int(100*tv_interval( $time, [gettimeofday])+.5)/100;
        $theNumAnagrams = scalar(@grams)." in ${elapsed}s.";
        $slAnag->delete(0,'end');
        $slAnag->insert('end',@grams);
    }
    $bvGetAnagrams=0;
}


sub selectWord
{
    my @words=();
    if($theWords)
    {
        @words=split(/\s+/, $theWords);
        if(!$words[0]) { shift(@words); }
        if(!$words[-1]) { pop(@words); }
    }
    push @words, $slDict->get($slDict->curselection( ));
    $theWords = join(' ', @words);
}


sub configure
{
    if(!$theConfigBoxVisible)
    {
        $tlConfig->withdraw();
    }
    elsif(!$tlConfig)
    {
        $tlConfig=$mainWindow->Toplevel();
        $tlConfig->title('Configure An Affront');
        $tlConfig->Button(-text => 'Close', 
                          -command=>sub { $tlConfig->withdraw(); $theConfigBoxVisible=0; })
            ->pack();
        $tlConfig->LabEntry(-label => 'dictionary', 
                            -textvariable => \$theDictionaryFile)
            ->pack(-expand=>1, -fill=>'x');
        $tlConfig->Scale(-label=>'dictionary min word length', 
                         -variable=>\$theMinWordLen, 
                         -from=>1, -to=>12, 
                         -orient=>'horizontal')
            ->pack(-expand=>1, -fill=>'x');
    }
    else
    {
        $tlConfig->deiconify();
        $tlConfig->raise();
    }
}
MainLoop;