'===========================================================================
' Subject: WHIZWORD SEARCHER                 Date: 03-19-00 (10:56)       
' Author:  Wayne Henderson                   Code: QB, QBasic, PDS        
' Origin:  whenders@becon.org              Packet: MISC.ABC
'===========================================================================
'WHIZWORD(tm), by Wayne Henderson_____March 18, 2000_____1:00pm EST
DEFINT A-Z: OPTION BASE 1
x = 5: y = 8: k = 11: DIM w$(x, y), sd(8)
CLS : GOSUB ReadArray: GOSUB Directions
COLOR 5, 0: LOCATE 1, 55: PRINT "Words in puzzle"
LOCATE , 55: PRINT "---------------": COLOR 6
RESTORE words
FOR c = 1 TO 10
   READ a$
   LOCATE c + 2, 59
   PRINT a$
NEXT
'
start:
COLOR 7: LOCATE 7, 1: PRINT SPACE$(30)
LOCATE 7, 1: PRINT "Word to find: ";
COLOR 14: LINE INPUT f$: f$ = LTRIM$(RTRIM$(f$))
IF f$ = "" OR LEN(f$) > 16 THEN LOCATE k, 1: COLOR 3: SYSTEM
FOR c = 11 TO 22
   LOCATE c, 1
   PRINT SPACE$(45)
NEXT
L = LEN(f$): f$ = UCASE$(f$): COLOR 9
LOCATE 9, 1: PRINT SPACE$(30): LOCATE 9, 1: PRINT f$
PRINT : COLOR 3
PRINT "Letter  Row  Col      Search Directions"
PRINT "-----------------------------------------"
'
work$ = LEFT$(f$, 1): Letter = 0
FOR Row = 1 TO x
   FOR Col = 1 TO y
      q$ = w$(Row, Col): Found = 0
      IF work$ = q$ THEN
         Letter = Letter + 1
         COLOR 6: PRINT "   "; work$; "    ";            'first letter found
         COLOR 7: PRINT STR$(Row); "   "; STR$(Col);
         GOSUB sd                               'get valid search directions
         GOSUB Remainder                         'look for remaining letters
         IF Found THEN EXIT FOR
      END IF
   NEXT Col
   IF Found THEN EXIT FOR
NEXT Row
COLOR 9
IF Found THEN
   PRINT : PRINT "FOUND: ";
   COLOR 3: PRINT "Row";
   COLOR 6: PRINT STR$(Row);
   COLOR 3: PRINT ", Col";
   COLOR 6: PRINT STR$(Col);
   COLOR 3: PRINT ", Direction";
   COLOR 6: PRINT Found
   k = CSRLIN
   GOSUB Highlite
ELSE
   IF Letter = 0 THEN PRINT "No letters found      No directions"
   COLOR 28: PRINT : PRINT "Word not found"
   k = CSRLIN
END IF
COLOR 3, 0: GOTO start
'
ReadArray: 'Read the puzzle matrix into a 2-dimensional array and display it
   RESTORE puzzle
   COLOR 14
   FOR Row = 1 TO x
      READ a$
      FOR Col = 1 TO y
         w$(Row, Col) = MID$(a$, Col, 1)
         PRINT w$(Row, Col); " ";
      NEXT
      PRINT
   NEXT Row
   COLOR 7
RETURN
'
Directions:
   LOCATE 3, 30: PRINT " 4   3   2"
   LOCATE , 30: PRINT "   \ | /"
   LOCATE , 30: PRINT "5 -- * -- 1"
   LOCATE , 30: PRINT "   / | \"
   LOCATE , 30: PRINT " 6   7   8"
RETURN
'
sd:
   FOR c = 1 TO 8: sd(c) = c: NEXT c
   IF Col + L > y + 1 THEN sd(1) = 0
   IF Row - L < 0 THEN sd(3) = 0   'If sd(?)=1 then search in that direction
   IF Col - L < 0 THEN sd(5) = 0       'If it's 0 then the word wouldn't fit
   IF Row + L > x + 1 THEN sd(7) = 0
   IF Col + L > y + 1 OR Row - L < 0 THEN sd(2) = 0
   IF Row - L < 0 OR Col - L < 0 THEN sd(4) = 0
   IF Col - L < 0 OR Row + L > x + 1 THEN sd(6) = 0
   IF Row + L > x + 1 OR Col + L > y + 1 THEN sd(8) = 0
   COLOR 5: PRINT "   "; : COLOR 4
   FOR c = 1 TO 8: PRINT sd(c); : NEXT c: PRINT    'display valid directions
RETURN
'
Remainder:      'Find the rest of the letters in the word ignoring line-wrap
   FOR c = 2 TO LEN(f$)
      wrk$ = MID$(f$, c, 1)
      IF sd(1) THEN IF wrk$ <> w$(Row, Col + c - 1) THEN sd(1) = 0
      IF sd(2) THEN IF wrk$ <> w$(Row - c + 1, Col + c - 1) THEN sd(2) = 0
      IF sd(3) THEN IF wrk$ <> w$(Row - c + 1, Col) THEN sd(3) = 0
      IF sd(4) THEN IF wrk$ <> w$(Row - c + 1, Col - c + 1) THEN sd(4) = 0
      IF sd(5) THEN IF wrk$ <> w$(Row, Col - c + 1) THEN sd(5) = 0
      IF sd(6) THEN IF wrk$ <> w$(Row + c - 1, Col - c + 1) THEN sd(6) = 0
      IF sd(7) THEN IF wrk$ <> w$(Row + c - 1, Col) THEN sd(7) = 0
      IF sd(8) THEN IF wrk$ <> w$(Row + c - 1, Col + c - 1) THEN sd(8) = 0
   NEXT
   FOR c = 1 TO 8      'run through the array and pick the correct direction
      IF sd(c) THEN Found = c: EXIT FOR
   NEXT
RETURN
'
Highlite:
   COLOR 15, 5: LOCATE Row, Col * 2 - 1: PRINT work$
   FOR c = 2 TO LEN(f$)
      IF sd(1) THEN LOCATE Row, (Col + c - 1) * 2 - 1
      IF sd(2) THEN LOCATE Row - c + 1, (Col + c - 1) * 2 - 1
      IF sd(3) THEN LOCATE Row - c + 1, Col * 2 - 1
      IF sd(4) THEN LOCATE Row - c + 1, (Col - c + 1) * 2 - 1
      IF sd(5) THEN LOCATE Row, (Col - c + 1) * 2 - 1
      IF sd(6) THEN LOCATE Row + c - 1, (Col - c + 1) * 2 - 1
      IF sd(7) THEN LOCATE Row + c - 1, Col * 2 - 1
      IF sd(8) THEN LOCATE Row + c - 1, (Col + c - 1) * 2 - 1
      PRINT MID$(f$, c, 1)
   NEXT
RETURN
'
puzzle:     'the puzzle could be stored as an ASCII file on disk and read in
DATA DRYHWELA
DATA UNIARPSD
DATA MLYYNOPD
DATA ENILIONE
DATA ELACSOJD
'
words:      'the words could be automatically read and searched sequentially
DATA Dry, Jon, Line, Lion, Mud, Pony, Scale, Sprain, Wayne, Added