08-04-2022, 02:01 AM (This post was last modified: 08-04-2022, 02:03 AM by bplus.)
For Wordle 3 to work as intended (having the 5 Letter Dictionary Open in an Editor so you can search it),
Replace line 40 that makes the Shell call to your designated txt Editor with this:
Shell _DontWait Chr$(34) + "5l_words.txt" + Chr$(34)
I forgot I renamed the Dictionary file since Wordle 3.bas
Coming soon to a GUI near you, the Game Wordle inspired: Waffle
08-04-2022, 11:46 PM (This post was last modified: 08-05-2022, 03:10 AM by bplus.)
Waffle And Wordle with starter Waffle Maker
Wow, 200 LOC to correctly color 21 squares for Waffle Game! Makes the Waffle Maker look simple LOL!
Here is what Waffle looks like at start and after I lose:
And here is Wordle and Waffle GUI zip (working with updated, vs GUI.BM, that checks control type before drawing to save on coding typos and really weird bugs).
Update: Apologies again about Wordle 3.bas attempting to call the wrong name for 5 Letter words.txt file, here is fixed Wordle 3.bas in zip package.
08-05-2022, 05:34 AM (This post was last modified: 08-05-2022, 05:36 AM by bplus.)
Hi Ken, I just ran an analysis on the 5l_words.txt file here are the first 2 or 3 words to try:
1. arose - has 5 top 6 letters used in the whole dictionary
2, clint - we now have the top 10 letters used in the dictionary
3. dumpy - you may or may not need a 3rd word depending how you scored with first 2
with dumpy you have the top 16 letters use minus h.
I should see how many words don't have a single one of these letters but my eyes are so blurry right now...
08-05-2022, 05:48 PM (This post was last modified: 08-05-2022, 05:50 PM by bplus.)
This fixes the little problem getting buttons clicked, sorry poor coding on my part in BtnClickEvent, this is more efficient:
Code: (Select All)
Option _Explicit
' Pretty good Article on Waffle: https://nerdschalk.com/waffle-wordle-game-spinoff-how-to-play-where-to-play-gameplay-rules-strategies-and-more/
' 2022-08-05 fix poor coding in BtnClickEvent
'$include:'vs GUI.BI'
Randomize Timer
Dim Shared As String Dict(1 To 3146), TheWaffle(1 To 6)
Dim Shared As Long TopWordN, BT(1 To 21), Turn, B1Click, NSwaps, lblSwaps
_Title "GUI Waffle"
Intro
' Set Globals from BI
Xmax = 620: Ymax = 620: GuiTitle$ = "GUI Waffle"
OpenWindow Xmax, Ymax, GuiTitle$, "arial.ttf" ' need to do this before drawing anything from NewControls"
Init ' calls ColorMyWorld to show puzzle
MainRouter ' after all controls setup
Sub BtnClickEvent (i As Long)
If con(BT(i)).BC = C3(60) Then Beep: Exit Sub ' ignore green button clicks!
Turn = Turn + 1
If Turn = 1 Then
B1Click = i ' save the place
ActiveControl = i
drwBtn BT(i), -1 ' high light
ElseIf Turn = 2 Then
If i = B1Click Then ' Cancel the first click
drwBtn BT(i), 0 ' turn off high light
Else
Swap con(BT(i)).Text, con(BT(B1Click)).Text
NSwaps = NSwaps - 1
ColorMyWorld
End If
Turn = 0 'resets
ActiveControl = 0
B1Click = 0
End If
End Sub
Sub LstSelectEvent (control As Long)
control = control
End Sub
Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)
i = i: Pmx = Pmx: Pmy = Pmy
End Sub
Sub PicFrameUpdate (i As Long)
i = i
End Sub
Sub Intro
Screen _NewImage(600, 400, 32) ' leave room for Editor window next to this QB64 app
_ScreenMove 200, 200
Color _RGB32(200, 200, 200), _RGB32(0, 0, 0) ' not too bright white on black for normal print
' 123456789012345678901234567890123456789012345678901234567890123456789012345
Locate 6, 1
Print " The Syrup on Waffle:"
Print
Print " 6 5-Letter Words have been laid out: 3 across and 3 down in a"
Print " Waffle pattern. Their letters have been swapped around and"
Print " your job is to get them back in order in 15 swaps or less."
Print
Print " Clues: Green background letters are in right spot,"
Print " Yellow backgrounds are in right row or column"
Print " (be careful, could be either word at an intersections),"
Print " White backgrounds are totally out of their words."
Print
Print
Print " ... zzz Press a key to continue ...zzz"
LoadDictionary
Sleep
End Sub
Sub Init ' create controls and variables to start first game
Dim As Long i, y, x
i = 1
For y = 0 To 4
For x = 0 To 4
If (x = 1 Or x = 3) And (y = 1 Or y = 3) Then
' skip
Else
BT(i) = NewControl(1, x * 120 + 20, y * 120 + 20, 100, 100, 45, 0, 0, "")
i = i + 1
End If
Next
Next
lblSwaps = NewControl(4, 381, 381, 98, 98, 40, 0, 0, "")
ResetGame
End Sub
Sub ResetGame ' reset Controls and Variables for new game
Dim As Long i
NSwaps = 15
Turn = 0
B1Click = 0
MakeWaffle
For i = 1 To 5
con(BT(i)).Text = Mid$(TheWaffle(1), i, 1)
Next
For i = 9 To 13
con(BT(i)).Text = Mid$(TheWaffle(2), i - 8, 1)
Next
For i = 17 To 21
con(BT(i)).Text = Mid$(TheWaffle(3), i - 16, 1)
Next
con(BT(6)).Text = Mid$(TheWaffle(4), 2, 1)
con(BT(14)).Text = Mid$(TheWaffle(4), 4, 1)
con(BT(8)).Text = Mid$(TheWaffle(6), 2, 1)
con(BT(16)).Text = Mid$(TheWaffle(6), 4, 1)
Dim scramble(1 To 21) As Long
For i = 1 To 21
scramble(i) = i
Next
For i = 21 To 2 Step -1
Swap scramble(i), scramble(Int(Rnd * i) + 1)
Next
For i = 1 To 8
Swap con(BT(scramble(i))).Text, con(BT(scramble(i + 8))).Text
Next
ColorMyWorld
End Sub
Sub ColorMyWorld ' after swaps redraw board with color codes, check for win or loss
Dim As Long c(1 To 21), i, hits, p ' hits by green count
Dim soln$(1 To 6)
' make a copy of the solution
For i = 1 To 6
soln$(i) = TheWaffle(i) ' copy TheWaffle (soln) and blank out letters colored
Next
For i = 1 To 21 ' set Green buttons
If c(i) <> 3 Then ' all 21 cases?
Select Case i
Case 1
If _Trim$(con(BT(i)).Text) = Mid$(soln$(1), 1, 1) Then c(i) = 3: Mid$(soln$(1), 1, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(4), 1, 1) Then c(i) = 3: Mid$(soln$(4), 1, 1) = " "
Case 2
If _Trim$(con(BT(i)).Text) = Mid$(soln$(1), 2, 1) Then c(i) = 3: Mid$(soln$(1), 2, 1) = " "
Case 3
If _Trim$(con(BT(i)).Text) = Mid$(soln$(1), 3, 1) Then c(i) = 3: Mid$(soln$(1), 3, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(5), 1, 1) Then c(i) = 3: Mid$(soln$(5), 1, 1) = " "
Case 4
If _Trim$(con(BT(i)).Text) = Mid$(soln$(1), 4, 1) Then c(i) = 3: Mid$(soln$(1), 4, 1) = " "
Case 5
If _Trim$(con(BT(i)).Text) = Mid$(soln$(1), 5, 1) Then c(i) = 3: Mid$(soln$(1), 5, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(6), 1, 1) Then c(i) = 3: Mid$(soln$(6), 1, 1) = " "
Case 6
If _Trim$(con(BT(i)).Text) = Mid$(soln$(4), 2, 1) Then c(i) = 3: Mid$(soln$(4), 2, 1) = " "
Case 7
If _Trim$(con(BT(i)).Text) = Mid$(soln$(5), 2, 1) Then c(i) = 3: Mid$(soln$(5), 2, 1) = " "
Case 8
If _Trim$(con(BT(i)).Text) = Mid$(soln$(6), 2, 1) Then c(i) = 3: Mid$(soln$(6), 2, 1) = " "
Case 9
If _Trim$(con(BT(i)).Text) = Mid$(soln$(2), 1, 1) Then c(i) = 3: Mid$(soln$(2), 1, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(4), 3, 1) Then c(i) = 3: Mid$(soln$(4), 3, 1) = " "
Case 10
If _Trim$(con(BT(i)).Text) = Mid$(soln$(2), 2, 1) Then c(i) = 3: Mid$(soln$(2), 2, 1) = " "
Case 11
If _Trim$(con(BT(i)).Text) = Mid$(soln$(2), 3, 1) Then c(i) = 3: Mid$(soln$(2), 3, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(5), 3, 1) Then c(i) = 3: Mid$(soln$(5), 3, 1) = " "
Case 12
If _Trim$(con(BT(i)).Text) = Mid$(soln$(2), 4, 1) Then c(i) = 3: Mid$(soln$(2), 4, 1) = " "
Case 13
If _Trim$(con(BT(i)).Text) = Mid$(soln$(2), 5, 1) Then c(i) = 3: Mid$(soln$(2), 5, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(6), 3, 1) Then c(i) = 3: Mid$(soln$(6), 3, 1) = " "
Case 14
If _Trim$(con(BT(i)).Text) = Mid$(soln$(4), 4, 1) Then c(i) = 3: Mid$(soln$(4), 4, 1) = " "
Case 15
If _Trim$(con(BT(i)).Text) = Mid$(soln$(5), 4, 1) Then c(i) = 3: Mid$(soln$(5), 4, 1) = " "
Case 16
If _Trim$(con(BT(i)).Text) = Mid$(soln$(6), 4, 1) Then c(i) = 3: Mid$(soln$(6), 4, 1) = " "
Case 17
If _Trim$(con(BT(i)).Text) = Mid$(soln$(3), 1, 1) Then c(i) = 3: Mid$(soln$(3), 1, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(4), 5, 1) Then c(i) = 3: Mid$(soln$(4), 5, 1) = " "
Case 18
If _Trim$(con(BT(i)).Text) = Mid$(soln$(3), 2, 1) Then c(i) = 3: Mid$(soln$(3), 2, 1) = " "
Case 19
If _Trim$(con(BT(i)).Text) = Mid$(soln$(3), 3, 1) Then c(i) = 3: Mid$(soln$(3), 3, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(5), 5, 1) Then c(i) = 3: Mid$(soln$(5), 5, 1) = " "
Case 20
If _Trim$(con(BT(i)).Text) = Mid$(soln$(3), 4, 1) Then c(i) = 3: Mid$(soln$(3), 4, 1) = " "
Case 21
If _Trim$(con(BT(i)).Text) = Mid$(soln$(3), 5, 1) Then c(i) = 3: Mid$(soln$(3), 5, 1) = " "
If _Trim$(con(BT(i)).Text) = Mid$(soln$(6), 5, 1) Then c(i) = 3: Mid$(soln$(6), 5, 1) = " "
End Select
End If
Next
' That was for Green now for yellow
For i = 1 To 21
If c(i) <> 3 Then ' all 21 cases?
Select Case i
Case 1
p = InStr(soln$(1), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 1) = " "
p = InStr(soln$(4), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(4), p, 1) = " "
Case 2
p = InStr(soln$(1), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 1) = " "
Case 3
p = InStr(soln$(1), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 1) = " "
p = InStr(soln$(5), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(5), p, 1) = " "
Case 4
p = InStr(soln$(1), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 1) = " "
Case 5
p = InStr(soln$(1), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 1) = " "
p = InStr(soln$(6), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(6), p, 1) = " "
Case 6
p = InStr(soln$(4), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(4), p, 1) = " "
Case 7
p = InStr(soln$(5), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(5), p, 1) = " "
Case 8
p = InStr(soln$(6), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(6), p, 1) = " "
Case 9
p = InStr(soln$(2), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(2), p, 1) = " "
p = InStr(soln$(4), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(4), p, 1) = " "
Case 10
p = InStr(soln$(2), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(2), p, 1) = " "
Case 11
p = InStr(soln$(2), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(2), p, 1) = " "
p = InStr(soln$(5), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(5), p, 1) = " "
Case 12
p = InStr(soln$(2), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(2), p, 1) = " "
Case 13
p = InStr(soln$(2), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(2), p, 1) = " "
p = InStr(soln$(6), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(6), p, 1) = " "
Case 14
p = InStr(soln$(4), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(4), p, 1) = " "
Case 15
p = InStr(soln$(5), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(5), p, 1) = " "
Case 16
p = InStr(soln$(6), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(6), p, 1) = " "
Case 17
p = InStr(soln$(3), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(3), p, 1) = " "
p = InStr(soln$(4), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(4), p, 1) = " "
Case 18
p = InStr(soln$(3), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(3), p, 1) = " "
Case 19
p = InStr(soln$(3), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(1), p, 3) = " "
p = InStr(soln$(5), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(5), p, 1) = " "
Case 20
p = InStr(soln$(3), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(3), p, 1) = " "
Case 21
p = InStr(soln$(3), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(3), p, 1) = " "
p = InStr(soln$(6), _Trim$(con(BT(i)).Text))
If p > 0 Then c(i) = 2: Mid$(soln$(6), p, 1) = " "
End Select
End If
Next
con(lblSwaps).Text = TS$(NSwaps)
drwLbl lblSwaps
For i = 1 To 21 'update buttons
If c(i) = 3 Then
con(BT(i)).FC = C3(999): con(BT(i)).BC = C3(60): hits = hits + 1
ElseIf c(i) = 2 Then
con(BT(i)).FC = C3(0): con(BT(i)).BC = C3(990) ' yellow backs row or column or both
Else
con(BT(i)).FC = C3(0): con(BT(i)).BC = C3(999) ' complete miss row and column
End If
drwBtn BT(i), 0
Next
If hits = 21 Then
mBox "Congratulations!", "You ate the Waffle."
ResetGame ' of course you want to play again!
End If
If NSwaps <= 0 Then
mBox "So sorry", "You've used your 15 Swaps, the puzzle was:" + Chr$(10)+_
" 3 Across:"+ chr$(10) + TheWaffle(1) + chr$(10) +TheWaffle(2) + chr$(10)+_
TheWaffle(3) + chr$(10)+" 3 Down:" + chr$(10) + TheWaffle(4) + chr$(10)+_
TheWaffle(5) + chr$(10) + TheWaffle(6)
ResetGame ' of course you want to play again!
End If
End Sub
Sub MakeWaffle
Erase TheWaffle 'clear whatever
Dim As Long i, j, r, flag, saveR
startOver:
For i = 1 To 3
rewaff:
TheWaffle(i) = Dict$(Int(Rnd * TopWordN) + 1)
For j = 1 To i - 1
If TheWaffle(i) = TheWaffle(j) Then GoTo rewaff
Next
Next
For i = 1 To 3
r = Int(Rnd * TopWordN) + 1
saveR = r
Select Case i
Case 1
rewaff2:
TheWaffle(4) = Dict$(r)
flag = 0
If Mid$(TheWaffle(4), 1, 1) = Mid$(TheWaffle(1), 1, 1) Then
If Mid$(TheWaffle(4), 3, 1) = Mid$(TheWaffle(2), 1, 1) Then
If Mid$(TheWaffle(4), 5, 1) = Mid$(TheWaffle(3), 1, 1) Then
flag = -1
End If
End If
End If
If flag = 0 Then
r = r + 1
If r > TopWordN Then r = 1
If r = saveR Then GoTo startOver ' damn it!
GoTo rewaff2
End If
Case 2
rewaff3:
TheWaffle(5) = Dict$(r)
flag = 0
If Mid$(TheWaffle(5), 1, 1) = Mid$(TheWaffle(1), 3, 1) Then
If Mid$(TheWaffle(5), 3, 1) = Mid$(TheWaffle(2), 3, 1) Then
If Mid$(TheWaffle(5), 5, 1) = Mid$(TheWaffle(3), 3, 1) Then
flag = -1
End If
End If
End If
If flag = 0 Then
r = r + 1
If r > TopWordN Then r = 1
If r = saveR Then GoTo startOver ' damn it!
GoTo rewaff3
End If
Case 3
rewaff4:
TheWaffle(6) = Dict$(r)
flag = 0
If Mid$(TheWaffle(6), 1, 1) = Mid$(TheWaffle(1), 5, 1) Then
If Mid$(TheWaffle(6), 3, 1) = Mid$(TheWaffle(2), 5, 1) Then
If Mid$(TheWaffle(6), 5, 1) = Mid$(TheWaffle(3), 5, 1) Then
flag = -1
End If
End If
End If
If flag = 0 Then
r = r + 1
If r > TopWordN Then r = 1
If r = saveR Then GoTo startOver ' damn it!
GoTo rewaff4
End If
End Select
Next
End Sub
Sub LoadDictionary
Open "5l_words.txt" For Input As #1 ' W3 version allows repeated letters, allot of 5 letter 1st names in here
While Not EOF(1)
TopWordN = TopWordN + 1
Input #1, Dict$(TopWordN)
Wend
Close #1
End Sub
'$include:'vs GUI.BM'
Replace this GUI Waffle.bas with the one from zip posted above.
I will post a revised zip package when I get Wordle fixed to probably 1 Text Box for input instead of 6 (one for each guess).
BTW the MainRouter calls those empty subs regardless the actual GUI app, that's why they are in there (in case anyone was wondering).
08-05-2022, 06:31 PM (This post was last modified: 08-05-2022, 06:59 PM by bplus.)
Oh, something I discovered last night in the 5l_words.txt file.
Word number 2930 is U.S.A. The dots will likely throw you off even if the code does not throw an error!
If you take it out change the For loop loading the Dict() to 3145 instead of 3136, and change any other place that says 3146 to 3145.
Update: all 4 programs in last zip will not be effected if you change the 5l_word.txt file with more or less words except the Dim Shared Dict(1 to 3146) line near the top. They all count the words they load and use that count for the top of the array.
That's interesting B+. I've always started with the word STARE because on Wheel of Fortune they always give: RSTLNE so I figured those were the most used letters, interesting.
There would be no words in the English language that don't have SOME of those letters B+ because a word has to have a vowel, a,e,i,o,u and sometimes y. If you use all 3 of those words it has all of the vowels. There's some words that use vowels with 2 dots on top, taken from other languages, but I don't know them off-hand.
vs GUI Updates - the latest from b+
