#!/usr/bin/perl
# wordSearchSolve.pl
# Program to solve a word search puzzle semi-automatically.
#
# With thanks to toolic, Limbic~Region and Count Zero of perlmonks.org for 
# suggesting several improvements.
#
# Christopher Dykes (2009-10-19) - (v2.2)

#Enable the following packages:
use strict;		#Enable strict syntax checking
use warnings;		#Enable diagnostic warnings
use Getopt::Long;	#Enable command line option parsing

#Define constants:
use constant 'VERSION' => 2.2;

#Declare local variables:
my($i, $j, $k, $word, $found);	#Various control variables
my $done = 0;			#Whether we're finished or not
my(@start, @end);		#The start and end locations of the word
my @puzzle;			#The puzzle to be searched

#Parse command line options:
my($file, $help, $version);	#Available command line options
GetOptions('file=s' => \$file, 'help' => \$help, 'version' => \$version);

&help				if($help);	#Display the help message
&version			if($version);	#Display the version details
@puzzle = @{&puzzleGet($file)}	if($file);	#Open our file if we have one

exit if($help || $version);

if(!$file)	#Get a file from the user if they haven't supplied one
{
	my $check = " ";
	while($check ne "y")
	{
		print "WARNING: No File supplied, supply now? (y/n) ";
		$check = lc(<STDIN>);
		chomp $check;
		
		exit if($check eq "n");
	}
	print "Enter file name:\t";	$file = <STDIN>;
	@puzzle = @{&puzzleGet($file)};
}

#Display the header:
print "Wordsearch Solver (v", VERSION, "):\n\n";
print "Enter the term to search for, enter '#quit' to exit ";
print "and #help for assistance\n\n";

#Allow the user to search:
while(!$done)
{
	print "> ";	chomp($word = <STDIN>);	#Get the word from the user
	my @chars = split(//,  $word);
	my @words = split(/ /, $word);

	if($chars[0] eq "#")
	{
		$done++		if($word eq "#quit");
		&internalHelp	if($word eq "#help");
		if($words[0] eq "#newpuzzle")
		{
			@puzzle = @{&getPuzzle($words[1])};
		}
	}
	else
	{
		print $word, "\t= ";
		my @word = split(//, $word);

		for($i = 0, $found = 0; $i < @puzzle && !$found; $i++)	#Row loop
		{
			for($j = 0; $j < @puzzle && !$found; $j++)	#Col loop
			{
				for($k = 0; $k < 8 && !$found; $k++)	#Dir loop
				{
					my @gen = ("");
					$found = &search($k, $i, $j, \@puzzle, \@word, @gen);
				}
			}
		}
		print "($i,$j) - ($end[0],$end[1])\n" if($found);
		print "NO RESULT\n" if(!$found);
	}
}

#Subroutines begin here:
sub search	#Performs a recursive search across the puzzle
{
	#Declare local variables:
	my($dir, $row, $col, $puzRef, $wrdRef, @gen) = @_;
	my @puzzle = @{$puzRef};
	my @word   = @{$wrdRef};

	($end[0], $end[1]) = (($row + 1), ($col + 1));	#Set our end location

	return 0 if($puzzle[$row][$col] ne $word[$#gen]);
	return 1 if($#word == $#gen);

	#Decide what to do:
	$row++ if(($dir == 0 || $dir == 4 || $dir == 5) && $row < $#puzzle);
	$row-- if(($dir == 1 || $dir == 6 || $dir == 7) && $row > 0);
	$col++ if(($dir == 3 || $dir == 5 || $dir == 7) && $col < $#puzzle);
	$col-- if(($dir == 2 || $dir == 4 || $dir == 6) && $col > 0);
	
	#Do the useful stuff:
	push(@gen, $puzzle[$row][$col]);
	return 1 if(&search($dir, $row, $col, \@puzzle, \@word, @gen)) || return 0;
}
sub puzzleGet
{
	my @puzzle;

	open(FILEIN, "$_[0]") || die("Couldn't open file $_[0]");

	while(<FILEIN>)
	{
		chomp($_);
		my @line = split(/ /, $_);
		push(@puzzle, \@line);
	}

	return \@puzzle;
}
sub help
{
	print "Usage: wordSearchSolve.pl [OPTION] -f [FILENAME]\n";
	print "A program to solve a word search automatically\n\n";
	print "-f\t--file\t\tLoad the puzzle from this file\n";
	print "-h\t--help\t\tDisplay this message\n";
	print "-v\t--version\tDisplay version information\n\n";
	print "Report bugs to <dykes.chris\@gmail.com>.\n";
}
sub version
{
	print "wordSearchSolve (v", VERSION, ")\n";
	print "Copyright (C) 2009 Christopher Dykes.\n";
	print "License GPLv3+: GNU GPL Version 3 or later <http://gnu.org/licenses/gpl.html>\n";
	print "This is free software: you are free to change and redistribute it.\n";
	print "There is NO WARRANTY, to the extent permitted by law.\n\n";
	print "Written by Christopher Dykes.\n";
	print "With thanks to toolic, Limbic~Region and Count Zero of perlmonks.org\n";
	print "for suggesting several improvements.\n";
}
sub internalHelp
{
	print "\nAvailable commands are:\n";
	print "\t#help\t\tDisplay this message\n";
	print "\t#newpuzzle\tLoad a new puzzle from a file\n";
	print "\t#quit\t\tExit the program\n";
	print "\n";
}