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