_TITLE "Puzzle Builder for Rosetta" 'by B+ started 2018-10-31 ' 2018-11-02 Now that puzzle is working with basic and plus starters remove them and make sure puzzle works as well.
' Added Direction legend to printout.
' OverHauled LengthLimit()
' Reorgnize this to try a couple of times at given Randomize number
' TODO create alphabetical copy of word list and check grid for all words embedded in it.
' LoadWords makes a copy of word list in alpha order
' FindAllWords finds all the items from the dictionary
' OK it all seems to be working OK
'overhauled
DIM SHARED LengthLimit
(3 TO 10) AS _BYTE 'reset in Initialize, track and limit longer words
'LoadWords opens file of words and sets
DIM SHARED NWORDS
'set in LoadWords, number of words with length: > 2 and < 11 and just letters
' word file words (shuffled) to be fit into puzzle and index position
DIM SHARED WORDS$
(1 TO 24945), CWORDS$
(1 TO 24945), WORDSINDEX
AS INTEGER 'the file has 24945 words but many are unsuitable
'words placed in Letters grid, word itself (W$) x, y head (WX, WY) and direction (WD), WI is the index to all these
' letters grid and 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
'to store all the words found embedded in the grid L$()
' signal successful fill of puzzle
FILLED = 0
try = 1
LoadWords 'this sets NWORDS count to work with
Initialize
ShowPuzzle
FOR WORDSINDEX
= 1 TO NWORDS
PlaceWord
ShowPuzzle
FindAllWords
FilePuzzle
LOCATE 23, 1:
PRINT "On try #"; Trm$
(try
);
" a successful puzzle was built and filed." try = try + 1
ok = -1
IF ok
THEN i
= i
+ 1: WORDS$
(i
) = wd$: CWORDS$
(i
) = wd$
NWORDS = i
SWAP WORDS$
(i
), WORDS$
(r
)
L$(c, r) = " "
'reset word arrays by resetting the word index back to zero
WI = 0
'fun stuff for me but doubt others would like that much fun!
'pluggin "basic", 0, 0, 2
'pluggin "plus", 1, 0, 0
'to assure the spreading of ROSETTA CODE
L$
(INT(RND * 5) + 5, 0) = "R": L$
(INT(RND * 9) + 1, 1) = "O" L$
(INT(RND * 9) + 1, 2) = "S": L$
(INT(RND * 9) + 1, 3) = "E" L$
(1, 4) = "T": L$
(9, 4) = "T": L$
(INT(10 * RND), 5) = "A"
'reset limits
LengthLimit(3) = 200
LengthLimit(4) = 6
LengthLimit(5) = 3
LengthLimit(6) = 2
LengthLimit(7) = 1
LengthLimit(8) = 0
LengthLimit(9) = 0
LengthLimit(10) = 0
'reset word order
Shuffle
'for fun plug-in of words
L$
(x
+ i
* DX
(d
), y
+ i
* DY
(d
)) = MID$(wd$
, i
+ 1, 1) WI = WI + 1
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d
PRINT " 0 1 2 3 4 5 6 7 8 9" 'LOCATE 15, 1: INPUT "OK, press enter... "; wate$
'used in PlaceWord
IF L$
(x
, y
) = " " THEN count
= count
+ 1 CountSpaces% = count
'used in PlaceWord
Match% = 0
Match% = -1
'heart of puzzle builder
' place the words randomly in the grid
' start at random spot and work forward or back 100 times = all the squares
' for each open square try the 8 directions for placing the word
' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE,
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop
' if place a word update L$, WI, W$(WI), WX(WI), WY(WI), WD(WI)
wd$ = WORDS$(WORDSINDEX) 'the right side is all shared
'skip too many long words
wLen
= LEN(wd$
) - 1 ' from the spot there are this many letters to check spot
= INT(RND * 100) ' a random spot on grid testNum = 1 ' when this hits 100 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 dNum = 1
'will wd$ fit? from at x, y
template$ = ""
b1
= wLen
* DX
(d
) + x
>= 0 AND wLen
* DX
(d
) + x
<= 9 b2
= wLen
* DY
(d
) + y
>= 0 AND wLen
* DY
(d
) + y
<= 9 IF b1
AND b2
THEN 'build the template of letters and spaces from Letter grid template$ = template$ + L$(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 L$
(x
+ i
* DX
(d
), y
+ i
* DY
(d
)) = MID$(wd$
, i
+ 1, 1) WI = WI + 1
W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d
IF CountSpaces%
= 0 THEN FILLED
= -1 EXIT SUB 'get out now that word is loaded 'if still here keep looking
dNum = dNum + 1
spot
= (spot
+ 100 + rdir
) MOD 100 testNum = testNum + 1
wd$ = CWORDS$(i)
b1
= wLen
* DX
(d
) + x
>= 0 AND wLen
* DX
(d
) + x
<= 9 b2
= wLen
* DY
(d
) + y
>= 0 AND wLen
* DY
(d
) + y
<= 9 IF b1
AND b2
THEN 'build the template of letters and spaces from Letter grid template$ = ""
template$ = template$ + L$(x + j * DX(d), y + j * DY(d))
IF template$
= wd$
THEN 'founda word 'store it
ALLindex = ALLindex + 1
ALL$(ALLindex) = wd$: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d
'report it
LOCATE 22, 1:
PRINT "Found: "; wd$;
" ("; Trm$
(x
);
", "; Trm$
(y
);
") >>>---> "; Trm$
(d
);
INPUT " Press enter...", wate$
PRINT #1, " 0 1 2 3 4 5 6 7 8 9" b$ = Trm$(r) + " "
b$ = b$ + L$(c, r) + " "
PRINT #1, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" PRINT #1, " These are the items from unixdict.txt used to build the puzzle:" PRINT #1, RIGHT$(SPACE$(7) + Trm$
(i
+ 1), 7);
") ";
RIGHT$(SPACE$(7) + W$
(i
+ 1), 10);
" ("; Trm$
(WX
(i
+ 1));
", "; Trm$
(WY
(i
+ 1));
") >>>---> "; Trm$
(WD
(i
+ 1)) PRINT #1, " These are the items from unixdict.txt found embedded in the puzzle:" PRINT #1, RIGHT$(SPACE$(7) + Trm$
(i
), 7);
") ";
RIGHT$(SPACE$(7) + ALL$
(i
), 10);
" ("; Trm$
(AllX
(i
));
", "; Trm$
(AllY
(i
));
") >>>---> "; Trm$
(AllD
(i
));
PRINT #1, RIGHT$(SPACE$(7) + Trm$
(i
+ 1), 7);
") ";
RIGHT$(SPACE$(7) + ALL$
(i
+ 1), 10);
" ("; Trm$
(AllX
(i
+ 1));
", "; Trm$
(AllY
(i
+ 1));
") >>>---> "; Trm$
(AllD
(i
+ 1))
