# 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;