This fixes the little problem getting buttons clicked, sorry poor coding on my part in BtnClickEvent, this is more efficient:
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).
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(7)).Text = Mid$(TheWaffle(5), 2, 1)
con(BT(15)).Text = Mid$(TheWaffle(5), 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).
b = b + ...