# boggle.pl
use strict;
use warnings;

use Storable;
use Text::Wrap qw(wrap);

# Boggle board board is representated as a flat array 
# with guard squares surrounding the valid squares on 
# all sides. Thus the virtual board size is +2 over the 
# "real" board size.

my $RealSize= 4;
my $BoardSize= $RealSize + 2;
my @board= (" ") x ( $BoardSize ** 2 ); 

# what do we add to "move" from one square to the next.
my @delta= ( -6, -5, 1, 7, 6, 5, -1, -7  ); # N, NE, E, ..., W, NW
my %loc_mask; # map valid locations on the board to specifc bits
              # we use this to prevent visiting a location twice.
my @inorder;  # valid locations on the board in order of 1,1 to 4,4
my $trie= {}; # trie of words in dictionary
              # Digit => HoH of possible successor words.
              # '' => 1 indicates path to this node is a valid word
              # $trie->{words} holds the count.

sub setup {
    my $file= shift;
    # first set up the information about the board
    my $bit= 0;
    for my $y ( 1 .. $RealSize ) {
        for my $x ( 1 .. $RealSize ) {
            my $loc= $x + ( $y * $BoardSize );
            $loc_mask{$loc}= 2 ** ($bit++);
            push @inorder, $loc;
        }
    }

    # Now read the dictionary. If we have already built a trie
    # of the dictionary it might be available as a Storable image
    if ( -e "$file.stor" && -M "$file.stor" < -M $file ) {
        print "Reading stored dictionary... ";
        $trie = retrieve("$file.stor");
        print "$trie->{words} words read\n";
    } else {
        # No up to date storable of the dictionary available.
        print "Reading dictionary... ";
        open my $in,"<",$file
            or die "Can't read '$file':$!";
        while (<$in>) {
            chomp;
            next if length $_ > 16;
            my $n=$trie;
            # add the word to the trie...
            $n= ( $n->{$_} ||= {} )
                for split //, uc $_;
            # mark the last node visited as an accepting state
            $n->{''}=!!1;
        }
        $trie->{words}= $.;
        print "$trie->{words} words read\n";
        print "Storing...";
        store $trie, "$file.stor";
        print "Done\n";
    }
}

# recurse through the possible paths on the board
# using the trie to determine which paths are legal.
sub recurse_find {
    my ( $loc, $words, $node, $bits, $word )= @_;
    if ( $node->{''} ) {
        push @$words,$word;
    }
    foreach my $d (@delta) {
        my $new= $loc+$d;
        my $char= $board[$new];
        if ( $node->{$char} and !($bits & $loc_mask{$new}) ) {
            recurse_find( $new,
                          $words,
                          $node->{$char},
                          $bits + $loc_mask{$new},
                          $word . $char );
        }
    }
}

sub printboard {
    local $_= join "",@board;
    s/^\s+/ /;
    s/\s+$/ /;
    s/  /\n /g;
    print $_,"\n------\n";

}

# loop through all the possible starting positions
# to see what words we find
sub find_words_in_board {
    @board[@inorder]= split //,uc(shift @_);
    my @words;
    printboard();
    foreach my $loc ( @inorder ) {
        my $c=$board[$loc];
        next if ! $trie->{$c};
        recurse_find( $loc,
                      \@words,
                      $trie->{$c},
                      $loc_mask{$loc},
                      $c );
    }
    my %unique;
    $unique{$_}++ for @words;
    print "Got ",0+@words," possible words (",
                 0+keys(%unique)," unique)\n";
    print wrap("","",join ", ",
               map { $unique{$_}>1 ? "$_($unique{$_})" : $_ }
               sort keys %unique),"\n";
}

$|++;

my $board= uc(shift @ARGV) || 'GAUTPRMRDOLAESIC';
my $file= shift(@ARGV) || "D:/dict/enable1.txt";

$board=~s/[^A-Z]//g;

die "Bad board! '$board'" if length($board)!=16;
die "Dictionary '$file' doesn't exist!"
  unless -e $file;

setup($file);
find_words_in_board($board);

__END__
Reading stored dictionary... 172823 words read
 GAUT
 PRMR
 DOLA
 ESIC
------
Got 249 possible words (229 unique)
AG, AI, AIL, AILS, AIS, AL, ALMA, ALOE, ALOES, ALS, ALSO, AM(2), AMA(2),
AMTRAC, AMU(2), APOD, APODS, AR(2), ARM(2), ARMOR, AROMA, AROSE, ART,
ARUM(2), AURA, AURAL, CALM, CALO, CAM, CAR, CARL, CARLS, CART, CIS, CLAM,
CLAMOR, CLOD, CLODS, CLOP, CLOSE, CLOSED, DE, DO, DOE, DOES, DOL, DOLCI,
DOLMA(2), DOLS, DOM, DOMAL, DOPA, DOR, DORM, DORP, DOS, DOSE, DRAG, DRAM,
DRAMA, DROP, DRUM, ED, ES, GAM, GAMA, GAMUT, GAP, GAR, GARLIC, GAUM,
GAUR(2), GRAM, GRAMA, GRUM, GRUMOSE, IS, LA, LAC, LAIC, LAM, LAMA, LAR,
LARUM, LI, LIAR, LIS, LO, LODE, LODES, LOP, LORD, LORDS, LOSE, MA(2), MAC,
MAG, MAIL, MAILS, MALIC, MAP, MAR(2), MARL(2), MARLS(2), MART, MAUT, MO,
MOD, MODE, MODES, MODS, MOIL, MOILS, MOL, MOLA, MOLAR, MOLS, MOP, MOR,
MORA, MOS, MU, MURA(2), MURAL, MURALS, MUT, OD, ODE, ODES, ODS, OE, OES,
OIL, OILS, OM, OP, OR, ORA, OS, OSE, PA, PAM, PAR, PARD, PARDS, PAROL,
PAROLS, PARURA, POD, PODS, POI, POIS, POISE, POISED, POL, POLAR, POLIS,
POLS, POM, POSE, POSED, PRAM, PRAU, PRO, PROD, PRODS, PROM, PROS, PROSE,
PROSED, RAG, RAIL, RAILS, RAISE, RAISED, RAM(2), RAMOSE(2), RAMROD,
RAMRODS, RAP, ROD, RODE, RODS, ROE, ROES, ROIL, ROILS, ROM, ROSE, ROSED,
RUM(2), RUMOR, RURAL, RURALISE, RURALISED, RUT(2), SI, SIAL, SIC, SILO,
SILOED, SLAM, SLOE, SLOP, SO, SOD, SOIL, SOL, SOLA, SOLAR, SOLI, SOMA(2),
SOP, SORA, SORD, TRAIL, TRAILS, TRAM, TUMOR, TURD, TURDS, TURMOIL(2),
TURMOILS(2), UM, URACIL, URACILS, URD, URDS, UT