This is a word search program I wrote to generate word search grids interactively, which I then print out and give to my daughter, who loves them.
#! /usr/bin/perl
######################################################################
+##
## Program: wordsearch
## Description: Interactively queries the user for words to add, then
## adds and displays the modified grid. On completion,
## displays the grid and list of words within.
######################################################################
+##
use strict;
use warnings;
use Getopt::Long;
my $help;
my $width = 20;
my $height = 20;
GetOptions ("help" => \$help,
"width=i" => \$width,
"height=i" => \$height);
if ($help)
{
print <<EOHELP;
Usage: ws [-width W] [-height H] [-help]
EOHELP
exit 1;
}
# Orientations are thus:
# 7 0 1
# \ | /
# 6 --.-- 2
# / | \
# 5 4 3
my @xdelta = (0, 1, 1, 1, 0, -1, -1, -1);
my @ydelta = (-1, -1, 0, 1, 1, 1, 0, -1);
# Initialize the grid.
my @grid;
my @words;
initializeGrid (\@grid, $width, $height);
displayGrid (\@grid);
$| = 1;
srand (time);
my $command = '';
while (1)
{
$command = getCommand ();
last if $command eq 'quit';
if ($command eq 'finish')
{
fillGapsInGrid (\@grid, $width, $height);
displayGrid (\@grid);
displayWords (\@words);
last;
}
if ($command eq 'help' || $command eq '?')
{
print <<EOHELP;
The folllowing commands are supported:
add <word> adds the word to the grid, if possible
help displays this message
? displays this message
finish fills in the remains of the grid, prints out grid and wo
+rds
quit quits program
EOHELP
next;
}
my ($words) = $command =~ /^add (.+)$/;
for my $word (split /\s+/, $words)
{
if (addWord (\@grid, $word))
{
push @words, $word;
displayGrid (\@grid);
}
else
{
print "Could not add '$word'\n";
}
}
}
exit 0;
######################################################################
+##
sub initializeGrid
{
my ($grid, $width, $height) = @_;
for my $r (0 .. $height - 1)
{
$grid->[$r] = '.' x $width;
}
}
######################################################################
+##
sub fillGapsInGrid
{
my ($grid, $width, $height) = @_;
my @alphabet = ('a' .. 'z');
$_ =~ s/\./$alphabet[rand (26)]/eg for @$grid;
}
######################################################################
+##
sub displayGrid
{
my ($grid) = @_;
print "\n";
for (@$grid)
{
my $row = $_;
$row =~ s/(.)/ $1/g;
print $row, "\n";
}
print "\n";
}
######################################################################
+##
sub displayWords
{
my ($words) = @_;
print "\n", join (', ', @$words), "\n";;
}
######################################################################
+##
sub getCommand
{
my $input = '';
while (1)
{
print "> ";
$input = lc <>;
chomp $input;
return $input if $input =~ /^(?:quit|finish|help|\?|add .+)$/;
print "Command '$input' not recognized\n" if $input;
}
}
######################################################################
+##
sub addWord
{
my ($grid, $word) = @_;
# The random algorithm.
for (0 .. $width * $height * 8)
{
my $x = int rand $width;
my $y = int rand $height;
my $dir = int rand 8;
if (wordFits ($grid, $word, $x, $y, $dir))
{
insertWord ($grid, $word, $x, $y, $dir);
return 1;
}
}
# The exhaustive algorithm.
for my $dir (0 .. 7)
{
for my $y (0 .. $height - 1)
{
for my $x (0 .. $width - 1)
{
if (wordFits ($grid, $word, $x, $y, $dir))
{
insertWord ($grid, $word, $x, $y, $dir);
return 1;
}
}
}
}
return 0;
}
######################################################################
+##
sub wordFits
{
my ($grid, $word, $x, $y, $dir) = @_;
#print "testing $word at [$x,$y] dir $dir\n";
my $xi = $xdelta[$dir];
my $yi = $ydelta[$dir];
# Simple rejection based on length.
my $endx = $x + (length ($word) - 1) * $xi;
my $endy = $y + (length ($word) - 1) * $yi;
return 0 if $endx >= $width ||
$endx < 0 ||
$endy >= $height ||
$endy < 0;
for my $i (0 .. length ($word) - 1)
{
my $x0 = $x + ($i * $xi);
my $y0 = $y + ($i * $yi);
#print "looking for " . substr ($word, $i, 1) . " at $x0,$y0\n";
return 0 if substr ($grid->[$y0], $x0, 1) ne '.' &&
substr ($grid->[$y0], $x0, 1) ne substr ($word, $i, 1)
+;
}
return 1;
}
######################################################################
+##
sub insertWord
{
my ($grid, $word, $x, $y, $dir) = @_;
my $xi = $xdelta[$dir];
my $yi = $ydelta[$dir];
for my $i (0 .. length ($word) - 1)
{
my $x0 = $x + ($i * $xi);
my $y0 = $y + ($i * $yi);
my $row = $grid->[$y0];
$row = substr ($row, 0, $x0) .
substr ($word, $i, 1) .
substr ($row, $x0 + 1, length ($row) - $x0 - 1);
$grid->[$y0] = $row;
}
}
######################################################################
+##