_Title "Boggle 2" ' b+ start 2022-01-12 ' Scabble Word List and Dictionary
' ref dictionary: https://boardgames.stackexchange.com/questions/38366/latest-collins-scrabble-words-list-in-text-file
' Die configurations
' https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages
' Thank you!
' 2022-01-14 status have the board display separated out from New Board and Game initialization
' have timer system and display working next to board display
' have player input system working
' 1. check word in dictionary working
' 2. check that word can legally be built from board is funky! sometimes works sometimes not 50/50 for legit builds yuck
' How to debug? Todays task is get this abolutely critical function working so the AI would be fairly easy to do.
' Oh I had to modify the Collins Word list to get a size that would fit into a variable length string array, 279496 words
' kept crashing QB64 without error messages when reached about 260,000 words so now I have a list for words with lengths of
' between 3 and 10, still 199,651 words!
' 2202-01-14 Hurray! Function wordBuildOK& is fixed, a very simple logic bug. I continued to check for builds of word after
' I got confirmation one of the builds was possible. It kept checking if there was more than one place the first letter of word
' appeared. The function is crucial for AI testing if words are buildable. I can get started on that today now that bug is
' fixed. Man! I had this fixed almost immediately, I had to exit the Function when the recursive function findCell& called from
' it found a positive result.
' 2022-01-15 qw$() function to handle the Q letter, function to handle scoring, main removes matching words on the 2 lists.
' you should be able to type 2 letters with (qu) square and get a 3 letter word.
' 2022-01-15 screw the die with face Q(u) with implied u, adding a 17th die with AEIOUU and removing all the special handling
' for that implied u crap! I don't think this will ruin the game but only make it better and less difficlut to code.
' Fix the spelling of reckoning :) OK new word files made for Boggle 2: AI Check Words is HUGE! Almost 35 X's more and longer
' words, words 5 letters and longer. The Word List file has been expanded from 3 to 10 letter words to 3 to 12 letter words.
' Dang! It's worse the points the AI collects from big words times the point values they are worth...
' OK more handicap, AI concedes all 3-6 letters words to player and gets points only for 7+ letter words. Is it fair now?
' Too much! Try concedes 3-5 but fight for 6+ letter words.
' 2022-01-16 Yesterday I was able to use 2 large word lists from : 3 - 12 Letter Words.txt (249,702)
' and AI Check Words.txt (229,745) they loaded fine all afternoon. Then I decided to use the 3-12 letter words for the
' AI check words list so I only had to load one file! So I change the code to do that and suddenly the 3-12 Letter Words.txt
' was quitting like there were more words than it could load (no error message, no subscript out of range you get with an array
' dim'd too small for # of items to put in it), QB64 just bugged out and quit ??? Just like when I was trying to load the
' whole file.
' So today I m trying jack's idea to over size the dim of the array to load into and track the number going in with a
' variable NTopWord. And I am going to try and load a bigger 3-16 Letter Words.txt file. NOPE!
' The 3-12 list is loading again today, but no garantee it will work for others or me in future as it quit last night.
' Try loading up Browser and run other stuff, maybe QB64 variable length string loads in one array is limited. Still OK.
' Have no idea why it works for .5 day and later doesn't ????
' 2022-01-16 Boggle 2 post: I will have the 3 to 10 Letter Words.txt file to load into game if you or I have problems loading the
' 3 to 12 Letter Words.txt file. So just Boggle 2 and 2 word files in zip.
' =================================== Sound Signals =========================================================
' Oh a high pitched peep is a sound signalling that the word enetered can't be legally built from board.
' A Beep is a signal the word is not in dictionary.
Const TimeLimit
= 180 ' actual game time is 3 minutes = 180 secs Const PrintLine
= 20 ' row where I can start display of user inputs below Board display on screen. Dim Shared Board$
(3, 3), WordList$
(1 To 280000) ' < this is over sized array # words is 279369 try jacks idea of oversized array Dim As Long pScore
, aiScore
, uba
, ubp
, i
, j
, mx
, my
, mbL
, mbR
, row
, col
' quick board for testin working mouse locations for clicking letters
'NewBoard
'While _KeyDown(27) = 0
' Cls
' DisplayBoard
' _Font 16
' While _MouseInput: Wend
' mx = _MouseX: my = _MouseY: mbL = _MouseButton(1): mbR = _MouseButton(2)
' row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
' Print col, row, mbL, mbR
' _Display
' _Limit 60
'Wend
NewBoard ' display timer and allow input of words from user for 3 minutes
DisplayBoard
elapsed = 0: player$ = "": w$ = ""
While elapsed
< TimeLimit
' do stuff <<<<<<<<<<<<<<<<<<<<<< off while debug wordBuildOK DisplayBoard
elapsed
= Timer(.01) - BoggleTime
If elapsed
< 0 Then elapsed
= 24 * 60 * 60 + Timer(.01) - BoggleTime
' midnight problem add aday of seconds to timer and subtr boogle
'some help
Locate 5, 50:
Print "Use Keyboard or Mouse to add letters to word." Locate 6, 50:
Print " Backspace will clear last letter." Locate 7, 50:
Print " Esc or Ctrl+C will clear word started." Locate 8, 50:
Print " Enter or Right Mouse to checks word > list."
'add mouse controls
row = (my - 80) / 60: col = (mx - 80) / 60 ' ?? not -60 but more
w$ = w$ + Board$(col, row) ' add letter to w$ build
If mbR
Then ' same as hitting Enter on keyboard If wordBuildOK&
(w$
) Then ' legal build If Find&
(WordList$
(), w$
) Then ' check words in dictionary before add to player$ If player$
= "" Then player$
= w$
Else player$
= player$
+ " " + w$
w$ = ""
If Len(k$
) Then 'handle 1 and 2 char key presses, maybe replace with _keyhit later Case 3 'Ctrl + C another way to clear? w$ = ""
Case 8 ' backspace more to do If wordBuildOK&
(w$
) Then ' legal build If Find&
(WordList$
(), w$
) Then ' check words in dictionary before add to player$ If player$
= "" Then player$
= w$
Else player$
= player$
+ " " + w$
w$ = ""
w$ = "" ': exit ?
'lets see what the AI comes up with
AI$ = AIwords$(5) ' new much larger much longer words
Print " zzz... Press any for the time of reckoning," Print " matching words on 2 lists will be removed and the round scored." ' evalaute results (remove matching words in lists) and score
DisplayBoard
player$ = removeRepeats$(player$) ' remove words input 2 or more times
Split player$, " ", p() ' convert player$ to array
ubp
= UBound(p
) ' quick count of words because array is base 1
Split AI$, " ", a()
For i
= 1 To uba
' Remove matching words from lists If a
(i
) = p
(j
) Then a
(i
) = "": p
(j
) = "" pScore = score&(p()): aiScore = score&(a()) ' scores done
AI$ = "": player$ = "" ' reset strings for rebuild
For i
= 1 To uba
' rebuild AI's non matching words If a
(i
) <> "" Then AI$
= AI$
+ " " + a
(i
) For i
= 1 To ubp
' rebuild players non matching words (if any) If p
(i
) <> "" Then player$
= player$
+ " " + p
(i
) 'display results of reckoning for round
Locate PrintLine
, 1:
Print "Player:"; player$;
" Score:"; pScore
Locate PrintLine
+ 3, 1:
Print "AI:"; AI$;
" Score:"; aiScore
Print " zzz... read em and weep, press any for another round of humiliation :)"
Static BeenHere
, Di$
(), Numbers
()
If BeenHere
= 0 Then 'load and initialize all the one time stuff ' load fonts
f48
= _LoadFont("Arial.ttf", 48, "MONOSPACE") f30
= _LoadFont("Arial.ttf", 30, "MONOSPACE") If f48
<= 0 Then Print "Sub NewBoard: Font did not load, goodbye.":
End
'load abrev Dictionary ======================================== comment out while debug
Open "3 to 12 Letter Words.txt" For Input As #1 ' for some reason 3-12 stopped loading on me ' "3 to 16 Letter Words.txt" new bigger file than loaded
' jack idea didn't work
' lets see if 3 to 12 will load this morning, yes it's loading this morning (Browser off)
Print "Loading 3 to 12 Letter Words from Collins Dictionary..." i = i + 1
'Cls: Locate 2, 1: Print i
NTopWord = i
Print "Big Word File loaded!,"; NTopWord;
" items zzz..."
' test load of file, find last 10 items
'For i = 199651 - 10 To 199651 ' when testing 3 to 10 Letter Words.txt
' Print WordList$(i)
'Next
'Sleep OK loading
' When using a separate word file for AI to "Handicap" it, no good just adds time to load stuff
'Open "AI Check Words.txt" For Input As #1
'Print "Loading AI Check Words.txt for AI, 6 to 12 letter words same dictionary..."
'i = 0
'While Not EOF(1)
' i = i + 1
' Input #1, AICheckWords$(i)
'Wend
'Close #1
' load dx(), dy() for testing the legality of words built from board
dx(0) = -1: dy(0) = -1 ' this is for AI to find words
dx(1) = 0: dy(1) = -1
dx(2) = 1: dy(2) = -1
dx(3) = -1: dy(3) = 0
dx(4) = 1: dy(4) = 0
dx(5) = -1: dy(5) = 1
dx(6) = 0: dy(6) = 1
dx(7) = 1: dy(7) = 1
' These are the 17 Dice with 6 Faces of a Letter need for Boggle
Di$(0) = "PACEMD"
Di$(1) = "RIFOBX"
Di$(2) = "IFEHEY"
Di$(3) = "DENOWS"
Di$(4) = "UTOKND"
Di$(5) = "HMSRAO"
Di$(6) = "LUPETS"
Di$(7) = "ACITOA"
Di$(8) = "YLGKUE"
Di$(9) = "QBMJOA"
Di$(10) = "EHISPN"
Di$(11) = "VETIGN"
Di$(12) = "BALIYT"
Di$(13) = "EZAVND"
Di$(14) = "RALESC"
Di$(15) = "UWILRG"
Di$(16) = "AEIOUU" ' b+ mod Boggle 2 to remove all special handling of Q words!!!
Dim Numbers
(0 To 16) ' load numbers for shuffling die order Numbers(i) = i
BeenHere = -1
'now get the game going
'For i = 1 To 16: Print Numbers(i);: Next: Print ' check the shuffle
For i
= 0 To 15 'choosing random face of die = 1 Letter Index2ColRow i, c, r
Board$
(c
, r
) = Mid$(Di$
(Numbers
(i
)), Int(Rnd * 6) + 1, 1) ' one die gets is left out now Boggle 2 ' now set timer + 180
For row
= 0 To 3 ' display the board Line ((col
+ 1) * 60 - 5, (row
+ 1) * 60 - 5)-Step(54, 54), &HFF2020FF, BF
'face color or die _PrintString ((col
+ 1) * 60 + 2, (row
+ 1) * 60 + 2), Board$
(col
, row
) _PrintString ((col
+ 1) * 60, (row
+ 1) * 60), Board$
(col
, row
)
'might not need in final cut
Function ColRow2Index&
(row
As Long, col
As Long) ' convert a board letter to index (not needed yet?) ColRow2Index& = row * 4 + col
colOut
= indexIn
Mod 4: rowOut
= indexIn \
4
curpos
= 1: arrpos
= LBound(loadMeArray
): LD
= Len(delim
) dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
, dpos
- curpos
) arrpos = arrpos + 1
curpos = dpos + LD
dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
)
Function Find&
(SortedArr$
(), x$
) ' if I am using this only to find words in dictionary, I can mod to optimize test
= Int((low
+ hi
) / 2) If SortedArr$
(test
) < x$
Then low
= test
+ 1 Else hi
= test
- 1
' This function checks to see that the word w$ is legally constructable with the given board.
' This function requires the recurive Function findCell& (startX As Long, startY As Long, word$, index As Long, Arr$())
Dim copy$
(-1 To 4, -1 To 4), first$
copy$(c, r) = Board$(c, r)
If copy$
(c
, r
) = first$
Then 'cell letter matches first letter in word test = findCell&(c, r, w$, 2, copy$())
If test
Then wordBuildOK&
= -1:
Exit Function ' ah ha! maybe it keeps trying when we are supposed to be done, fix?
'recursively called starting from wordBuildOK&
'make own set of variables for this function (attempt to debug but did not fix anything)
a$(c, r) = Arr$(c, r)
i = index: w$ = word$: y = startY: x = startX
a$(x, y) = "" 'so wont be used again
test = findCell&(x + dx(d), y + dy(d), w$, i + 1, a$())
Function AIwords$
(timeLimit
As Double) 'returns a space delimiter string of 1 point words that can be constructed from board in limited time 'ub = UBound(WordList$) now is NTopWord
' get a non redundant list of letters from board and put them in alpha order
l$ = Board$(c, r)
letters$ = l$
OK = 0
letters$
= Mid$(letters$
, 1, i
- 1) + l$
+ Mid$(letters$
, i
) If OK
= 0 Then letters$
= letters$
+ l$
'check if this is OK so far OK finally! This is 3rd time I needed to exit when found
' AIwords$ = letters$
'now letters of board are in alpha order
dp = 1 'place in dict
For l
= 1 To Len(letters$
) ' advance place in list$ by one until the word > letter dp = dp + 1
If checkTime
- startTime
> timeLimit
Then GoTo fini
'now start testing words
If wordBuildOK&
(WordList$
(dp
)) Then If b$
= "" Then b$
= WordList$
(dp
) Else b$
= b$
+ " " + WordList$
(dp
) dp = dp + 1
If checkTime
- startTime
> timeLimit
Then GoTo fini
fini:
AIwords$ = b$
' Dont need to special handling of Q words
'Function qw$ (w$) 'insert the u into a q letter word
' Dim As Long p
' p = InStr(w$, "Q")
' If p Then qw$ = Mid$(w$, 1, p) + "U" + Mid$(w$, p + 1) Else qw$ = w$
'End Function
Function removeRepeats$
(s$
) ' s$ is space delimited word list Split s$, " ", t$()
ok = -1
If b$
= "" Then b$
= t$
(i
) Else b$
= b$
+ " " + t$
(i
) removeRepeats$ = b$
score& = s
