_TITLE "Puzzle Builder for Word Lists" 'by B+ restarted 2020-11-28 ' Make a Word Search game & txt file from a list of words usu with some thene.
' 2020-11-30 Puzzle Builder #2 w Finder 2020-11 Now complete the app with a word finder.
' Max word letters = 15
' Max cells/letters per side = 30
' Max words can find on word list is 120 (that can be shown on screen).
CONST ScreenWidth
= 1000, ScreenHeight
= 640 DIM SHARED WordListFileBase$
, GridSide
, GridSideM1
, GridSideP2M1
'======================================= File Base name and Grid Size ================================================
' Make your word list file with: Some base name for theme + " Word List.txt"
' test file 2
WordListFileBase$ = "Elements" ' add suffix to your file " Word List.txt" <<<<<<<<<<<<<<<<<<<<<<<<< Input
GridSide = 30 ' <<<<<<<<<<<<<<<<<<<<<<<<< Input later 30 the maximum grid size
' test file 1
'WordListFileBase$ = "Christmas" 'add suffix to your file " Word List.txt" <<<<<<<<<<<<<<<<<<<<<<<<< Input
'GridSide= 15 ' <<<<<<<<<<<<<<<<<<<<<<<<< Input later 30 the maximum grid size
'' test file 3
'WordListFileBase$ = "The_Four"
'GridSide = 5
'=====================================================================================================================
' Calc once and for all!
GridSideM1 = GridSide - 1
GridSideP2M1 = GridSide * GridSide - 1
IF GridSide
> 15 THEN LetterLimit
= 15 ELSE LetterLimit
= GridSide
GridLabel$
= MID$(" 0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z", 1, GridSide
* 2 + 2)
'LoadWords opens file of words and sets
DIM SHARED NWords
'set in LoadWords, number of words
' word file words (shuffled) to be fit into puzzle and index position, 24945 comes from a dictionary file
DIM SHARED Words$
(1 TO 24945), WordsIndex
AS INTEGER 'the file has 24945 words but many are unsuitable
'words placed in Letters grid, word itself (WordList$) x, y head (WordX, WordY) and direction (WordDirection), WordIndex is the index to all these
DIM SHARED WordList$
(1 TO 250), WordX
(1 TO 250), WordY
(1 TO 250), WordDirection
(1 TO 250), WordIndex
DIM SHARED BestWordList$
(1 TO 250), BestWordX
(1 TO 250), BestWordY
(1 TO 250), BestWordDirection
(1 TO 250)
' letters grid and for saving best grid
DIM SHARED Letters$
(0 TO GridSideP2M1
, 0 TO GridSideP2M1
), Best$
(0 TO GridSideP2M1
, 0 TO GridSideP2M1
), BestWordIndex
' direction arrays
DX(0) = 1: DY(0) = 0
DX(1) = 1: DY(1) = 1
DX(2) = 0: DY(2) = 1
DX(3) = -1: DY(3) = 1
DX(4) = -1: DY(4) = 0
DX(5) = -1: DY(5) = -1
DX(6) = 0: DY(6) = -1
DX(7) = 1: DY(7) = -1
' signal successful fill of puzzle = either no spaces left or all words$() used
DIM SHARED Filled
' signal we are full and done!
DIM try
, c
, r
, y$
, puzzleFiled
try = 0
LoadWords 'this sets NWORDS count to work with
WHILE try
< 1000000 'for long runs uncomment BEEP Initialize
'ShowPuzzle
FOR WordsIndex
= 1 TO NWords
PlaceWord
'ShowPuzzle
IF WordIndex
> BestWordIndex
THEN 'copy Letters$ into Best$ Best$(c, r) = Letters$(c, r)
BestWordIndex = WordIndex
ERASE BestWordList$
, BestWordX
, BestWordY
, BestWordDirection
BestWordList$(r) = WordList$(r): BestWordX(r) = WordX(r): BestWordY(r) = WordY(r): BestWordDirection(r) = WordDirection(r)
IF BestWordIndex
= NWords
THEN 'automatic file if all words positioned in puzzle ShowBestPuzzle
LOCATE 34, 1:
PRINT "On try #"; TS$
(try
);
" all words used!" FilePuzzle
LOCATE 36, 1:
PRINT "Puzzle Filed, next up is word search." puzzleFiled = -1
try = try + 1
ShowBestPuzzle
LOCATE 34, 1:
PRINT "After "; TS$
(try
);
" tries, this was best puzzle." LOCATE 36, 1:
INPUT "Enter y for yes, to save the best to file."; y$
FilePuzzle
LOCATE 37, 1:
PRINT "Puzzle Filed, next up is word search."
' Now to find words in our best puzzle
DIM bestPuz
, mx
, my
, mb
, wIndex
, hx
, hy
, wd
, i
, sx
, sy
, navX$
, navY$
, navD$
ShowBestPuzzle 'get a snapshot
bestPuz
= _NEWIMAGE(ScreenWidth
, ScreenHeight
, 32) wIndex = my
wIndex = my + 40
wIndex = my + 80
wIndex = 0
IF wIndex
> BestWordIndex
THEN wIndex
= 0 IF Found
(BestWordList$
(wIndex
), hx
, hy
, wd
) THEN 'high lite it black, yellow convertCR2Screen hx, hy, sx, sy ' tranlate array location to screen location and navigate column, row
convertCR2Nav hx, hy, wd, navX$, navY$, navD$
LOCATE 36, 1:
PRINT BestWordList$
(wIndex
);
" found at ("; navX$;
", "; navY$;
") going "; navD$
COLOR &HFF0000BB, &HFFFFFF00 hx = hx + DX(wd): hy = hy + DY(wd)
convertCR2Screen hx, hy, sx, sy
COLOR &HFFFFFFFF, &HFF000000
NWords
= NWords
+ 1: Words$
(NWords
) = UCASE$(wd$
) ' traditional ucase, works better with proper names
SUB Shuffle
'then order biggest first smallest last i = 0
WHILE i
< NWords
- 1 'order the hard way but less than 100 words i = i + 1
SUB Initialize
' zero out everything
Letters$(c, r) = " "
ERASE WordList$
, WordX
, WordY
, WordDirection
WordIndex = 0
Shuffle 'reset word order
FUNCTION CountSpaces
() 'used in PlaceWord FOR y
= 0 TO GridSide
- 1 FOR x
= 0 TO GridSide
- 1 IF Letters$
(x
, y
) = " " THEN count
= count
+ 1 CountSpaces = count
Match = 0
Match = -1
' place the words randomly in the grid
' start at random spot and work forward or all the squares
' for each open square try the 8 directions for placing the word
'
' Filled will now signal that all the words have been positioned
' if place a word update Letters$, WordIndex, WordList$(WordIndex), WordX(WordIndex), WordY(WordIndex), WordDirection(WordIndex)
DIM wd$
, wLen
, spot
, testNum
, rdir
' rdir go forward or back form spot DIM x
, y
, d
, dNum
, rdd
' dNum counts number of directions we tried, rdd sets direction to rotate DIM template$
, b1
, b2
'for match against letters already in Letters$ grid
wd$ = Words$(WordsIndex) 'the right side is all shared
wLen
= LEN(wd$
) - 1 ' from the spot there are this many letters to check spot
= INT(RND * GridSide
* GridSide
) ' a random spot on grid testNum = 1 ' when this hits GridSide*GridSide we've tested all possible spots on grid
IF RND < .5 THEN rdir
= -1 ELSE rdir
= 1 ' go forward or back from spot for next test WHILE testNum
< GridSide
* GridSide
IF Letters$
(x
, y
) = MID$(wd$
, 1, 1) OR Letters$
(x
, y
) = " " THEN dNum = 1
'will wd$ fit? from at x, y
template$ = ""
b1
= wLen
* DX
(d
) + x
>= 0 AND wLen
* DX
(d
) + x
<= GridSideM1
'wLen = len(wd$) - 1 b2
= wLen
* DY
(d
) + y
>= 0 AND wLen
* DY
(d
) + y
<= GridSideM1
IF b1
AND b2
THEN ' build the template of letters and spaces from Letter grid template$ = template$ + Letters$(x + i * DX(d), y + i * DY(d))
IF Match
(wd$
, template$
) THEN 'the word will fit but does it fill anything? IF ASC(template$
, j
) = 32 THEN 'yes a space to fill FOR i
= 0 TO wLen
'adding word to letter grid Letters$
(x
+ i
* DX
(d
), y
+ i
* DY
(d
)) = MID$(wd$
, i
+ 1, 1) WordIndex = WordIndex + 1 'add word to loacting arrays
WordList$(WordIndex) = wd$: WordX(WordIndex) = x: WordY(WordIndex) = y: WordDirection(WordIndex) = d
IF CountSpaces
= 0 OR WordIndex
> NWords
THEN Filled
= -1 EXIT SUB 'get out now that word is loaded 'if still here keep looking
d
= (d
+ 8 + rdd
) MOD 8 'set next direction to try dNum = dNum + 1 'count number of resets done when have 9 resets
spot = spot + rdir ' ok try next spot
IF spot
>= GridSide
* GridSide
THEN spot
= 0 IF spot
< 0 THEN spot
= GridSide
* GridSide
- 1 testNum = testNum + 1 'until tried every spot on grid
'SUB ShowPuzzle 'this was needed to make sure finding the best puzzle was working correctly
' DIM i, x, y
' CLS
' LOCATE 1, 1: PRINT GridLabel$
' FOR i = 3 TO 2 + GridSide
' LOCATE i, 1: PRINT MID$(GridLabel$, i * 2 - 2, 1);
' NEXT
' FOR y = 0 TO GridSide - 1
' FOR x = 0 TO GridSide - 1
' LOCATE y + 3, 2 * x + 4: PRINT Letters$(x, y)
' NEXT
' NEXT
' FOR i = 1 TO WordIndex
' IF i <= 40 THEN
' LOCATE i, 65: PRINT TS$(i); " "; WordList$(i);
' ELSEIF i <= 80 THEN
' LOCATE i - 40, 85: PRINT TS$(i); " "; WordList$(i);
' ELSEIF i <= 120 THEN
' LOCATE i - 80, 105: PRINT TS$(i); " "; WordList$(i);
' END IF
' NEXT
' LOCATE 35, 1: PRINT "Spaces left:"; CountSpaces
' LOCATE 36, 1: PRINT "Words placed:"; WordIndex
' LOCATE 37, 1: PRINT SPACE$(16)
' IF WordsIndex THEN LOCATE 37, 1: PRINT TS$(WordsIndex); " "; Words$(WordsIndex)
'END SUB
DIM i
, r
, c
, b$
, x$
, y$
, d$
b$
= MID$(GridLabel$
, r
* 2 + 4, 1) + " " b$ = b$ + Best$(c, r) + " "
PRINT #1, " Search Word Solutions" PRINT #1, " The words from: " + WordListFileBase$
+ " Word List.txt can be found here:" FOR i
= 1 TO BestWordIndex
convertCR2Nav BestWordX(i), BestWordY(i), BestWordDirection(i), x$, y$, d$
PRINT #1, "("; x$;
", "; y$;
") >>>---> "; d$
FOR y
= 0 TO GridSide
- 1 FOR x
= 0 TO GridSide
- 1 Best$
(x
, y
) = MID$("BPLUS", m
+ 1, 1)
fillBlanksInBest
FOR i
= 3 TO 2 + GridSide
FOR y
= 0 TO GridSide
- 1 FOR x
= 0 TO GridSide
- 1 FOR i
= 1 TO BestWordIndex
LOCATE i
- 40, 85:
PRINT TS$
(i
);
" "; BestWordList$
(i
);
LOCATE i
- 80, 105:
PRINT TS$
(i
);
" "; BestWordList$
(i
);
FUNCTION Found
(word$
, headX
, headY
, direction
) 'First find a letter that matches the first letter in word$,
'then at that x, y try each of 8 directions to see if find a match.
'See if enough room to fit the find word before heading out to match letters.
DIM first$
, lenFind
, x
, y
, d
, b1
, b2
, xx
, yy
, b$
, i
first$
= MID$(word$
, 1, 1): lenFind
= LEN(word$
) - 1 FOR d
= 0 TO 7 'will word fit in this direction? 2 booleans True condition b1
= lenFind
* DX
(d
) + x
>= 0 AND lenFind
* DX
(d
) + x
<= GridSideM1
b2
= lenFind
* DY
(d
) + y
>= 0 AND lenFind
* DY
(d
) + y
<= GridSideM1
' build word from Letters block to see if matches word to find
b$ = first$: xx = x + DX(d): yy = y + DY(d)
b$ = b$ + Best$(xx, yy)
xx = xx + DX(d): yy = yy + DY(d)
xx = x: yy = y 'copy x, y for rebuilding word on screen
IF b$
= word$
THEN 'found one show our result headX = x: headY = y: direction = d: Found = -1
SUB convertCR2Screen
(c
, r
, screenC
, screenR
) screenC = 2 * c + 4: screenR = r + 3
SUB convertCR2Nav
(c
, r
, d
, navX$
, navY$
, navD$
) CASE 1: navD$
= "South East" CASE 3: navD$
= "South West" CASE 5: navD$
= "North West" CASE 7: navD$
= "North East"
