#!/usr/bin/perl
# wsp_r.pl		Word search puzzle, Assignment 1
use strict;
use warnings;

# Constants
use constant N  => 0;	
use constant NE => 1;
use constant E  => 2;	
use constant SE => 3;
use constant S  => 4;	
use constant SW => 5;
use constant W  => 6;	
use constant NW => 7;

use constant R => 0;
use constant C => 1;

use constant TRUE  => 1;
use constant FALSE => 0;

###########################################################
#####################   main   ############################
my @words;
my @ltrs;

read_file(\@ltrs, \@words);
search(\@ltrs, \@words);
writefile(\@ltrs, \@words);

####################  end main  ###########################
###########################################################

sub step {
	my ($dir, $r, $c) = @_;
	if ($dir == N)     {return (--$r, $c)}
	elsif ($dir == NE) {return (--$r, ++$c)}
	elsif ($dir == E)  {return ($r, ++$c)}
	elsif ($dir == SE) {return (++$r, ++$c)}
	elsif ($dir == S)  {return (++$r, $c)}
	elsif ($dir == SW) {return (++$r, --$c)}
	elsif ($dir == W)  {return ($r, --$c)}
	elsif ($dir == NW) {return (--$r, --$c)}
	else {
		die "Inside 'step': invalid param\n"
	}
}

sub stepback {
	my ($dir, $r, $c) = @_;
	if ($dir == N)     {return (++$r, $c)}
	elsif ($dir == NE) {return (++$r, --$c)}
	elsif ($dir == E)  {return ($r, --$c)}
	elsif ($dir == SE) {return (--$r, --$c)}
	elsif ($dir == S)  {return (--$r, $c)}
	elsif ($dir == SW) {return (--$r, ++$c)}
	elsif ($dir == W)  {return ($r, ++$c)}
	elsif ($dir == NW) {return (++$r, ++$c)}
	else {
		die "Inside 'stepback': invalid param\n";
	}
}

sub read_file {
	my ($ltrs, $words) = @_;
	@ARGV = @ARGV ? @ARGV : ("wp.txt");
	
	# Read in grid of letters
	my @tmp;
	while (<>) {
		last if /^$/;
		chomp;
		@tmp = ();
		for ("\\", split(//, $_), "\\") {
			push @tmp, {
				data     => $_,
				solution => FALSE,
			}
		}
		push @$ltrs, [@tmp];
	}
	
	# Create border
	my $cols = @tmp;
	@tmp = ();
	for (1..$cols) {		
		push @tmp, {
			data     => "\\",
			solution => FALSE,
		}
	}
	unshift @$ltrs, [@tmp];	# Add Top border
	push @$ltrs, [@tmp];    # Add Bottom border
	
	# Read in words to search for
	while (<>) {
		chomp;
		push @$words, {
			data  => $_,
			chars => [split //],
			found => FALSE,
			beg   => [],
			end   => [],
		}
	}
}

sub search {
	my ($ltrs, $words) = @_;
	my $end_row = $#{$ltrs} - 1;
	my $end_col = $#{$ltrs->[0]} - 1;
	
	for my $i ( 1..$end_row ) {
		for my $j ( 1..$end_col ) {
			for my $idx (0..$#words) {
				if (! $words->[$idx]{found} && 
					  $words->[$idx]{chars}[0] eq $ltrs->[$i][$j]{data} ) {
						  
					my ($rows, $cols) = ($i, $j);
					for my $dir (N..NW) {
						my $k = 0;
						($rows, $cols) = step($dir, $rows, $cols);
						look($dir, $ltrs, $words, $rows, $cols, $idx, $k);
						if (! $words->[$idx]{found} ) {
							$rows = $i;
							$cols = $j;
						}
						else {
							$ltrs->[$i][$j]{solution} = TRUE;
							$words->[$idx]{beg}[R] = $i;
							$words->[$idx]{beg}[C] = $j;
							last;
						}
					}
				}
			}
		}
	}
}

sub look {
	my ($dir, $ltrs, $words, $row, $col, $idx, $k) = @_;
	if (++$k != @{ $words->[$idx]{chars} } &&
		$ltrs->[$row][$col]{data} eq $words->[$idx]{chars}[$k] ) {
			
		($row, $col) = step($dir, $row, $col);
		look($dir, $ltrs, $words, $row, $col, $idx, $k);
		if ( $words->[$idx]{found} ) {
			($row, $col) = stepback($dir, $row, $col);
			$ltrs[$row][$col]{solution} = TRUE;
		}
	}
	else {
		if ($k == @{ $words->[$idx]{chars} } ) {
			$words[$idx]{found} = TRUE;
			($row, $col) = stepback($dir, $row, $col);
			$words->[$idx]{end}[R] = $row;
			$words->[$idx]{end}[C] = $col;
		}
	}
}

sub writefile {
	my ($ltrs, $words) = @_;
	
	# Print out puzzle letter grid
	for (my $i = 1; $i < $#{ $ltrs }; ++$i) {
		for (my $j = 1; $j < $#{ $ltrs->[0] }; ++$j) {
			print $ltrs->[$i][$j]{data} . ' ';
		}
		print "\n";
	}
	
	# List search words & their location in the grid
	for (@$words) {
		print $_->{data}, "\t";
		print "R" . $_->{beg}[R] . ' ' . "C" . $_->{beg}[C] . "\t";
		print "R" . $_->{end}[R] . ' ' . "C" . $_->{end}[C] . "\n";
	}
	
	# Print out grid solution
	for (my $i = 1; $i < $#{ $ltrs }; ++$i) {
		for (my $j = 1; $j < $#{ $ltrs->[0] }; ++$j) {
			if ($ltrs->[$i][$j]{solution}) {
				print $ltrs->[$i][$j]{data} . ' ';
			}
			else {
				print "-" . ' ';
			}
		}
		print "\n";
	}
}

__DATA__
SSOKGCYUQMIEAWT
PLIEBXUQNJGDZWT
YQGNKHDAXURPMJG
ETIHWRONGDAXVSQ
NKPIRFADAXVTQOM
JHFMACAEYWURPNL
JHFDEBZGLLUBXVT
RQOMPKIIECHCDFD
BZYWSVGBVRORATR
QONLKHIHEOAFEDC
AZXWTFOSLHVBDDU

BARE
BIG
CLEAR
COOL
DEAD
EMPTY
HARD
LEVEL
LIGHT
PIG
RED
SOFT
SPEAR
WHITE
WRONG