'===========================================================================
' Subject: FAST WORD SEARCH SOLVER           Date: 08-29-95 (00:00)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Keys:    FAST,WORD,SEARCH,SOLVER         Packet: TEXT.ABC
'===========================================================================
'===========================================================
' The Fast Word Search Solver by William Yu (c) 08-29-1995
'
'  Why waste hours doing those simple word search puzzles
'  Why not impress your family/friends by solving it without
' even making a single mark on the puzzle grid, and solving
' the puzzle in just 10 minutes or less! (Depending on your
' typing skills and how big the puzzle grid is).
'  All you have to do is type in the required data and wait
' only seconds for The Fast Word Search Solver to solve it
' for you!  You can disable search methods if your Word
' Search Puzzle does not require it for more speed!
'  Default Search Method (You can change the order):
'      Horizontal Find
'      Backward Horizontal Find
'      Vertical Find
'      Backward Vertical Find
'      Diagonal Right and Down Find
'      Diagonal Left and Down Find
'      Diagonal Right and Up Find
'      Diagonal Left and Up Find
' Timed Searches for (Within Basic environment):
' Out of 5 trials, fastest time recorded:
'        286/16MHz     64.22 seconds    20/20 Grid  82 Words
'        386/25MHz     16.31 seconds       "          "
'        486/33MHz     4.56  seconds       "          "
'        486DX2/66MHz  1.81  seconds       "          "
' All times are approximate, larger words take more
' time to find.  More words and larger grids take more
' time to search.
'  The times could be faster if you disable the letter
' spacing.  Try it and see how fast it can really go!
'===========================================================

DEFINT A-Z
DECLARE SUB HorizontalFind (I, Max, Found, Find$)
DECLARE SUB HorizontalBackFind (I, Max, Found, Find$)
DECLARE SUB VerticalFind (I, Max, Found, Find$)
DECLARE SUB VerticalBackFind (I, Max, Found, Find$)
DECLARE SUB DiagonalFind (I, Max, Found, Find$, Direction)
DECLARE SUB DiagonalBackFind (I, Max, Found, Find$, Direction)

SCREEN 0, 0, 0, 0

REDIM SHARED Column$(50)   ' Maximum is 50, but change if neccessary

CONST Max=20               ' How many Columns does your grid have
                           ' Rows would be the better word, but who cares

OPEN "PUZZLE.DAT" FOR INPUT AS #1
  FOR I = 1 TO Max
    LINE INPUT #1, Column$(I)
    FOR X = 1 TO LEN(Column$(I))
      PRINT MID$(Column$(I), X, 1); " ";  ' You can disable the spacing
    NEXT X
    PRINT
  NEXT I
CLOSE #1

'Uncomment this to manually type and find each word
'DO
'  LOCATE 2, 50
'  LINE INPUT "Find: "; Find$
'  Find$ = UCASE$(Find$)
'  IF Find$ = "" THEN END
'  GOSUB Find
'  COLOR , 0
'  LOCATE 2, 55: PRINT SPACE$(20)
'LOOP

OPEN "PUZZLE.FND" FOR INPUT AS #1
  T! = TIMER
  DO
    LINE INPUT #1, Find$
    LOCATE 2, 50: PRINT "Find: "; Find$
    GOSUB Find
    COLOR , 0
    LOCATE 2, 55: PRINT SPACE$(25)
  LOOP UNTIL EOF(1)
  LOCATE 10, 47: PRINT "Seconds to Find all: "; : PRINT USING "###.##"; TIMER - T!
CLOSE #1

SLEEP
END


' You can disable the spacing and for Horizontal Finds for more speed
' and take out the For/Next Loop

Find:
HorizontalFind I, Max, Found, Find$
IF Found = 0 THEN HorizontalBackFind I, Max, Found, Find$
IF Found = 0 THEN
  VerticalFind I, Max, Found, Find$
ELSE
  LOCATE I, Found + Found - 1: COLOR , 1
  FOR X = 1 TO LEN(Find$)
    PRINT MID$(Find$, X, 1); : COLOR , 0: PRINT " "; : COLOR , 1
  NEXT X
  RETURN
END IF
IF Found = 0 THEN VerticalBackFind I, Max, Found, Find$
IF Found = 0 THEN
  DiagonalFind I, Max, Found, Find$, Direction
ELSE
  LOCATE Found, I + I - 1: COLOR , 1
  FOR X = 1 TO LEN(Find$)
    PRINT MID$(Find$, X, 1); : COLOR , 0: PRINT " "; : COLOR , 1
    PRINT
    LOCATE , I + I - 1
  NEXT X
  RETURN
END IF
IF Found = 0 THEN
  DiagonalBackFind I, Max, Found, Find$, Direction
ELSE
  LOCATE I, Found + Found - 1: COLOR , 1
  FOR X = 1 TO LEN(Find$)
    PRINT MID$(Find$, X, 1)
    IF Direction = 1 THEN LOCATE I + X, Found + Found + (X * 2) - 1 ELSE LOCATE I + X, ABS(Found + Found - (X * 2) - 1)
  NEXT X
  RETURN
END IF
IF Found = 0 THEN
  LOCATE 4, 50: PRINT SPACE$(30)
  LOCATE 4, 50: COLOR , 0: PRINT Find$; " not found."
ELSE
  LOCATE I, Found + Found - 1: COLOR , 1
  FOR X = 1 TO LEN(Find$)
    PRINT MID$(Find$, X, 1)
    IF Direction = 1 THEN LOCATE I + X, Found + Found + (X * 2) - 1 ELSE LOCATE I + X, ABS(Found + Found - (X * 2) - 1)
  NEXT X
END IF

RETURN

SUB DiagonalBackFind (I, Max, Found, Find$, Direction)

BackUpFind$ = Find$

FOR X = Max TO 1 STEP -1
 BackFind$ = BackFind$ + MID$(Find$, X, 1)
NEXT X

Find$ = BackFind$

FirstLetter$ = LEFT$(Find$, 1)

I = 0
DO
  I = I + 1
  FindSecond$ = ""
  IF (Max - I) < LEN(Find$) - 1 THEN EXIT DO
  Where = INSTR(Column$(I), FirstLetter$)
  DO WHILE Where
  IF Where THEN
    '  \
    '    \     Searches left and up
    '      \
    IF LEN(Column$(I)) - Where >= LEN(Find$) - 1 THEN
      Y = I: Z = 1
      FOR X = Where + 1 TO Where + LEN(Find$) - 1
        Y = Y + 1: Z = Z + 1
        IF MID$(Column$(Y), X, 1) <> MID$(Find$, Z, 1) THEN EXIT FOR
        FindSecond$ = FindSecond$ + MID$(Column$(Y), X, 1)
      NEXT X
      FindSecond$ = FirstLetter$ + FindSecond$
      IF FindSecond$ = Find$ THEN Found = Where: Direction = 1: EXIT SUB
    END IF
    '      /
    '    /      Searches right and up
    '  /
    IF Where - LEN(Find$) >= 0 THEN
      FindSecond$ = ""
      Y = I: Z = 1
      FOR X = Where - 1 TO Where - LEN(Find$) + 1 STEP -1
        Y = Y + 1: Z = Z + 1
        IF MID$(Column$(Y), X, 1) <> MID$(Find$, Z, 1) THEN EXIT FOR
        FindSecond$ = FindSecond$ + MID$(Column$(Y), X, 1)
      NEXT X
      FindSecond$ = FirstLetter$ + FindSecond$
      IF FindSecond$ = Find$ THEN Found = Where: Direction = 2: EXIT SUB
    END IF
  END IF
  Where = INSTR(Where + 1, Column$(I), FirstLetter$)
  FindSecond$ = ""
  LOOP
LOOP

Find$ = BackUpFind$

END SUB

SUB DiagonalFind (I, Max, Found, Find$, Direction)

FirstLetter$ = LEFT$(Find$, 1)

I = 0
DO
  I = I + 1
  FindSecond$ = ""
  IF (Max - I) < LEN(Find$) - 1 THEN EXIT DO
  Where = INSTR(Column$(I), FirstLetter$)
  DO WHILE Where
    IF Where THEN
      IF LEN(Column$(I)) - Where >= LEN(Find$) - 1 THEN
        ' \
        '   \     Searches right and down
        '     \
        Y = I: Z = 1
        FOR X = Where + 1 TO Where + LEN(Find$) - 1
          Y = Y + 1: Z = Z + 1
          IF MID$(Column$(Y), X, 1) <> MID$(Find$, Z, 1) THEN EXIT FOR
          FindSecond$ = FindSecond$ + MID$(Column$(Y), X, 1)
        NEXT X
        FindSecond$ = FirstLetter$ + FindSecond$
        IF FindSecond$ = Find$ THEN Found = Where: Direction = 1: EXIT SUB
      END IF
        '      /
        '    /     Searches left and down
        '  /
      IF Where - LEN(Find$) >= 0 THEN
        FindSecond$ = ""
        Y = I: Z = 1
        FOR X = Where - 1 TO Where - LEN(Find$) + 1 STEP -1
          Y = Y + 1: Z = Z + 1
          IF MID$(Column$(Y), X, 1) <> MID$(Find$, Z, 1) THEN EXIT FOR
          FindSecond$ = FindSecond$ + MID$(Column$(Y), X, 1)
        NEXT X
        FindSecond$ = FirstLetter$ + FindSecond$
        IF FindSecond$ = Find$ THEN Found = Where: Direction = 2: EXIT SUB
      END IF
    END IF
    Where = INSTR(Where + 1, Column$(I), FirstLetter$)
    FindSecond$ = ""
  LOOP
LOOP

END SUB

SUB HorizontalBackFind (I, Max, Found, Find$)

'Reverse FIND$ Horizontal Back Find

BackUpFind$ = Find$

FOR X = Max TO 1 STEP -1
 BackFind$ = BackFind$ + MID$(Find$, X, 1)
NEXT X

Find$ = BackFind$

I = 0
DO
  I = I + 1
  Found = INSTR(Column$(I), Find$)
  IF Found THEN EXIT DO
LOOP UNTIL I = Max

IF Found = 0 THEN Find$ = BackUpFind$

END SUB

SUB HorizontalFind (I, Max, Found, Find$)

'Horizontal Find

I = 0
DO
  I = I + 1
  Found = INSTR(Column$(I), Find$)
  IF Found THEN EXIT DO
LOOP UNTIL I = Max

END SUB

SUB VerticalBackFind (I, Max, Found, Find$)

REDIM VerticalColumn$(50)

BackUpFind$ = Find$

FOR X = Max TO 1 STEP -1
 BackFind$ = BackFind$ + MID$(Find$, X, 1)
NEXT X

Find$ = BackFind$

FOR Y = 1 TO LEN(Column$(1))
  FOR X = 1 TO Max
    VerticalColumn$(Y) = VerticalColumn$(Y) + MID$(Column$(X), Y, 1)
  NEXT X
NEXT Y

I = 0
DO
  I = I + 1
  Found = INSTR(VerticalColumn$(I), Find$)
  IF Found THEN EXIT DO
LOOP UNTIL I = LEN(VerticalColumn$(I))

ERASE VerticalColumn$
IF Found = 0 THEN Find$ = BackUpFind$

END SUB

SUB VerticalFind (I, Max, Found, Find$)

REDIM VerticalColumn$(50)

FOR Y = 1 TO LEN(Column$(1))
  FOR X = 1 TO Max
    VerticalColumn$(Y) = VerticalColumn$(Y) + MID$(Column$(X), Y, 1)
  NEXT X
NEXT Y

I = 0
DO
  I = I + 1
  Found = INSTR(VerticalColumn$(I), Find$)
  IF Found THEN EXIT DO
LOOP UNTIL I = LEN(VerticalColumn$(I))

ERASE VerticalColumn$

END SUB


'------------[ Begin PUZZLE.DAT ]---------------
LEGNASSSSSTSEUGSYOBP
SELORTELGSERRRATNASL
NEMKNEEVNEGSAIIMNRSA
PNIERPPTIINNEVOEEUUN
YRRRAAGAPWDEIIEHAROT
LAEHRLPRPFSTRKTLCIRM
PECSPESSARADKOCRTMIY
PLSEEOBTRNEIRESOASCT
AVNNLNHNWSDBFIMITPOU
CEOGIETSASEMMEBLTSUR
OSISRTBSURLLOEEBSYSK
UHTSEIDRACCOCTCLOOIE
NTANRIPGAACVONHEINNY
TMRCURDORTHENTUEDNSS
RROIIASOMSISTERSRPGL
YACSPTLDOGLOWACERSIS
SWEETSRWMGDBNMHEAGFG
ISDOOFIIMERAHSERHTTN
DADDYAGLYSEKACSTARSO
ERAFAMILYLNEHUSBANDS
'------------[ End PUZZLE.DAT ]---------------


'------------[ Begin PUZZLE.FND ]---------------
ANGEL
APPLY
AUNTS
BAKE
BIRDS
BROTHERS
BOYS
CAKES
CARD
CAROLS
CELEBRATIONS
CHAPELS
CHILDREN
CHOIRS
CHURCHES
CLAUS
COUNTRYSIDE
COUSINS
CRANBERRIES
CRIBS
DADDY
DECEMBER
DECORATIONS
ELVES
EMOTION
FAMILY
FARE
FEELINGS
FOODS
GENEROSITY
GIFTS
GIRLS
GLOW
GOODIES
GOODWILL
GRANDFATHERS
GRANDMOTHERS
GRIP
GUESTS
HUSBANDS
KEEN
KIDS
LEARN
LIGHTS
LOVES
MEALS
MERRY
MISTLETOE
MOMMY
NATIVITY
PAPER
PARENTS
PARTIES
PLANT
PRESENTS
RIBBONS
ROLES
SANTA
SHARE
SHOP
SISTERS
SONGS
SONS
SPARKLE
SPREE
STARS
STOCKINGS
SURPRISES
SWEETS
TEAMS
TINSEL
TOOLS
TRAVEL
TREATS
TREES
TRIPS
TURKEYS
TURNS
UNCLES
WARMTH
WIVES
WRAPPING
'------------[ End PUZZLE.FND ]---------------