QB64 Phoenix Edition
vs GUI Updates - the latest from b+ - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: bplus (https://staging.qb64phoenix.com/forumdisplay.php?fid=36)
+---- Thread: vs GUI Updates - the latest from b+ (/showthread.php?tid=689)

Pages: 1 2 3 4 5 6 7 8

RE: vs GUI 2022-07-27 Update - bplus - 08-03-2022

GUI Wordle plus a regular Wordle Game played with Dictionary
A screenshot of GUI Wordle when I finally got one without looking in top left corner LOL!

   

Funny the regular app, Wordle 3 < 100 LOC!

RE: vs GUI 2022-07-27 Update - bplus - 08-04-2022

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

RE: vs GUI 2022-07-27 Update - bplus - 08-04-2022

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.

RE: vs GUI Update - bplus - 08-05-2022

OK Wordle 3.bas is working as intended:
   

A view from the Waffle Maker (test code for creating a Waffle Puzzle Solution):
   

RE: vs GUI Updates - the latest from b+ - SierraKen - 08-05-2022

Wordle rocks! I've been playing the regular Wordle for around 200 games in a row now. Thanks B+!

RE: vs GUI Updates - the latest from b+ - bplus - 08-05-2022

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...

RE: vs GUI Updates - the latest from b+ - bplus - 08-05-2022

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(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).

RE: vs GUI Updates - the latest from b+ - bplus - 08-05-2022

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.

RE: vs GUI Updates - the latest from b+ - SierraKen - 08-05-2022

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.

RE: vs GUI Updates - the latest from b+ - SierraKen - 08-05-2022

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.