File Coverage

blib/lib/Games/WordFind.pm

Criterion	Covered	Total	%
statement	6	184	3.2
branch	0	40	0.0
condition	0	13	0.0
subroutine	2	11	18.1
pod	5	9	55.5
total	13	257	5.0

package Games::WordFind;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '0.02';

# declare some package-wide globals
my $lim;
my @letters=("A".."Z");
my @direction=qw(n ne nw e w se s sw);
my $trials=50;

# given a direction, where can a word start and still fit
# in the desired direction:
my %range_hash=(
   'n'  => sub {return ([0..$lim],[(length($_[0])-1)..$lim])},
   's'  => sub {return ([0..$lim],[0..($lim-length($_[0]))])},
   'e'  => sub {return ([0..($lim-length($_[0]))],[0..$lim])},
   'w'  => sub {return ([(length($_[0])-1)..$lim],[0..$lim])},
   'ne' => sub {return ([0..($lim-length($_[0]))],[(length($_[0])-1)..$lim])},
   'nw' => sub {return ([(length($_[0])-1)..$lim],[(length($_[0])-1)..$lim])},
   'se' => sub {return ([0..($lim-length($_[0]))],[0..($lim-length($_[0]))])},
   'sw' => sub {return ([(length($_[0])-1)..$lim],[0..($lim-length($_[0]))])},
   );

# given a direction, how do we adjust the indices for
# subsequent letters when inserting a word:
my %dir_hash=(
   'n'  => [-1,0],
   's'  => [1,0],
   'e'  => [0,1],
   'w'  => [0,-1],
   'ne' => [-1,1],
   'nw' => [-1,-1],
   'se' => [1,1],
   'sw' => [1,-1]
   );


sub new {
    my $that=shift;
    my $class=ref($that)||$that;
    my $self=shift||{};
    $self->{cols}||=10; # default size
    bless $self,$class;
    return $self;
}

# build the intitial lattice with elements of '*'
sub init {
    my $self=shift;
    $self->{lattice}=undef;
    for (0..$self->{cols}-1) {
        push @{$self->{lattice}[$_]},("*")x$self->{cols};
    }
}

sub create_puzzle {
    my $self=shift;
    $self->init();
    @{$self->{words}}=@_;
    my %dropped; #for storing words that don't fit
    $self->{'dropped'}=\%dropped;
    foreach my $word (@{$self->{words}}) {
       if ($self->check_length($word)) {
            warn "Warning: dropping $word, too long!\n";
            $dropped{$word}++;
            next;
       }
       $self->{success}=0;
       my $tries=0;
       until ($self->{success}) {
          $tries++;
          $self->get_direction();
          $self->insert_word($word);
          if ($tries>$trials) {
            warn "too many tries on $word: Dropping $word!\n";
            $dropped{$word}++;
            $self->{success}=1; #its dropped, get out of until loop!
          }
       }
    }
# lattice has words inserted now, and will function as
# a solution matrix --- now copy lattice words into puzzle
# and fill remainder with random letters:
    foreach my $i (0..$#{$self->{lattice}}) {
       foreach my $j (0..$#{$self->{lattice}[$i]}) {
          if ($self->{lattice}[$i][$j] ne '*') {
             $self->{puzzle}[$i][$j]=$self->{lattice}[$i][$j];
          } else {
             $self->{puzzle}[$i][$j]=$letters[rand(@letters)];
          }
       }
    }
# for output, remove 'dropped' words from wordlist and
# sort and up-case the words actually used in the puzzle:
    @{$self->{words}}=map{"      \U$_"}
            sort grep !$dropped{$_},@{$self->{words}};
# hmm, let's actually return ref's to the lattice and such
# so user's can format them however they want if desired:
    my @solution=@{$self->{lattice}};
    my @puzzle=@{$self->{puzzle}};
    my @words=@{$self->{words}};
    return \(@puzzle,@words,@solution);
}

sub check_length {
   my $self=shift;
   return 0 if length($_[0]) <= $self->{cols};
   return 1;
}
sub get_direction {
    my $self=shift;
    $self->{dir}=$direction[rand(@direction)];
}

sub insert_word {
    my $self=shift;
    my $word = shift;
    $word=uc($word);
    $lim=$self->{cols}-1;
    my @ranges = $range_hash{$self->{dir}}->($word);
    unless (@{$ranges[0]} && @{$ranges[1]}) {
        $self->{success}= 0;
        return 0;
    }
    my @x=@{$ranges[0]};
    my @y=@{$ranges[1]};
    my ($j,$i)=($x[rand(@x)],$y[rand(@y)]);
    my @word=split //,$word;
    my @lat_refs=();
    foreach my $letter (@word) {
        if ($self->{intersect}) { #share letters in puzzle
            if ($self->{lattice}[$i][$j] eq '*' ||
                        $self->{lattice}[$i][$j] eq $letter) {
                push @lat_refs,\$self->{lattice}[$i][$j];
                $i+=$dir_hash{$self->{dir}}->[0];
                $j+=$dir_hash{$self->{dir}}->[1];
            } else {
                $self->{success}= 0;
                return 0;
            }
        } else { # don't share letters
            if ($self->{lattice}[$i][$j] eq '*') {
                push @lat_refs,\$self->{lattice}[$i][$j];
                $i+=$dir_hash{$self->{dir}}->[0];
                $j+=$dir_hash{$self->{dir}}->[1];
            } else {
                $self->{success}= 0;
                return 0;
            }
        } #end if intersect
    }# end foreach

    # ok, we have a word and it fits...just assign the letters
    # to the references of the lattice:
    foreach my $l_ref (@lat_refs) {
        $$l_ref=shift @word;
    }
    $self->{success}= 1; # we made it
}

# return a puzzle formatted in plain text, with solution
# matrix appended if $opts_ref->{solution} non-zero
sub get_plain {
    my $self=shift;
    my $opts_ref=shift;
    my @words=@{$self->{words}};
    my $puzzle='';
    $puzzle.= "\t\tWords to Find:\n";
    $puzzle.= "\t\t--------------\n\n";
    while (@words) {
        my @line=@words>2?splice(@words,0,3):splice(@words,0);
        $puzzle.= join("\t",@line)."\n";
    }
    $puzzle.= "\n";
    foreach my $ref (@{$self->{puzzle}}) {
        $puzzle.= "\t\t@$ref\n";
    }
    if ($opts_ref->{solution}) {
        $puzzle.= "\nSolution:\n";
        foreach my $ref (@{$self->{lattice}}) {
            $puzzle.= "\t\t@$ref\n";
        }
    }
    return $puzzle;
}

# return a puzzle formatted in latex tabular form
#   -solution on second page if $opts_ref->{solution} non-zero
#   -complete latex wrapper if $opts_ref->{wrapper} non-zero
sub get_latex {
    my $self=shift;
    my $opts_ref=shift;
    my @words=@{$self->{words}};
    my $title="{\\Large \\textbf{Find The Following Words:}}";
    my $puzzle='';

$puzzle.=<
%% the arraystretch and tabcolsep values used here were found
%% by visual experimentation, not appropriate for other text sizes
\\renewcommand{\\arraystretch}{2.25}
\\renewcommand{\\tabcolsep}{5pt}
\\begin{center}
\\begin{tabular}{lllll}
\\multicolumn{5}{c}{$title}\\\\ \\hline
EOF

    @words=map{"{\\Large $_}"}@words;
    while (@words) {
        my @line=@words>2?splice(@words,0,3):splice(@words,0);
        if (@line<3) {
            @line=@line==2?(@line,''):(@line,'','');
        }
        $puzzle.= join('& &',@line)."\\\\ \n";
    }

$puzzle.=<
\\end{tabular}
\\end{center}
EOF

    my $c=$self->{cols};
    $c='c'x$c;

$puzzle.=<
\\begin{center}
\\begin{tabular}{$c}
EOF

    foreach my $ref (@{$self->{puzzle}}) {
        @$ref=map{"{\\huge $_}"}@$ref;
        $puzzle.= join('&',@$ref)."\\\\ \n";
    }

$puzzle.=<
\\end{tabular}
\\end{center}
EOF

    if ($opts_ref->{solution}) {

$puzzle.=<
\\newpage
\\begin{center}
\\begin{tabular}{$c}
EOF

        foreach my $ref (@{$self->{lattice}}) {
            @$ref=map{"{\\huge $_}"}@$ref;
            $puzzle.= join('&',@$ref)."\\\\ \n";
        }

$puzzle.=<
\\end{tabular}
\\end{center}
EOF
    } # end if solution

    if ($opts_ref->{wrapper}) {

$puzzle=<
\\documentclass[10pt,letterpaper,]{article}
\\oddsidemargin -1in
\\textwidth 8.5in
\\begin{document}
\\pagestyle{empty}
$puzzle
\\end{document}
EOF
    } # end if wrapper
    return $puzzle;
}

#############################
#############################
sub get_html {
    my $self=shift;
    my $opts_ref=shift;
    my @words=@{$self->{words}};
    my $title="Find The Following Words:";
    my $puzzle='';

$puzzle.=<
$title


\n";  




299




 





 





 





 





 





 



 EOF 




300




 





 





 





 





 





 



   




301




0





 





 





 





 





 



     while (@words) { 




302




0




  
  0
  




 





 





 





 



         my @line=@words>2?splice(@words,0,3):splice(@words,0); 




303




0




  
  0
  




 





 





 





 



         if (@line<3) { 




304




0




  
  0
  




 





 





 





 



             @line=@line==2?(@line,''):(@line,'',''); 




305




 





 





 





 





 





 



         } 




306




0





 





 





 





 





 



         $puzzle.= ''. 




307




 





 





 





 





 





 



               join('',@line)."




308




 





 





 





 





 





 



     } 




309




 





 





 





 





 





 



   




310




0





 





 





 





 





 



 $puzzle.="\n";
EOF

    while (@words) {
        my @line=@words>2?splice(@words,0,3):splice(@words,0);
        if (@line<3) {
            @line=@line==2?(@line,''):(@line,'','');
        }
        $puzzle.= '
              join('
    }

$puzzle.="

    my $c=$self->{cols};
    $c='c'x$c;

$puzzle.="\n"; \n"; 




316




 





 





 





 





 





 



   




317




0





 





 





 





 





 



     foreach my $ref (@{$self->{puzzle}}) { 




 




0





 





 





 





 





 



   




318




0





 





 





 





 





 



         @$ref=map{" $_"}@$ref; 




 




0





 





 





 





 





 



   




319




0





 





 





 





 





 



         $puzzle.=''.  




320




 





 





 





 





 





 



               join('',@$ref)."




321




 





 





 





 





 





 



     } 




322




 





 





 





 





 





 



   




323




0





 





 





 





 





 



 $puzzle.="\n";

    foreach my $ref (@{$self->{puzzle}}) {
        @$ref=map{" $_"}@$ref;
        $puzzle.='
              join('
    }

$puzzle.="

    if ($opts_ref->{solution}) {

$puzzle.="Solution:\n"; \n"; 




328




 





 





 





 





 





 



   




329




0





 





 





 





 





 



         foreach my $ref (@{$self->{lattice}}) { 




 




0





 





 





 





 





 



   




330




0





 





 





 





 





 



             @$ref=map{" $_"}@$ref; 




 




0





 





 





 





 





 



   




331




0





 





 





 





 





 



             $puzzle.=''.  




332




 





 





 





 





 





 



                   join('',@$ref)."




333




 





 





 





 





 





 



         } 




334




 





 





 





 





 





 



   




335




0





 





 





 





 





 



 $puzzle.="\n";

        foreach my $ref (@{$self->{lattice}}) {
            @$ref=map{" $_"}@$ref;
            $puzzle.='
                  join('
        }

$puzzle.="
    } # end if solution

    if ($opts_ref->{wrapper}) {

$puzzle=<

 WordFind

$puzzle


EOF
    } # end if wrapper
    return $puzzle;
}

#############################

1;
__END__