# build_db.pl - used to update the word list database

#!/usr/bin/perl
use strict;
use warnings;
use Storable;
my (%dict, %seen);

open(my $fh, '<', 'all_words.txt') or die $!;
while (<$fh>) {
    tr/\r\n//d;
    $_ = lc($_);
    next if /[^a-z]/ || length($_) < 3 || $seen{$_}++;
    eval join '', 'push @{$dict', (map {"{$_}"} split //, $_), "{words
+}}, +'$_';";
}
store \%dict, 'my_dict.db';
[download]

# scramble.pl - used to play the game

#!/usr/bin/perl
use strict;
use warnings;
use Storable;
use Win32::GuiTest 'SendKeys';

my $dict = retrieve('my_dict.db');
my @board = split //, $ARGV[0];

my %map;
if (@board == 25) {
    %map = (
        0  => [1, 5, 6],
        1  => [0, 2, 5, 6, 7],
        2  => [1, 3, 6, 7, 8],
        3  => [2, 4, 7, 8, 9],
        4  => [3, 8, 9],
        5  => [0, 1, 6, 10, 11],
        6  => [0, 1, 2, 5, 7, 10, 11, 12],
        7  => [1, 2, 3, 6, 8, 11, 12, 13],
        8  => [2, 3, 4, 7, 9, 12, 13, 14],
        9  => [3, 4, 8, 13, 14],
        10 => [5, 6, 11, 15, 16],
        11 => [5, 6, 7, 10, 12, 15, 16, 17],
        12 => [6, 7, 8, 11, 13, 16, 17, 18],
        13 => [7, 8, 9, 12, 14, 17, 18, 19],
        14 => [8, 9, 13, 18, 19],
        15 => [10, 11, 16, 20, 21],
        16 => [10, 11, 12, 15, 17, 20, 21, 22],
        17 => [11, 12, 13, 16, 18, 21, 22, 23],
        18 => [12, 13, 14, 17, 19, 22, 23, 24],
        19 => [13, 14, 18, 23, 24],
        20 => [15, 16, 21],
        21 => [15, 16, 17, 20, 22],
        22 => [16, 17, 18, 21, 23],
        23 => [17, 18, 19, 22, 24],
        24 => [18, 19, 23]
    );
}
else {
    %map = (
        0  => [1, 4, 5],
        1  => [0, 2, 4, 5, 6],
        2  => [1, 3, 5, 6, 7],
        3  => [2, 6, 7],
        4  => [0, 1, 5, 8, 9],
        5  => [0, 1, 2, 4, 6, 8, 9, 10],
        6  => [1, 2, 3, 5, 7, 9, 10, 11],
        7  => [2, 3, 6, 10, 11],
        8  => [4, 5, 9, 12, 13],
        9  => [4, 5, 6, 8, 10, 12, 13, 14],
        10 => [5, 6, 7, 9, 11, 13, 14, 15],
        11 => [6, 7, 10, 14, 15],
        12 => [8, 9, 13],
        13 => [8, 9, 10, 12, 14],
        14 => [9, 10, 11, 13, 15],
        15 => [10, 11, 14]
    );
}

my %sol;
for my $pos (keys %map) {

    my ($tree, $seen) = ($dict, {});
    my @work = [$tree, $pos, $seen];
    while (@work) {
        my $item = pop @work;
        my ($tree, $node, $seen) = @$item;

        # Can't visit this position again
        my %new_seen = (%$seen, $node => 1);

        # No more words below this depth
        next if ! defined $tree->{$board[$node]};

        my $new_tree = $tree->{$board[$node]};

        # Add words up to this point to the solution list
        @sol{@{$new_tree->{words}}} = () if $new_tree->{words};

        # Add items to the work queue
        for my $pos (@{$map{$node}}) {
            next if $new_seen{$pos};
            push @work, [$new_tree, $pos, \%new_seen];
        }
    }
}
sleep 1;  # Used to change focus to browser window
SendKeys($_ . "~", 17) for sort {length($b) <=> length($a)} keys %sol;
[download]