Here is my response to Slipstream's Word Seek. This script prints the same output to the screen as Word Seek, except this script actually searches the puzzle text to find the words. Go ahead and change the search terms and letters in the search area. It will still work.

Restrictions:

  • Search area must be in ALL CAPS
  • It only works on a 16x16 letter search area as shown. 

    use strict;       use warnings;

my  @hidden_words_to_find  =  (
'PERL',  'USESTRICT',  'ARRAY',
'PERLMONKS', 'LENGTH', 'WHILE',
'FOREACH', 'MODULUS',   'CPAN',
'SUBROUTINE','PRINT', 'SCALAR',
'REGEX', 'IF','ELSE',   'WARN',
'BLESS', 'EXIT','HASH', 'JAPH',

);$_='

P X U S E S T R I C T G L A F I
I E E R Z I A P S Z R E E A W N
X A R R A Y E K E D J D L D F J
D F S L W M N C J C E R I C E R
U H F C M O N L E N G T H I D O
M R X H M H Z W I E R X W A S D
H E Y L C E S T R V H W D E W Q
E G R X W M U A D F E G E L S E
C E M J F O R E A C H T R H E C
P X U H R D T Y R P Y N B X P B
W C B B Z U E N R A W A C V R E
D F U V D L S A C N B V Y A I T
S S E L B U B H E W S D L N N D
A D X G E S F K S J G A R T T F
F G I E B N S B Z A C W Q U E A
S D T G A E R N N S H P A J Q D

';my $a=q(s;\n;;g;s# ##g;@_=spl
it(//,$_);my$i=0;for(@_){($i%16
 eq 0)?(print $/):();print,prin
t ' ';$i++}for my$word(@hidden_
words_to_find){my$m=$word;my$g=
$m;$g =~ tr~A-Z~a-z~;my$gi='s/'
."$m".'/'."$g".'/gi';eval$gi;my
 @m=split(//,$m);my @g=split(//
,$g);$gi='s/';for($i=0;$i<(@m-1
);$i++){$gi.="$m[$i]".'(\w{15})
';}$gi.="$m[$i++]".'/';for($i=0
;$i<(@g-1);$i++){my$j=$i+1;$gi.
="$g[$i]".'$'."$j";}$gi.="$g[$i
++]".'/gi';eval$gi;@m=split(//,
$m);@g=split(//,$g);$gi='s/';fo
r($i=0;$i<(@m-1);$i++){$gi.="$m
[$i]".'(\w{16})';}$gi.="$m[$i++
]".'/';for($i=0;$i<(@g-1);$i++)
{my$j=$i+1;$gi.="$g[$i]".'$'."$
j";}$gi.="$g[$i++]".'/gi';eval$
gi;$gi='s/';for($i=0;$i<(@m-1);
$i++){$gi.="$m[$i]".'(\w{14})';
}$gi.="$m[$i++]".'/';for($i=0;$
i<(@g-1);$i++){my$j=$i+1;$gi.="
$g[$i]".'$'."$j";}$gi.="$g[$i++
]".'/gi';eval$gi;@m=reverse(@m)
;@g=reverse(@g);$gi='s/';for($i
=0;$i<(@m-1);$i++){$gi.="$m[$i]
".'(\w{16})';}$gi.="$m[$i++]".'
/';for($i=0;$i<(@g-1);$i++){my$
j=$i+1;$gi.="$g[$i]".'$'."$j";}
$gi.="$g[$i++]".'/gi';eval$gi;$
gi='s/';for($i=0;$i<(@m-1);$i++
){$gi.="$m[$i]".'(\w{14})';}$gi
.="$m[$i++]".'/';for($i=0;$i<(@
g-1);$i++){my$j=$i+1;$gi.="$g[$
i]".'$'."$j";}$gi.="$g[$i++]".'
/gi';eval$gi;$gi='s/';for($i=0;
$i<(@m-1);$i++){$gi.="$m[$i]".'
(\w{15})';}$gi.="$m[$i++]".'/';
for($i=0;$i<(@g-1);$i++){my$j=$
i+1;$gi.="$g[$i]".'$'."$j";}$gi
.="$g[$i++]".'/gi';eval$gi;$m=j
oin"",@m;$g=join"",@g;$gi='s/'.
"$m".'/'."$g".'/gi';eval$gi;}pr
int $/;s;[A-Z]; ;g;@_=split"",$
_;$i=0;for(@_){($i%16 eq 0)?(pr
int $/):();print,print ' ';$i++
});$a=~ s;$/;;g;eval$a; __END__

    [download]
    Now if only I could get it to work with erudil's find-a-func...

    Update: Corrected the array->arrax bug. Well spotted Monarch!

    • Replies are listed 'Best First'.
    Re: Word Seeker
    by monarch (Priest) on Jun 16, 2005 at 07:53 UTC
      Very funky indeed! But I get:
      p   u s e s t r i c t       f i
  e             s       e
  a r r a x   k         l
      l     n       e   i
          o   l e n g t h
  r     m       i       w
  e   l       t
  g r     m u           e l s e
  e     f o r e a c h
p x     r d       p         p
      b   u   n r a w       r
    u     l       n       a i
s s e l b u   h         l   n
    x     s     s     a     t
    i             a c
    t             s h p a j

      [download]
      Just wondering why array comes out as "arrax" in the puzzle output..?
    		[reply]
    [d/l]
        "array" came out "arrax" because my translation range was wrong. tr~A-Z~a-x~ instead of tr~A-Z~a-z~. Darn keys are too close together...It's fixed now, I think.
    		[reply]
    [d/l]
    [select]
    Re: Word Seeker
    by kaif (Friar) on Jun 22, 2005 at 08:21 UTC

      Here's my attempt to do the same thing. The same restrictions apply to my code. Hope you enjoy it!

      Note: I have taken a few liberties in my code: I have changed the format of the "header", because I like qw, and I have changed the word warn to die.

      use strict;       use warnings;

@_=my @hidden_words_to_find=qw(
PERL USESTRICT ARRAY SUBROUTINE
EXIT CPAN FOREACH MODULUS BLESS
WHILE PERLMONKS PRINT SCALAR IF
REGEX ELSE DIE LENGTH HASH JAPH
);$_='

P X U S E S T R I C T G L A F I
I E E R Z I A P S Z R E E I D N
X A R R A Y E K E D J D L D X J
D F S L W M N C J C E R I C E R
U H F C M O N L E N G T H I D O
M R X H M H Z W I E R X W A S D
H E Y L C E S T R V H W D E W Q
E G R X W M U A D F E G E L S E
C E M J F O R E A C H T R H E C
P X U H R D T Y R P Y N B X P B
W C B B Z U E S C A E A C V R E
D F U V D L S A C N B V Y A I T
S S E L B U B H E W S D L N N D
A D X G E S F K S J G A R T T F
F G I E B N S B Z A C W Q U E A
S D T G A E R N N S H P A J Q D

';print;s/\n/--/g;for$/(1,30,32
,34){for$.(@_,map{reverse.""}@_
){my$x;$"=join"(.{$/})",split//
,$.;$0="";s|$"|join"",map{(eval
"\$@{[$x++]}") .$_}split//,lc$.
|gei;}}s/-{2}/\n/g;s/[A-Z]/ /g;
print"Locations:";print;__END__

      [download]
    		[reply]
    [d/l]
    [select]
        I knew it could be done with less code than I used, but this is rediculous! kaif++
    		[reply]

    Back to Obfuscated Code