#!/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
[download]