File Coverage

blib/lib/Games/Literati.pm
Criterion Covered Total %
statement 394 433 90.9
branch 91 122 74.5
condition 43 76 56.5
subroutine 31 35 88.5
pod 11 16 68.7
total 570 682 83.5


line stmt bran cond sub pod time code
1             package Games::Literati;
2 4     4   73217 use warnings;
  4         7  
  4         123  
3 4     4   15 use strict;
  4         6  
  4         64  
4 4     4   13 use Carp;
  4         8  
  4         236  
5              
6 4     4   69 use 5.006;
  4         9  
7             require Exporter;
8              
9             our @ISA = qw(Exporter);
10             our @EXPORT_GAMES = qw(scrabble superscrabble literati wordswithfriends);
11             our @EXPORT_CONFIG = qw($WordFile $MinimumWordLength);
12             our @EXPORT_OTHER = qw(find %valid);
13             our @EXPORT_INFO = qw(n_rows n_cols numTilesPerHand);
14             our @EXPORT_CUSTOMIZER = (@EXPORT_INFO, 'var_init');
15             our @EXPORT_OK = (@EXPORT_GAMES, @EXPORT_CONFIG, @EXPORT_OTHER, @EXPORT_INFO, @EXPORT_CUSTOMIZER);
16             our %EXPORT_TAGS = (
17             'allGames' => [@EXPORT_GAMES],
18             'configGame' => [@EXPORT_CONFIG],
19             'infoFunctions' => [@EXPORT_INFO],
20             'customizer' => [@EXPORT_CUSTOMIZER],
21             'all' => [@EXPORT_OK],
22             ); # v0.032007: add the tags
23              
24             our $VERSION = 0.040;
25             our %valid = ();
26             our @bonus;
27             our @onboard;
28             our %values;
29             our %solutions;
30             our $words;
31             our $bingo_bonus;
32             our @wilds;
33             our $WordFile = './wordlist';
34             our $GameName = '';
35             our $BoardCols = 15; # v0.032001
36             our $BoardRows = 15; # v0.032001
37             our $MinimumWordLength = 2; # v0.032003
38             our $BingoHandLength = 7; # v0.032005
39              
40             sub scrabble {
41 2     2 1 19435 var_init(15,15,7);
42 2         9 _scrabble_init();
43 2         5 display();
44 2         25 search(shift, shift);
45             }
46              
47             sub superscrabble { # v0.032002
48 3     3 1 24686 var_init(21,21,7);
49 3         11 _superscrabble_init();
50 3         6 display();
51 3         37 search(shift, shift);
52             }
53              
54             sub literati {
55 5     5 1 30609 var_init(15,15,7);
56 5         13 _literati_init();
57 5         12 display();
58 5         59 search(shift, shift);
59             }
60              
61             sub wordswithfriends {
62 2     2 1 19499 var_init(15,15,7);
63 2         7 _wordswithfriends_init();
64 2         6 display();
65 2         25 search(shift, shift);
66             }
67              
68 16 50   16 0 52 sub set_rows($) { $BoardRows = shift if defined $_[0]; }
69 16 50   16 0 43 sub set_cols($) { $BoardCols = shift if defined $_[0]; }
70 25482     25482 1 36937 sub n_cols() { return $BoardCols; }
71 2236     2236 1 3622 sub n_rows() { return $BoardRows; }
72 184598     184598   597528 sub _max_col() { return $BoardCols-1; }
73 146582     146582   417722 sub _max_row() { return $BoardRows-1; }
74 2740     2740   2939 sub _center_col() { return _max_col()/2; } # v0.032003
75 70988     70988   73105 sub _center_row() { return _max_row()/2; } # v0.032003
76 0     0 1 0 sub numTilesPerHand() { return $BingoHandLength; } # v0.032005
77              
78             sub var_init {
79 19 100   19 1 4211 set_rows($_[0]) if (defined $_[0]);
80 19 100       60 set_cols($_[1]) if (defined $_[1]);
81 19 50 33     107 croak "INVALID rows=$BoardRows, cols=$BoardCols:\n\tFor now, must be an odd square board, such as 15x15 or 17x17, not 16x16 or 15x17.\n" unless ($BoardRows==$BoardCols) && ($BoardRows % 2 == 1); # v0.032003 this restriction prevents difficult calcs for the center square
82 19 100       46 $BingoHandLength = ($_[2]) if (defined $_[2]);
83              
84 19         100 %values = ();
85 19         91 undef $words;
86 19         205 undef @bonus;
87 19         74 undef %solutions; # v0.032002 = prevents accidentally combining solution sets from multiple games
88              
89 19         35 foreach my $r (0.._max_row) {
90 309         328 foreach my $c (0.._max_col) {
91 5139         4499 undef $bonus[$r][$c];
92             }
93             }
94              
95 19         684 print "Hashing words...\n";
96 19         242 my $fh;
97 19 50       568 open( $fh, $WordFile ) || croak "Cannot open words file \"$WordFile\"\n\t$!";
98 19         342 while (<$fh>) {
99 398         309 chomp;
100 398 100       586 next if length($_) < $MinimumWordLength; # ignore short words (v0.032003)
101 364         371 $valid{$_} = 1;
102 364         258 push @{$words->[length $_]}, $_;
  364         944  
103             }
104 19         215 close $fh;
105             }
106              
107             sub check {
108 0     0 0 0 my @wordlist = @{ pop @_ };
  0         0  
109 0         0 for my $w (@wordlist) {
110 0 0       0 if ($valid{$w} == 1) {
111 0         0 print qq|"$w" is valid.\n|;
112             }
113             else {
114 0         0 print qq|"$w" is invalid.\n|;
115             }
116             }
117             }
118              
119             sub find {
120 4     4   19 no warnings;
  4         6  
  4         4500  
121 0     0 1 0 my $args = shift;
122 0         0 my $letters = $args->{letters};
123 0   0     0 my $re = $args->{re} || "//";
124 0   0     0 my $internal = $args->{internal} || 0;
125 0         0 my $len;
126             my $hint;
127 0         0 my $check_letters;
128 0         0 my @results;
129 0         0 my ($min_len, $max_len) = (split ",", $args->{len});
130 0   0     0 $min_len ||= 2;
131 0   0     0 $max_len ||= 7;
132              
133 0 0       0 croak "Not enough letters.\n" unless (length($letters) > 1);
134              
135              
136 0         0 LINE: for (keys %valid) {
137 0         0 $len = length $_;
138 0 0 0     0 next LINE if ($len > $max_len || $len < $min_len);
139 0         0 $check_letters = $letters;
140              
141 0 0       0 next LINE unless (eval $re);
142 0         0 $hint = "";
143              
144 0         0 for my $l (split //, $_) {
145 0 0 0     0 next LINE unless ( $check_letters =~ s/$l// or
      0        
146             ($check_letters =~ s/\?// and $hint .= "($l)") );
147             }
148 0 0       0 unless ($internal) {
149 0         0 print "$_ $hint\n";
150             }
151             else {
152 0         0 push @results, $_;
153             }
154              
155             }
156 0 0       0 return \@results if $internal;
157             }
158              
159             sub _find {
160 4261     4261   3884 my $letters = shift;
161 4261         3099 my $len = shift;
162 4261         3345 my $re = shift;
163 4261         3505 my $check_letters;
164             my @results;
165 0         0 my @v;
166              
167 4261         3352 LINE: for (@{$words->[$len]}) {
  4261         7157  
168 9563         7851 $check_letters = $letters;
169              
170 9563 100       44571 next LINE unless /^$re$/;
171              
172 798         915 @v = ();
173 798         1653 for my $l (split //, $_) {
174 2101 50 66     17867 next LINE unless ( ( $check_letters =~ s/$l// and push @v, $values{$l} ) or
      33        
      66        
175             ( $check_letters =~ s/\?// and push @v, 0 ) );
176             }
177              
178              
179 197         925 push @results, { "trying" => $_, "values" => [ @v ] };
180             }
181 4261         11893 return \@results;
182             }
183              
184             sub display {
185 37     37 1 41 my $f = shift;
186 37         48 my ($t, $r, $c) = @_;
187              
188 37         83 print "\nBoard:\n";
189 37         480 for my $row (0.._max_row) {
190 609 50       6201 print sprintf "%02d ", $row if $f;
191 609         695 for my $col (0.._max_col) {
192 10269   50     103601 $onboard[$row][$col] ||= '.';
193 10269         14368 print $onboard[$row][$col];
194             }
195 609         6694 print "\n";
196             }
197 37         406 print "\n";
198              
199             }
200              
201             # 0.02: separate input() from search(), to make it easier to override the input() function (for example, with possible future Games::Literati::WebInterface)
202             sub input {
203 12     12 1 15 my $input = "";
204              
205             INPUT:
206 12         20 while(1) {
207 14         28 for my $row (0.._max_row) {
208 214         456 print "row $row:\n";
209 214         2467 $input = ;
210 214         175 chomp $input;
211 214 100       257 if (length($input) > n_cols) {
212 1         2 printf "over board: %d columns is more than %d\n", length($input), n_cols;
213 1         19 next INPUT;
214             }
215 213         1406 $onboard[$row]=[split //, $input];
216             }
217 13         46 print "---------$GameName----------\n";
218 13         185 display();
219              
220 13         141 $input = "";
221 13         43 while( $input !~ /^(yes|no)$/ ) {
222 14         27 print "Is the above correct?\n";
223 14         175 $input = ;
224 14         99 chomp $input;
225             }
226              
227 13 100       59 last INPUT if $input =~ /^yes$/;
228             }
229              
230             WILD:
231 12         13 while(1) {
232 14         29 print "wild tiles are at:[Row1,Col1 Row2,Col2 ...]\n";
233 14         179 $input = ;
234 14         19 chomp $input;
235              
236 14         37 @wilds = ();
237 14 100       46 last WILD unless $input;
238 7         33 my @w = (split /\s/, $input);
239 7         15 for (@w) {
240 17         38 my ($r, $c) = split (/,/, $_);
241 17 100 100     84 unless (defined $onboard[$r][$c] && $onboard[$r][$c] ne '.') {
242 2         4 print "Invalid wild tile positions, please re-enter.\n";
243 2         26 next WILD;
244             }
245 15         31 $wilds[$r][$c] = 1;
246             }
247 5         11 last WILD;
248             }
249              
250             TILES:
251 12         17 while(1) {
252 13         31 print "Enter tiles:\n";
253 13         182 $input = ;
254 13         16 chomp $input;
255 13 100       31 last TILES unless length($input) > $BingoHandLength;
256             }
257 12         36 return lc $input; # v0.032006 = convert to lower case
258             }
259              
260             sub search {
261 12     12 0 19 my $use_min = shift;
262 12         14 my $use = shift;
263 12         15 my $input;
264 12         16 my $best = 0;
265              
266 12         18 $input = input();
267              
268 12         43 print "\nLooking for solutions for $input(in X axis)...\n";
269 12         145 display();
270 12         145 _mathwork($input, "x", $use_min, $use);
271 12         34 _rotate_board();
272              
273 12         66 print "\nLooking for solutions for $input(in Y axis)...\n";
274 12         222 _mathwork($input, "y", $use_min, $use);
275 12         34 _rotate_board();
276              
277 12         17 my @args;
278 12 50       126 for my $key (sort { ($solutions{$b} <=> $solutions{$a}) || ($a cmp $b) } keys %solutions) { # sort by score, then alphabetically by solution
  717         1016  
279 106 100       1272 last if ++$best > 10;
280              
281 98         296 print "Possible Top Ten Solution $best: $key, score $solutions{$key}\n";
282              
283             }
284              
285             }
286              
287             sub _mathwork {
288 4     4   23 no warnings;
  4         4  
  4         11833  
289 24     24   52 $|=1;
290 24         27 my %found;
291 24         35 my $letters = shift;
292 24         85 my @letters = split //, $letters;
293 24         38 my $rotate = ($_[0] eq "y");
294 24   50     91 my $use_min = $_[1] || 1;
295 24   50     65 my $use = $_[2] || scalar @letters;
296 24         30 my $go_on = 0;
297 24         25 my $actual_letters;
298             my $solution;
299              
300 24         54 while ($use >= $use_min) {
301 136         736 print "using $use tiles:\n";
302              
303 136         2529 for my $row (0.._max_row) {
304 2220         2713 for my $col (0..n_rows-$use) {
305 30846 100       47297 next if $onboard[$row][$col] ne '.'; # skip populated tiles
306 25267         20568 $go_on = 0;
307 25267         20477 $actual_letters = $letters;
308 25267         18931 my @thisrow = @{$onboard[$row]};
  25267         79701  
309              
310 25267         21375 my $count = $use;
311 25267         18473 my $column = $col;
312              
313             # make sure that number of letters (count=use) will fit on the board
314 25267         35414 while ($count) {
315 103417 100       104917 if ($column > _max_col) {$go_on = 0; last};
  887         825  
  887         770  
316              
317 102530 100       142478 unless ($go_on) {
318 77800 100 100     327281 if (
      33        
      100        
      66        
      100        
      66        
      100        
      66        
      100        
      66        
319             ($onboard[$row][$col] ne '.') ||
320             ($column > 0 && $onboard[$row][$column-1] ne '.') ||
321             ($column < _max_col && $onboard[$row][$column+1] ne '.') ||
322             ($row > 0 && $onboard[$row-1][$column] ne '.') ||
323             ($row < _max_row && $onboard[$row+1][$column] ne '.') ||
324             ($row == _center_row && $column == _center_col)
325             ) {
326 7036         6669 $go_on = 1;
327             }
328             }
329 102530 100       155278 if ( $thisrow[$column] eq '.' ) {
330 92012         74781 $thisrow[$column] = '/'; # use slash to indicate a letter we want to use
331 92012         66055 $count --;
332             }
333 102530         136309 $column ++;
334             } # $count down to 0
335 25267 50       27713 next if $column > n_cols; # next starting-col if this column has extended beyond the board
336 25267 100       59425 next unless $go_on == 1; # next starting-col if we determined that we should stop this attempt
337              
338             # if we made it here, there's enough room for a word of length==$use;
339             # we have a string that's comprised of
340             # . dots indicating empty spots on the board
341             # / slashes indicating empty spots that we will fill with our new tiles
342             # t letters indicating the letter that's already in that space
343 6149         4933 my $str = "";
344 6149         4641 my $record;
345 6149         6274 map { $str .= $_ } @thisrow; # aka $str = join('',@thisrow);
  102975         103986  
346              
347             # split into pieces of the row: each piece is surrounded by empties
348             # look for the piece that includes the contiguous slashes and letters
349 6149         16465 for (split (/\./, $str)) {
350 46466 100       72557 next unless /\//; # if this piece of the row isn't part of our new word, skip it
351 6149         6423 $record = $str = $_;
352 6149         12835 ~s/\//./g;
353 6149         10461 $str =~ s/\///g;
354 6149         5795 $actual_letters .= $str;
355              
356 6149         5406 my $length = length $_;
357              
358             # look for real words based on the list of 'actual letters', which combines
359             # the tiles in your hand with those letters already in this row.
360             # also grab the point values of each of the tiles in the word
361 6149 100       12610 unless (defined $found{"$actual_letters,$_"}) {
362 4261         5463 $found{"$actual_letters,$_"} = _find($actual_letters, $length, $_);
363             }
364              
365 6149         5391 for my $tryin (@{$found{"$actual_letters,$_"}}) {
  6149         17095  
366              
367 872         827 my @values = @{ $tryin->{values} };
  872         1554  
368 872         1115 my $index = index ($record, "/"); # where the first tile I'm trying is located
369 872         693 my $fail = 0;
370 872         662 my $replace;
371 872         681 my $score = 0;
372 872         741 my $v = 0;
373 872         840 my $trying = $tryin->{trying};
374              
375             # cycle thru each of the the crossing-words (vertical words that intersect the horizontal word I'm laying down)
376 872         1544 for my $c ($col..$col + $length - 1 - $index) {
377 2816         2474 $str = '';
378              
379             # build up the full column-string one character at a time (vertical slice of the board)
380             # this will allow us to check for words that cross with our attempted word
381 2816         3322 for my $r (0.._max_row) {
382 47832 100       49215 if ($r == $row) { # if it's the current row, use the replacement character rather than the '.' that's in the real board
383 2816         3173 $str .= substr ($record, $index, 1);
384 2816         2571 $replace = substr ($trying, $index, 1); # this is the character from $trying that is taking the place of the slash for this column
385 2816         3148 $v = $values[$index++];
386             }
387             else { # otherwise use the character from the real board
388 45016         40963 $str .= $onboard[$r][$c];
389             }
390             } # r row loop
391              
392             # find the sub-word of the column-string that is bounded by the array ends or a . on one side or another, and look for the
393             # subword that contains the / (ie, the row where I'm laying down the new tiles
394 2816         8201 for (split /\./, $str) {
395 25013 100       36222 next unless /\//; # if this sub-word doesn't contain the new-tile row, continue
396 2760 100       4673 next if (length($_) == 1); # if this sub-word contains the new-tile row, but is only one character long, don't score the crossing-word for this column
397             # if it makes it here, I actually found that I'm making a vertical word when I lay down my horizontal tiles, so start scoring
398 663         571 my $t_score = 0; # "t" means temporary; in this block, t_score holds the score for the tiles already laid down in the vertical word
399 663         756 my $vstart = $row - index($_, "/"); # the current vertical word ($_) starts at the board's row=$vstart
400              
401             # loop thru the already existing tiles in the crossing-word; add in their non-bonus score if they are not wild
402             # (non-bonus, because they were laid down in a previous turn, so their bonus has been used up)
403 663         2272 while (/(\w)/g) {
404             # BUGFIX (pcj): use vrow as the row of the current letter of the vertical word
405             # if it's a wild, 0 points, else add its non-bonus value
406 2272         2095 my $vrow = $vstart + pos() - 1; # vstart is the start of the vertical word; pos is the 1-based position in the vertical word; -1 adjusts for the 1-based to get the row of the current \w character $1
407 2272 100       3058 my ($wr,$wc) = ($rotate) ? ($vrow, $c) : ($c, $vrow); # swap row and column for wilds[][] array, since wilds[][] wasn't transposed.
408              
409 2272 100       3708 unless ( $wilds[$vrow][$c] ) {
410 2259         5772 $t_score += $values{$1};
411             }
412              
413              
414             }; # end of vertical-word's real-letter score
415 663         1324 s/\//$replace/;
416              
417             # if my vertical cross-word for this column is a valid word, continue scoring by adding the score for the new tile in this column,
418             # including bonuses activated by the new tile
419 663 100       1044 if ($valid{$_}) {
420 2 50       21 if ($bonus[$row][$c] eq "TL") {
    50          
    50          
    50          
    50          
    0          
421 0         0 $score += $t_score + $v * 3;
422             }
423             elsif ($bonus[$row][$c] eq "DL") {
424 0         0 $score += $t_score + $v * 2;
425             }
426             elsif ($bonus[$row][$c] eq "DW") {
427 0         0 $score += ($t_score + $v) * 2;
428             }
429             elsif ($bonus[$row][$c] eq "TW") {
430 0         0 $score += ($t_score + $v) * 3;
431             }
432             elsif ($bonus[$row][$c] =~ /^(\d+)L$/) { # v0.032002
433 2         8 $score += $t_score + $v * $1;
434             }
435             elsif ($bonus[$row][$c] =~ /^(\d+)W$/) { # v0.032002
436 0         0 $score += ($t_score + $v) * $1;
437             }
438             else {
439 0         0 $score += $t_score + $v;
440             }
441             } # end if valid
442             else { # else invalid
443 661         812 $fail = 1; # fail indicates it's not a valid word
444             } # end else invalid
445             } # for split
446 2816 100       6431 last if $fail; # since (at least) one of the verticals isn't a valid word, the whole horizontal placement is bad, so we can stop trying more columns
447             # future: might replace the $fail flag with named loops, so the else { $fail=1 } above would become else { last FOR_MY_C; }
448              
449             } # $c
450 872 100       2526 next if $fail; # next tryin
451              
452 211         261 my $col_index = 0 - index ($record, "/");
453 211         168 my $t_score = 0; # different lexical scope; this temp score is the score for just the new horizontal word; it will be added to the existing $score above after all bonuses are applied
454 211         196 my $t_flag = '';
455 211         198 my $cc = 0;
456              
457             # this is the scoring for the word I just laid down
458 211         462 for (split //, $trying) {
459 1127 100       1572 if ($onboard[$row][$col+$col_index] eq '.') { # if new tile
460 1037 50       4373 if ($bonus[$row][$col+$col_index] eq "TL") {
    100          
    100          
    100          
    100          
    100          
461 0         0 $t_score += $values[$cc] * 3;
462             }
463             elsif ($bonus[$row][$col+$col_index] eq "DL") {
464 23         39 $t_score += $values[$cc] * 2;
465             }
466             elsif ($bonus[$row][$col+$col_index] =~ /^(\d+)L$/) { # v0.032002
467 57         170 $t_score += $values[$cc] * $1; # multiply tile by the number that prefixes the L
468             }
469             elsif ($bonus[$row][$col+$col_index] eq "DW") {
470 43         49 $t_score += $values[$cc];
471 43         48 $t_flag .= "*2";
472             }
473             elsif ($bonus[$row][$col+$col_index] eq "TW") {
474 2         5 $t_score += $values[$cc];
475 2         3 $t_flag .= "*3";
476             }
477             elsif ($bonus[$row][$col+$col_index] =~ /^(\d+)W$/) { # v0.032002
478 95         110 $t_score += $values[$cc];
479 95         202 $t_flag .= "*$1"; # multiply word by the number that prefixes the W
480             }
481             else {
482 817         763 $t_score += $values[$cc];
483             }
484             } # end if new tile
485             else { # else tile already there
486 90         127 my ($wr, $wc) = ($row, $col + $col_index);
487 90 100       181 ($wc, $wr) = ($wr, $wc) if $rotate; # swap row and column for wilds[][] array, since wilds[][] wasn't transposed.
488 90 50       213 unless ($wilds[$wr][$wc]) {
489 90         121 $t_score += $values{$_};
490             }
491             } # end else already a tile there
492 1127         813 $cc ++;
493 1127         1016 $col_index ++;
494             } # foreach split trying
495              
496 211         11010 $score += eval "$t_score$t_flag"; # add in the bonus-enabled horizontal score to the pre-calculated veritcal scores
497             # POSSIBLY CLEARER: if $t_flag is just changed to $word_multiplier with an integer value starting at 1,
498             # then this could be $t_score * $word_multiplier;
499 211 100       666 $score += $bingo_bonus if $use == $BingoHandLength; # add in bingo-bonus if all tiles used (v0.032005: configurable)
500              
501 211 100       1076 $solution = ($rotate?"column" : "row") .
    100          
    100          
502             " $row become: '$trying' starting at " .
503             ($rotate?"row" : "column") .
504             " $col " .
505             ($use == $BingoHandLength ? "(BINGO!!!!)" : ""); # v0.032005 = configurable
506              
507 211         882 print "($score)\t$solution\n";
508 211         4711 $solutions{"$solution using $use tile(s)"} = $score;
509              
510             } # end for my tryin
511             } # end for split
512              
513             } # end col
514             } # end row
515 136         1751 $use --;
516             } # end use
517              
518             }
519              
520              
521             sub _rotate_board {
522              
523 24     24   45 for my $row (0..(_max_row-1)) {
524 372         437 for my $col ($row+1.._max_col) {
525 3150         4514 ($onboard[$col][$row], $onboard[$row][$col]) = ($onboard[$row][$col], $onboard[$col][$row]);
526             }
527             }
528 24         49 ($BoardRows, $BoardCols) = ($BoardCols, $BoardRows);
529             }
530              
531             sub _init {
532 0     0   0 _scrabble_init();
533             }
534              
535             sub set_bonus_4quad { # v0.032009
536             # _set_bonus_4quad(r,c,b) will set the bonus array based on the row, column, and bonus text supplied
537             # it puts them in the four quadrants (r,c), (#-r,c), (r,#-c), (#-r,#-c) to keep a perfectly-balanced
538             # board
539 338   100 338 0 550 my $ra = shift || 0;
540 338   100     494 my $ca = shift || 0;
541 338   50     484 my $b = shift || '';
542              
543 338         348 my $rb = _max_row - $ra;
544 338         358 my $cb = _max_col - $ca;
545              
546 338         307 $bonus[$ra][$ca] = $b;
547 338         283 $bonus[$rb][$ca] = $b;
548 338         263 $bonus[$ra][$cb] = $b;
549 338         254 $bonus[$rb][$cb] = $b;
550              
551 338         303 return $b;
552             }
553              
554             sub _scrabble_init {
555              
556 3     3   8 $GameName = "Scrabble";
557             ##########################################################################
558             # Scrabble #
559             ##########################################################################
560             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
561             # 0 [TW][__][__][DL][__][__][__][TW][__][__][__][DL][__][__][TW] # 0 #
562             # 1 [__][DW][__][__][__][TL][__][__][__][TL][__][__][__][DW][__] # 1 #
563             # 2 [__][__][DW][__][__][__][DL][__][DL][__][__][__][DW][__][__] # 2 #
564             # 3 [DL][__][__][DW][__][__][__][DL][__][__][__][DW][__][__][DL] # 3 #
565             # 4 [__][__][__][__][DW][__][__][__][__][__][DW][__][__][__][__] # 4 #
566             # 5 [__][TL][__][__][__][TL][__][__][__][TL][__][__][__][TL][__] # 5 #
567             # 6 [__][__][DL][__][__][__][DL][__][DL][__][__][__][DL][__][__] # 6 #
568             # 7 [TW][__][__][DL][__][__][__][DW][__][__][__][DL][__][__][TW] # 7 #
569             # 8 [__][__][DL][__][__][__][DL][__][DL][__][__][__][DL][__][__] # 8 #
570             # 9 [__][TL][__][__][__][TL][__][__][__][TL][__][__][__][TL][__] # 9 #
571             # 10 [__][__][__][__][DW][__][__][__][__][__][DW][__][__][__][__] # 10 #
572             # 11 [DL][__][__][DW][__][__][__][DL][__][__][__][DW][__][__][DL] # 11 #
573             # 12 [__][__][DW][__][__][__][DL][__][DL][__][__][__][DW][__][__] # 12 #
574             # 13 [__][DW][__][__][__][TL][__][__][__][TL][__][__][__][DW][__] # 13 #
575             # 14 [TW][__][__][DL][__][__][__][TW][__][__][__][DL][__][__][TW] # 14 #
576             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
577             ##########################################################################
578              
579 3         12 set_bonus_4quad(0,0,'TW');
580 3         6 set_bonus_4quad(0,7,'TW'); # middle column
581 3         7 set_bonus_4quad(7,0,'TW'); # middle row
582              
583 3         14 set_bonus_4quad(1,1,'DW');
584 3         9 set_bonus_4quad(2,2,'DW');
585 3         7 set_bonus_4quad(3,3,'DW');
586 3         28 set_bonus_4quad(4,4,'DW');
587 3         9 set_bonus_4quad(7,7,'DW'); #center
588              
589 3         8 set_bonus_4quad(0,3,'DL');
590 3         10 set_bonus_4quad(2,6,'DL');
591 3         16 set_bonus_4quad(3,0,'DL');
592 3         7 set_bonus_4quad(3,7,'DL');
593 3         7 set_bonus_4quad(6,2,'DL');
594 3         7 set_bonus_4quad(6,6,'DL');
595 3         9 set_bonus_4quad(7,3,'DL'); #middle row
596              
597 3         6 set_bonus_4quad(1,5,'TL');
598 3         5 set_bonus_4quad(5,1,'TL');
599 3         7 set_bonus_4quad(5,5,'TL');
600              
601 3         6 for my $row (0.._max_row) {
602 45         49 for my $col (0.._max_col) {
603 675         589 $onboard[$row][$col] = '.';
604             }
605             }
606              
607             %values = (
608 3         43 a=>1,
609             b=>3,
610             c=>3,
611             d=>2,
612             e=>1,
613             f=>4,
614             g=>2,
615             h=>4,
616             i=>1,
617             j=>8,
618             k=>5,
619             l=>1,
620             m=>3,
621             n=>1,
622             o=>1,
623             p=>3,
624             q=>10,
625             r=>1,
626             s=>1,
627             t=>1,
628             u=>1,
629             v=>4,
630             w=>4,
631             x=>8,
632             y=>4,
633             z=>10
634             );
635 3         6 $bingo_bonus = 50;
636             }
637              
638             sub _superscrabble_init { # v0.032002
639              
640 4     4   11 $GameName = "SuperScrabble";
641              
642             ##################################################################################################
643             # SuperScrabble #
644             ##################################################################################################
645             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 #
646             # 0 [4W][__][__][2L][__][__][__][3W][__][__][2L][__][__][3W][__][__][__][2L][__][__][4W] # 0 #
647             # 1 [__][2W][__][__][3L][__][__][__][2W][__][__][__][2W][__][__][__][3L][__][__][2W][__] # 1 #
648             # 2 [__][__][2W][__][__][4L][__][__][__][2W][__][2W][__][__][__][4L][__][__][2W][__][__] # 2 #
649             # 3 [2L][__][__][3W][__][__][2L][__][__][__][3W][__][__][__][2L][__][__][3W][__][__][2L] # 3 #
650             # 4 [__][3L][__][__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__][__][3L][__] # 4 #
651             # 5 [__][__][4L][__][__][2W][__][__][__][2L][__][2L][__][__][__][2W][__][__][4L][__][__] # 5 #
652             # 6 [__][__][__][2L][__][__][2W][__][__][__][2L][__][__][__][2W][__][__][2L][__][__][__] # 6 #
653             # 7 [3W][__][__][__][__][__][__][2W][__][__][__][__][__][2W][__][__][__][__][__][__][3W] # 7 #
654             # 8 [__][2W][__][__][3L][__][__][__][3L][__][__][__][3L][__][__][__][3L][__][__][2W][__] # 8 #
655             # 9 [__][__][2W][__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__][2W][__][__] # 9 #
656             # 10 [2L][__][__][3W][__][__][2L][__][__][__][2W][__][__][__][2L][__][__][3W][__][__][2L] # 10 #
657             # 11 [__][__][2W][__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__][2W][__][__] # 11 #
658             # 12 [__][2W][__][__][3L][__][__][__][3L][__][__][__][3L][__][__][__][3L][__][__][2W][__] # 12 #
659             # 13 [3W][__][__][__][__][__][__][2W][__][__][__][__][__][2W][__][__][__][__][__][__][3W] # 13 #
660             # 14 [__][__][__][2L][__][__][2W][__][__][__][2L][__][__][__][2W][__][__][2L][__][__][__] # 14 #
661             # 15 [__][__][4L][__][__][2W][__][__][__][2L][__][2L][__][__][__][2W][__][__][4L][__][__] # 15 #
662             # 16 [__][3L][__][__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__][__][3L][__] # 16 #
663             # 17 [2L][__][__][3W][__][__][2L][__][__][__][3W][__][__][__][2L][__][__][3W][__][__][2L] # 17 #
664             # 18 [__][__][2W][__][__][4L][__][__][__][2W][__][2W][__][__][__][4L][__][__][2W][__][__] # 18 #
665             # 19 [__][2W][__][__][3L][__][__][__][2W][__][__][__][2W][__][__][__][3L][__][__][2W][__] # 19 #
666             # 20 [4W][__][__][2L][__][__][__][3W][__][__][2L][__][__][3W][__][__][__][2L][__][__][4W] # 20 #
667             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 #
668             ##################################################################################################
669              
670              
671 4         11 set_bonus_4quad( 0, 0,'4W');
672              
673 4         7 set_bonus_4quad( 0, 7,'3W');
674 4         10 set_bonus_4quad( 3, 3,'3W');
675 4         7 set_bonus_4quad( 3,10,'3W'); # middle column
676 4         8 set_bonus_4quad( 7, 0,'3W');
677 4         7 set_bonus_4quad(10, 3,'3W'); # middle row
678              
679 4         6 set_bonus_4quad( 1, 1,'2W');
680 4         8 set_bonus_4quad( 1, 8,'2W');
681 4         13 set_bonus_4quad( 2, 2,'2W');
682 4         8 set_bonus_4quad( 2, 9,'2W');
683 4         13 set_bonus_4quad( 4, 4,'2W');
684 4         16 set_bonus_4quad( 5, 5,'2W');
685 4         8 set_bonus_4quad( 6, 6,'2W');
686 4         10 set_bonus_4quad( 7, 7,'2W');
687 4         7 set_bonus_4quad( 8, 1,'2W');
688 4         9 set_bonus_4quad( 9, 2,'2W');
689 4         10 set_bonus_4quad(10,10,'2W'); # center
690              
691 4         6 set_bonus_4quad( 2, 5,'4L');
692 4         9 set_bonus_4quad( 5, 2,'4L');
693              
694 4         9 set_bonus_4quad( 1, 4,'3L');
695 4         10 set_bonus_4quad( 4, 1,'3L');
696 4         10 set_bonus_4quad( 4, 8,'3L');
697 4         8 set_bonus_4quad( 8, 4,'3L');
698 4         5 set_bonus_4quad( 8, 8,'3L');
699              
700 4         10 set_bonus_4quad( 0, 3,'2L');
701 4         11 set_bonus_4quad( 0,10,'2L'); # middle column
702 4         8 set_bonus_4quad( 3, 0,'2L');
703 4         10 set_bonus_4quad( 3, 6,'2L');
704 4         7 set_bonus_4quad( 5, 9,'2L');
705 4         7 set_bonus_4quad( 6, 3,'2L');
706 4         9 set_bonus_4quad( 6,10,'2L'); # middle column
707 4         6 set_bonus_4quad( 9, 5,'2L');
708 4         8 set_bonus_4quad( 9, 9,'2L');
709 4         6 set_bonus_4quad(10, 0,'2L'); # middle row
710 4         6 set_bonus_4quad(10, 6,'2L'); # middle row
711              
712 4         10 for my $row (0.._max_row) {
713 84         93 for my $col (0.._max_col) {
714 1764         1658 $onboard[$row][$col] = '.';
715             }
716             }
717              
718             %values = (
719 4         55 a=>1,
720             b=>3,
721             c=>3,
722             d=>2,
723             e=>1,
724             f=>4,
725             g=>2,
726             h=>4,
727             i=>1,
728             j=>8,
729             k=>5,
730             l=>1,
731             m=>3,
732             n=>1,
733             o=>1,
734             p=>3,
735             q=>10,
736             r=>1,
737             s=>1,
738             t=>1,
739             u=>1,
740             v=>4,
741             w=>4,
742             x=>8,
743             y=>4,
744             z=>10
745             );
746 4         8 $bingo_bonus = 50;
747             }
748              
749             sub _literati_init {
750              
751 6     6   14 $GameName = "Literati";
752              
753             ##########################################################################
754             # Literati #
755             ##########################################################################
756             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
757             # 0 [__][__][__][3W][__][__][3L][__][3L][__][__][3W][__][__][__] # 0 #
758             # 1 [__][__][2L][__][__][2W][__][__][__][2W][__][__][2L][__][__] # 1 #
759             # 2 [__][2L][__][__][2L][__][__][__][__][__][2L][__][__][2L][__] # 2 #
760             # 3 [3W][__][__][3L][__][__][__][2W][__][__][__][3L][__][__][3W] # 3 #
761             # 4 [__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__] # 4 #
762             # 5 [__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__] # 5 #
763             # 6 [3L][__][__][__][2L][__][__][__][__][__][2L][__][__][__][3L] # 6 #
764             # 7 [__][__][__][2W][__][__][__][__][__][__][__][2W][__][__][__] # 7 #
765             # 8 [3L][__][__][__][2L][__][__][__][__][__][2L][__][__][__][3L] # 8 #
766             # 9 [__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__] # 9 #
767             # 10 [__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__] # 10 #
768             # 11 [3W][__][__][3L][__][__][__][2W][__][__][__][3L][__][__][3W] # 11 #
769             # 12 [__][2L][__][__][2L][__][__][__][__][__][2L][__][__][2L][__] # 12 #
770             # 13 [__][__][2L][__][__][2W][__][__][__][2W][__][__][2L][__][__] # 13 #
771             # 14 [__][__][__][3W][__][__][3L][__][3L][__][__][3W][__][__][__] # 14 #
772             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
773             ##########################################################################
774              
775 6         14 set_bonus_4quad(0,3,'3W');
776 6         11 set_bonus_4quad(3,0,'3W');
777              
778 6         11 set_bonus_4quad(1,5,'2W');
779 6         10 set_bonus_4quad(3,7,'2W'); # middle column
780 6         8 set_bonus_4quad(5,1,'2W');
781 6         15 set_bonus_4quad(7,3,'2W'); # middle row
782              
783 6         12 set_bonus_4quad(0,6,'3L');
784 6         10 set_bonus_4quad(3,3,'3L');
785 6         7 set_bonus_4quad(5,5,'3L');
786 6         9 set_bonus_4quad(6,0,'3L');
787              
788 6         11 set_bonus_4quad(1,2,'2L');
789 6         11 set_bonus_4quad(2,1,'2L');
790 6         13 set_bonus_4quad(2,4,'2L');
791 6         10 set_bonus_4quad(4,2,'2L');
792 6         10 set_bonus_4quad(4,6,'2L');
793 6         10 set_bonus_4quad(6,4,'2L');
794              
795 6         9 $bingo_bonus = 35;
796              
797 6         9 for my $row (0.._max_row) {
798 90         98 for my $col (0.._max_col) {
799 1350         1280 $onboard[$row][$col] = '.';
800             }
801             }
802              
803             %values = (
804 6         94 a=>1,
805             b=>2,
806             c=>1,
807             d=>1,
808             e=>1,
809             f=>3,
810             g=>1,
811             h=>2,
812             i=>1,
813             j=>5,
814             k=>3,
815             l=>1,
816             m=>1,
817             n=>1,
818             o=>1,
819             p=>2,
820             q=>5,
821             r=>1,
822             s=>1,
823             t=>1,
824             u=>1,
825             v=>4,
826             w=>4,
827             x=>5,
828             y=>3,
829             z=>5
830             );
831              
832             }
833              
834             sub _wordswithfriends_init {
835              
836 3     3   8 $GameName = "Words With Friends";
837              
838             ##########################################################################
839             # Words With Friends #
840             ##########################################################################
841             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
842             # 0 [__][__][__][3W][__][__][3L][__][3L][__][__][3W][__][__][__] # 0 #
843             # 1 [__][__][2L][__][__][2W][__][__][__][2W][__][__][2L][__][__] # 1 #
844             # 2 [__][2L][__][__][2L][__][__][__][__][__][2L][__][__][2L][__] # 2 #
845             # 3 [3W][__][__][3L][__][__][__][2W][__][__][__][3L][__][__][3W] # 3 #
846             # 4 [__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__] # 4 #
847             # 5 [__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__] # 5 #
848             # 6 [3L][__][__][__][2L][__][__][__][__][__][2L][__][__][__][3L] # 6 #
849             # 7 [__][__][__][2W][__][__][__][__][__][__][__][2W][__][__][__] # 7 #
850             # 8 [3L][__][__][__][2L][__][__][__][__][__][2L][__][__][__][3L] # 8 #
851             # 9 [__][2W][__][__][__][3L][__][__][__][3L][__][__][__][2W][__] # 9 #
852             # 10 [__][__][2L][__][__][__][2L][__][2L][__][__][__][2L][__][__] # 10 #
853             # 11 [3W][__][__][3L][__][__][__][2W][__][__][__][3L][__][__][3W] # 11 #
854             # 12 [__][2L][__][__][2L][__][__][__][__][__][2L][__][__][2L][__] # 12 #
855             # 13 [__][__][2L][__][__][2W][__][__][__][2W][__][__][2L][__][__] # 13 #
856             # 14 [__][__][__][3W][__][__][3L][__][3L][__][__][3W][__][__][__] # 14 #
857             # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 #
858             ##########################################################################
859              
860 3         9 set_bonus_4quad(0,3,'3W');
861 3         7 set_bonus_4quad(3,0,'3W');
862              
863 3         8 set_bonus_4quad(1,5,'2W');
864 3         7 set_bonus_4quad(3,7,'2W'); # middle column
865 3         8 set_bonus_4quad(5,1,'2W');
866 3         11 set_bonus_4quad(7,3,'2W'); # middle row
867              
868 3         7 set_bonus_4quad(0,6,'3L');
869 3         7 set_bonus_4quad(3,3,'3L');
870 3         5 set_bonus_4quad(5,5,'3L');
871 3         5 set_bonus_4quad(6,0,'3L');
872              
873 3         6 set_bonus_4quad(1,2,'2L');
874 3         6 set_bonus_4quad(2,1,'2L');
875 3         6 set_bonus_4quad(2,4,'2L');
876 3         7 set_bonus_4quad(4,2,'2L');
877 3         6 set_bonus_4quad(4,6,'2L');
878 3         4 set_bonus_4quad(6,4,'2L');
879              
880 3         4 $bingo_bonus = 35;
881              
882 3         6 for my $row (0.._max_row) {
883 45         47 for my $col (0.._max_col) {
884 675         584 $onboard[$row][$col] = '.';
885             }
886             }
887              
888             %values = (
889 3         47 a=>1,
890             b=>4,
891             c=>4,
892             d=>2,
893             e=>1,
894             f=>4,
895             g=>3,
896             h=>3,
897             i=>1,
898             j=>10,
899             k=>5,
900             l=>2,
901             m=>4,
902             n=>2,
903             o=>1,
904             p=>4,
905             q=>10,
906             r=>1,
907             s=>1,
908             t=>1,
909             u=>2,
910             v=>5,
911             w=>4,
912             x=>8,
913             y=>3,
914             z=>10
915             );
916              
917             }
918              
919             sub _text_bonus_board { # v0.032010
920 4     4   13 my $str = "";
921 4         3 my ($row, $col);
922 4         7 $str .= " ##" . "#"x4 . "####"x(n_rows) . "#"x8 . "\n";
923 4         6 $str .= sprintf " # %-*s #\n", (4*n_rows+10), $GameName;
924 4         6 $str .= " ##" . "#"x4 . "####"x(n_rows) . "#"x8 . "\n";
925 4         5 $str .= sprintf " # %-4s", '';
926 4         5 $str .= join '', map { sprintf " %-3d", $_ } @{[0 .. _max_col]};
  66         93  
  4         6  
927 4         14 $str .= " "x7 . "#\n";
928 4         5 for $row (0.._max_row) {
929 66         77 $str .= sprintf " # %-4d", $row;
930 66         67 for $col (0.._max_col) {
931 1116   100     2439 $str .= sprintf "[%2s]", $bonus[$row][$col]||'__';
932             }
933 66         81 $str .= sprintf " # %-4d#\n", $row;
934             }
935 4         6 $str .= sprintf " # %-4s", '';
936 4         4 $str .= join '', map { sprintf " %-3d", $_ } @{[0 .. _max_col]};
  66         98  
  4         8  
937 4         13 $str .= " "x7 . "#\n";
938 4         7 $str .= " ##" . "#"x4 . "####"x(n_rows) . "#"x8 . "\n";
939 4         15 return $str;
940             }
941              
942             1;
943              
944              
945             =pod
946              
947             =head1 NAME
948              
949             Games::Literati - For word games like Literati (or Scrabble, or Words With Friends), find the best-scoring solution(s) for a board and hand of tiles.
950              
951             =head1 SYNOPSIS
952              
953             use Games::Literati qw/:allGames/;
954             literati();
955             wordswithfriends();
956             scrabble();
957             superscrabble();
958              
959             =head2 Export Tags
960              
961             =over
962              
963             =item :allGames => C, C, C, C
964              
965             =item :configGame => C<$WordFile>, C<$MinimumWordLength>
966              
967             =item :infoFunctions => C, C, C
968              
969             =begin comments
970              
971             =item :customizer => C<:infoFunctions>, C
972              
973             =end comments
974              
975             =back
976              
977             =head1 DESCRIPTION
978              
979             B helps you find out I solutions for a given
980             board and tiles. It can be used to play
981             L (the original 15x15 grid),
982             L (the official 21x21 extended grid),
983             L (an old Yahoo! Games 15x15 grid, from which B derives its name), and
984             L (a newer 15x15 grid).
985             By overriding or extending the package, one could implement other similar letter-tile grids,
986             with customizable bonus placements.
987              
988             To use this module to play the games, a one-liner such as the
989             following can be used:
990              
991             perl -MGames::Literati=literati -e "literati();"
992              
993             Enter the data prompted then the best 10 solutions will be displayed.
994              
995             =head2 Board Input
996              
997             The game will prompt you for each row of the board, one row at a time
998              
999             row 0:
1000             row 1:
1001             ...
1002             row 14:
1003              
1004             And will expect you to enter the requested row's data. It expects one
1005             character for each column on the board. Thus, on a standard 15x15 board,
1006             it will expect each row to contain 15 characters. The `C<.>' character
1007             represents an empty square. Individual letters (in lower case) represent
1008             tiles that have already been laid on the board. (Don't worry about
1009             indicating wild tiles just yet; that will come momentarily.) An example
1010             input row could be:
1011              
1012             .......s.header
1013              
1014             After requesting the last row, the B will display the
1015             board as it received it, and ask you
1016              
1017             Is the above correct?
1018              
1019             At this point, it is expecting you to type either `C' or `C'.
1020             If you answer `C', the game will progress. If you answer `C',
1021             it will start over asking for C. If you answer with anything
1022             else, it will ask you again if everything is correct.
1023              
1024             Once you have entered `C', B will ask you for
1025             the coordinates of the any wild tiles already on the board
1026              
1027             wild tiles are at:[Row1,Col1 Row2,Col2 ...]
1028              
1029             C and C are 0-referenced, so the upper left of the board
1030             is C<0,0>, and the lowe right of the standard board is C<14,14>.
1031             Multiple wild tiles are space-separated. If there have not been any
1032             wild tiled played yet, just hit C, giving it an empty input.
1033             If you have wilds, with one at one-tile diagonally from the upper right
1034             and the second two tiles diagonally from the lower-left, you would
1035             enter
1036              
1037             1,13 12,2
1038              
1039             If your coordinates resolve to an empty tile (C<.>) or a tile that's
1040             not on the board, you will be notified:
1041              
1042             Invalid wild tile positions, please re-enter.
1043             wild tiles are at:[Row1,Col1 Row2,Col2 ...]
1044              
1045             Finally, after receiving a valid input for the wilds, B
1046             will ask you for what tiles are in your hand.
1047              
1048             Enter tiles:
1049              
1050             You should enter anywhere from 1 to 7 tiles (for a standard game).
1051             Letter tiles should be in lower case; wild tiles are indicated by a
1052             question mark `C'.
1053              
1054             ?omment
1055              
1056             It is recommended to pre-write everything into a file. and run the
1057             program via command-line. See the L, below.
1058              
1059             =head1 SAMPLE TURNS
1060              
1061             These samples will use input file F, to help ensure the correct
1062             input format.
1063              
1064             As described above, the first 15 lines represent board situation, followed
1065             with "yes", followed by wild tile positions, if none, place a empty
1066             line here, then followed by tiles (can be less than 7), use ? to
1067             represent wild tiles. Please make sure the last line in your file
1068             ends with a full NEWLINE character on your system (it's safest to add
1069             a blank line after the list of tiles).
1070              
1071             I' in the working directory when running
1072             the program, or to set C<$WordFile> to the path to your dictionary.>
1073              
1074             =head2 First Turn
1075              
1076             Create game file named F, like this:
1077              
1078             ...............
1079             ...............
1080             ...............
1081             ...............
1082             ...............
1083             ...............
1084             ...............
1085             ...............
1086             ...............
1087             ...............
1088             ...............
1089             ...............
1090             ...............
1091             ...............
1092             ...............
1093             yes
1094              
1095             ?omment
1096            
1097              
1098             Run the game from the command line:
1099              
1100             perl -MGames::Literati=literati -e'literati()' < t
1101              
1102             The output will be (depending on word list)
1103              
1104             [...]
1105             using 7 tiles:
1106             (47) row 7 become: 'comment' starting at column 1 (BINGO!!!!)
1107             (47) row 7 become: 'memento' starting at column 1 (BINGO!!!!)
1108             (47) row 7 become: 'metonym' starting at column 1 (BINGO!!!!)
1109             (47) row 7 become: 'momenta' starting at column 1 (BINGO!!!!)
1110             (47) row 7 become: 'momento' starting at column 1 (BINGO!!!!)
1111             [...]
1112             Possible Ten Best Solution 1: row 7 become: 'metonym' starting at column 5 (BINGO!!!!) using 7 tile(s), score 47
1113             Possible Ten Best Solution 2: row 7 become: 'moments' starting at column 6 (BINGO!!!!) using 7 tile(s), score 47
1114             Possible Ten Best Solution 3: row 7 become: 'momenta' starting at column 6 (BINGO!!!!) using 7 tile(s), score 47
1115             Possible Ten Best Solution 4: column 7 become: 'omentum' starting at row 7 (BINGO!!!!) using 7 tile(s), score 47
1116             Possible Ten Best Solution 5: column 7 become: 'memento' starting at row 7 (BINGO!!!!) using 7 tile(s), score 47
1117             Possible Ten Best Solution 6: column 7 become: 'memento' starting at row 1 (BINGO!!!!) using 7 tile(s), score 47
1118             Possible Ten Best Solution 7: row 7 become: 'comment' starting at column 3 (BINGO!!!!) using 7 tile(s), score 47
1119             Possible Ten Best Solution 8: row 7 become: 'omentum' starting at column 7 (BINGO!!!!) using 7 tile(s), score 47
1120             Possible Ten Best Solution 9: row 7 become: 'omentum' starting at column 1 (BINGO!!!!) using 7 tile(s), score 47
1121             Possible Ten Best Solution 10: column 7 become: 'memento' starting at row 5 (BINGO!!!!) using 7 tile(s), score 47
1122              
1123             If you run the same board with the Scrabble engine:
1124              
1125             $ perl -MGames::Literati=scrabble -e'scrabble()' < t
1126              
1127             You will get
1128              
1129             [...]
1130             (76) row 7 become: 'comment' starting at column 1 (BINGO!!!!)
1131             (76) row 7 become: 'memento' starting at column 1 (BINGO!!!!)
1132             (72) row 7 become: 'metonym' starting at column 1 (BINGO!!!!)
1133             [...]
1134             Possible Ten Best Solution 1: column 7 become: 'memento' starting at row 1 (BINGO!!!!) using 7 tile(s), score 76
1135             Possible Ten Best Solution 2: column 7 become: 'momento' starting at row 1 (BINGO!!!!) using 7 tile(s), score 76
1136             Possible Ten Best Solution 3: row 7 become: 'metonym' starting at column 5 (BINGO!!!!) using 7 tile(s), score 76
1137             Possible Ten Best Solution 4: row 7 become: 'momenta' starting at column 1 (BINGO!!!!) using 7 tile(s), score 76
1138             [...]
1139              
1140             =head2 Intermediate Turn
1141              
1142             For most turns, you input file the F containing a partially
1143             populated game, such as:
1144              
1145             ...............
1146             ...............
1147             ...............
1148             .......c.......
1149             ......ai.......
1150             .......s.header
1151             .......t....r..
1152             ...jurors..soup
1153             .......o....p.h
1154             .upsilon.f..pea
1155             .......speering
1156             .........s..n.e
1157             .........t..g..
1158             .........e.....
1159             ........broils.
1160             yes
1161             7,8 10,14 7,14
1162             eurmsss
1163            
1164              
1165             Run the game from the command line:
1166              
1167             perl -MGames::Literati=literati -e'literati()' < t
1168              
1169             The output will be (depending on word list)
1170              
1171             [....]
1172             using 7 tiles:
1173             using 6 tiles:
1174             (9) row 3 become: 'cussers' starting at column 8
1175             (9) row 12 become: 'russets' starting at column 4
1176             using 5 tiles:
1177             (8) row 3 become: 'cruses' starting at column 8
1178             (8) row 3 become: 'curses' starting at column 8
1179              
1180             [...]
1181             Possible Ten Best Solution 1: column 3 become: 'susses' starting at row 10 using 5 tile(s), score 24
1182             Possible Ten Best Solution 2: column 3 become: 'serums' starting at row 10 using 5 tile(s), score 24
1183             [...]
1184              
1185             If you run the same board with the Scrabble engine:
1186              
1187             perl -MGames::Literati=scrabble -e'scrabble()' < t
1188              
1189             You will get
1190              
1191             [...]
1192             Possible Ten Best Solution 1: row 14 become: 'embroils' starting at column 6 using 2 tile(s), score 36
1193             Possible Ten Best Solution 2: row 6 become: 'stems' starting at column 6 using 4 tile(s), score 23
1194             Possible Ten Best Solution 3: column 2 become: 'spumes' starting at row 8 using 5 tile(s), score 22
1195             [...]
1196              
1197             Good luck!:)
1198              
1199             =head1 PUBLIC FUNCTIONS
1200              
1201             =over 4
1202              
1203             =item literati([I[, I]])
1204              
1205             =item wordswithfriends([I[, I]])
1206              
1207             =item scrabble([I[, I]])
1208              
1209             =item superscrabble([I[, I]])
1210              
1211             These functions execute each of the games. As shown in the L
1212             and L, each turn generally requires just one call to
1213             the specific game function. Each function implements the appropriate
1214             15x15 (or 20x20 for superscrabble) grid of bonus scores.
1215              
1216             There are two optional arguments to the game functions:
1217              
1218             =over 4
1219              
1220             =item I
1221              
1222             The minimum number of tiles to play, which defaults to C<1>. If you
1223             want to only allow your computer player (I, the B
1224             module) to play 3 or more tiles, you would set I=C<3>.
1225              
1226             If you specify C<0> or negative, the magic of perl will occur, and it
1227             will internally use the default of I=C<1>.
1228              
1229             =item I
1230              
1231             The maximum number of tiles to play, which defaults to all the tiles
1232             in the given hand. If you want to restrict your computer player to play 5
1233             or fewer tiles, you would set I=C<5>. It will check to ensure that
1234             I is bounded by the C..
1235              
1236             If you want to specify I, you B also specify a I.
1237              
1238             If you specify I less than I, B will not play
1239             any tiles.
1240              
1241             =back
1242              
1243             Thus, specifying C will restrict the computer Literati
1244             player to using 3, 4, or 5 tiles on this turn.
1245              
1246             =item find(I<\%args>) or find(I<$args>)
1247              
1248             Finds possible valid words, based on the hashref provided. When playing
1249             the automated game using the above functions, this is not needed, but it
1250             is provided to give you access to a function similar to the internal function,
1251             but it outputs extra information to the user.
1252              
1253             =over 4
1254              
1255             =item \%args or $args
1256              
1257             A reference to a hash containing the keys C, C, and
1258             C.
1259              
1260             =over 4
1261              
1262             =item $args->{etters}
1263              
1264             This is the list of letters available to play.
1265              
1266             =item $args->{re}
1267              
1268             This is a string which will be evaluated into a perl regular
1269             expression that is evaluated to determine. Note: this requres the
1270             full regex syntax, so use C<'/c.t/'> to indicate you are looking
1271             for valid letters to put between a `c' and a `t'.
1272              
1273             =item $args->{internal}
1274              
1275             (Boolean) If set to a true value, find() will be quiet (not print
1276             to standard output) and will return an array-reference of possible
1277             solutions. If false, find() will print suggested words to STDOUT.
1278              
1279             =back
1280              
1281             =back
1282              
1283             B: The I function is not under active development, and changes to the
1284             internal function might not be replicated to this public function. (It is
1285             documented and left exportable to be backward compatible with the original
1286             B release.)
1287              
1288              
1289             =back
1290              
1291             =head1 PUBLIC VARIABLES
1292              
1293             These variables are exportable, so can be fully qualified as
1294             C<%Games::Literati::valid>, or if included in the export list
1295             when you C the module, you can reference them directly,
1296             as
1297              
1298             use Games::Literati qw/literati $WordFile/;
1299             $WordFile = '/usr/share/dict/words';
1300              
1301             =over 4
1302              
1303             =item $WordFile
1304              
1305             The C<$WordFile> points to a text document, which lists one valid word per line.
1306              
1307             The variable defaults to './wordfile'. (in version 0.01, that was the
1308             only value, and there was no variable.)
1309              
1310             You may change the default wordfile by setting this variable to the path
1311             to find the list.
1312              
1313             $Games::Literati::WordFile = '/usr/dict/words';
1314              
1315              
1316             Sources for C<$WordFile>
1317              
1318             =over
1319              
1320             =item * Your OS may include a builtin dictionary (such as F or
1321             F). Beware: these often have numbers or
1322             punctuation (periods, hyphens), which may interfere with proper functioning
1323              
1324             =item * ENABLE (Enhanced North American Benchmark Lexicon): a
1325             public-domain list with more than 173,000 words, available at a variety of locations,
1326             including in an old L
1327             repository|https://code.google.com/archive/p/dotnetperls-controls/downloads>
1328             as
1329             "L"
1330             The ENABLE dictionary is used by a variety of online tools, and is
1331             the primary source for the official L dictionary.
1332              
1333             =item * Anthony Tan has delved into the Words With Friends app, and
1334             has compared their internal list to the original ENABLE list at
1335             L
1336              
1337             =back
1338              
1339             If you want to use one of the lists from a website, you will need
1340             to download the list to a file, and set C<$WordFile> to the path
1341             to your downloaded list.
1342              
1343             =item %valid
1344              
1345             For each I that B parses from the C<$WordList>
1346             file, it will set C<$valid{I}> to C<1>.
1347              
1348             =item $MinimumWordLength
1349              
1350             Default = 2. This is used when parsing the dictionary file (during C)
1351             to ignore words that are too short. Most of these games don't allow
1352             single-letter words ("I", "a").
1353              
1354             =back
1355              
1356             =begin comment
1357              
1358             =head1 CUSTOMIZATION
1359              
1360             You can override the private internal functions to get your own
1361             functionality. This might be useful if you would like to make
1362             a sub-package (maybe that use a GUI interface), or if you'd like to
1363             build a script on your webserver that will host a game where you
1364             can play against B.
1365              
1366             These brief notes are intended as hints for how to get started.
1367              
1368             For a sub-package, B, you could
1369             inherit from B, and define your own
1370             package-specific I and I functions, which
1371             you could then ask if you could add to the B
1372             distribution.
1373              
1374             For a standalone application, F, you could just C
1375             Games::Literati> and override the default functions, such as
1376             defining your own C function.
1377              
1378             =over 4
1379              
1380             =item sub display()
1381              
1382             This subroutine displays the current state of the board.
1383              
1384             By default, it outputs the board to STDOUT as a 15x15 grid:
1385              
1386             ...............
1387             ...............
1388             ...............
1389             ...............
1390             ...............
1391             ...............
1392             ...............
1393             ...............
1394             ...............
1395             ...............
1396             ...............
1397             ...............
1398             ...............
1399             ...............
1400             ...............
1401              
1402             Override the subroutine to change the style of output
1403              
1404             sub Games::Literati::display { # overrides default behavior
1405             my $f = shift;
1406              
1407             print "\nBoard:\n";
1408             for my $row (0..14) {
1409             print sprintf "%02d ", $row if $f;
1410             for my $col (0..14) {
1411             # use _ instead of .
1412             my $c = $Games::Literati::onboard[$row][$col] || '_';
1413             $c =~ s/\./_/g;
1414             print $c;
1415             }
1416             print "\n";
1417             }
1418             print "\n";
1419             }
1420              
1421             =item input()
1422              
1423             Ask for the current board data: existing tile positions,
1424             wild-tile positions, and the tiles in your hand, and initiate the search
1425             for valid words using the existing board and your hand.
1426              
1427             Overriding sub Games::Literati::input (similarly to display, above)
1428             will allow a change in input method, such as via CGI. Look at the source
1429             code for the default input(), so you know what globals need to be set,
1430             and what to return.
1431              
1432             =item var_init(I, I, I)
1433              
1434             Initialize the board setup, including number of rows and number of columns,
1435             and the number of tiles in a (full) hand. Bingos occur when the number of
1436             tiles played equals I).
1437              
1438             This is used when manually defining a new game. For example, if you wanted
1439             to define a game called C with a 7x7 board, and only 5 tiles
1440             dealt to each player, the "game engine routine" would be defined as
1441              
1442             # run the game:
1443             sub tinyscrabble {
1444             var_init(7,7,5);
1445             _tinyscrabble_init();
1446             display();
1447             search(shift, shift);
1448             }
1449              
1450             =item define your own board
1451              
1452             When creating your own custom game, you need a subroutine to
1453             define the game. Pattern it similar to the following:
1454              
1455             # define the board:
1456             use Games::Literati; # COMING SOON: the use Games::Literati qw/:customizer/
1457             # which will make it easy to get rid of all the $Games::Literati:: prefixes
1458             sub _tinyscrabble_init {
1459             # name the game
1460             $Games::Literati::GameName = "TinyScrabble";
1461              
1462             # define the bonuses
1463             $Games::Literati::bonus[0][0] = 'DW';
1464             # ...
1465             $Games::Literati::bonus[6][6] = 'DW';
1466              
1467             for my $row (0.._max_row) {
1468             for my $col (0.._max_col) {
1469             $onboard[$row][$col] = '.';
1470             }
1471             }
1472              
1473             %Games::Literati::values = (
1474             a => 1,
1475             z => 1000,
1476             )
1477              
1478             $Games::Literati::bingo_bonus = 5000;
1479             }
1480              
1481             =back
1482              
1483             =end comment
1484              
1485             =head1 BUGS AND FEATURE REQUESTS
1486              
1487             Please report any bugs or feature requests emailing C
1488             or thru the web interface at L.
1489              
1490             A simple interface (with examples) for play your own custom grid is in the works. Studying
1491             the source code may point you in the right direction if you want a custom grid before the
1492             customization features are made public.
1493              
1494             =head1 AUTHOR
1495              
1496             Chicheng Zhang Cchichengzhang AT hotmail.comE> wrote the original code.
1497              
1498             Peter C. Jones Cpetercj AT cpan.orgE> has added various feature
1499             and made bug fixes.
1500              
1501             =head1 LICENSE AND COPYRIGHT
1502              
1503             Copyright (c) 2003, Chicheng Zhang. Copyright (C) 2016 by Peter C. Jones
1504              
1505             This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
1506              
1507             =cut