QB64 Phoenix Edition
Words of Wonders by Fugo - basic clone - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Words of Wonders by Fugo - basic clone (/showthread.php?tid=857)

Words of Wonders by Fugo - basic clone - Petr - 09-05-2022

Hi.

Do you like crossword puzzles? If so, how do we write them so that we can figure them out together, no matter what level of English (or any other language) we are at?

After all, we have one thing in common. Speech that everyone on this forum will understand. That speech is QB64 and QBasic. Keywords, metacommand names, and function names. We all know it. How well do you know QB64 statements?

I dropped the OpenGL commands.

The following program is inspired by Fugo's Words of Wonders Android game. I play it sometimes, so I thought - can to write this? And it succeeded. I did not deal with graphic orgies and effects. I was only interested in the principle, the keyboard clone, and the puzzle itself.

To the point. After starting, the first crossword will start. In the right part is the keyboard. Hover the mouse over the first letter of the word you want to insert into the crossword puzzle, press and hold the left mouse button and create the whole word by successively choosing the letters (command QB64). If the word is a valid command, it will appear in the crossword puzzle. If not used in the crossword, but is a valid command name (as to QB64 version 2.02), this word is counted among the premium words.

Don't know what to do? Click the letter H with the mouse. The program will reveal a random letter in the crossword!

I dont use $. So is possible using statements without $: STR, COMMAND...

This is the lighter part of the program. WoW files are made by an editor with a database, I will post that next time. Attached are the required crossword files and font file.



[Image: wow.jpg]

Code: (Select All)
'World of Words clone - A clone of the game for Android re-writed for Windows/Linux in qb64
'public version, english commented source code. Written by Petr Preclik, 09/2022
'program accept COMMAND$ parameter - wow file: if this source is compiled as WoW.exe and file with crossword (CrossWord.WoW) is in the same directory run it as: WoW.exe CrossWord.WoW
'crossword program A (it lets you solve WoW crosswords, it doesn't let you create them)
$NoPrefix
Title "Words of Wonders clone (inspired by Fugo original game for Android), modified to Qbasic/QB64 statements"
Dim Shared Kbd$ '                                                              structure for wordcross
Type WoW
    W As String * 23
    Xpos As Unsigned Byte
    Ypos As Unsigned Byte
    O As Byte
End Type

Type HelpA '                                                                  structure for built-in Help function
    Char As Unsigned Byte
    V As Byte
End Type

Screen NewImage(1300, 1024, 32)

Fnt& = LoadFont("arialbd.ttf", 18, "bold")
Font Fnt&, 0


For GameLevels = 1 To 10 '                                     10 WordCross for you
    ReDim Shared Words(-1) As WoW '                            own words in wordcross
    ReDim Shared CW(24, 24) As Unsigned Byte, Orientation As Byte
    ReDim Shared CorrectWords(0) As String
    ReDim Shared HelpA(24, 24) As HelpA '                      array for Help function, show which character can be displayed after help use

    Orientation = 1 '                                          1 = vertical, -1 = horizontal
    If Command$ <> "" Then
        WoWFileName$ = Command$
    Else
        If GameLevels < 10 Then in$ = "0" Else in$ = ""
        WoWFileName$ = "CrossWord" + in$ + LTrim$(Str$(GameLevels)) + ".WoW"
    End If
    WoWLoad WoWFileName$ '

    ReDim Shared Visible(UBound(words)) As Byte
    Game = 0

    '                                                            draw empty grid (just used cells!)
    For sx = 0 To 23
        For sy = 0 To 22
            GPositionX = 10 + sx * 40
            GPositionY = 50 + sy * 40
            If CW(sx, sy) > 0 Then
                Line (GPositionX - 19, GPositionY - 19)-(GPositionX + 19, GPositionY + 19), , B
                'fill array for help function:
                HelpA(sx, sy).Char = CW(sx, sy)
                If HelpA(sx, sy).V = 0 Then HelpA(sx, sy).V = -1
            End If
    Next sy, sx
    PCopy 0, 1

    Do Until Game = 1
        '                                                        test, if word, you try inserting to crossword is correct, or not
        PCopy 1, 0
        Correct = 0
        BlickVal = 0
        For test = 0 To UBound(words)
            If UCase$(o$) = Trim$(Words(test).W) And Visible(test) = 1 Then BlickVal = test 'blick if user try inserting the same word twice
            If UCase$(o$) = Trim$(Words(test).W) Then Visible(test) = 1
            If Visible(test) = 1 Then Correct = Correct + 1 '                               'correct inserted words counter
        Next

        '                                                                                    print correct words to screen
        For PrintCorrect = 0 To UBound(words)
            If Visible(PrintCorrect) = 1 Then
                WordX = Words(PrintCorrect).Xpos
                WordY = Words(PrintCorrect).Ypos
                WordO = Words(PrintCorrect).O
                Word$ = Trim$(Words(PrintCorrect).W)

                GPositionX = 10 + WordX * 40
                GPositionY = 50 + WordY * 40
                NoCh = Len(Word$) - 1

                Select Case WordO
                    Case 1 '                                                                 vertical [Y]
                        posit = 0
                        For GY = GPositionY To GPositionY + 40 * NoCh Step 40
                            posit = posit + 1
                            PrintString (GPositionX - 8, GY - 8), Mid$(Word$, posit, 1)
                            HelpA(WordX, WordY + posit - 1).V = 1
                        Next

                    Case -1 '                                                                horizontal [X]
                        posit = 0
                        For GX = GPositionX To GPositionX + 40 * NoCh Step 40
                            posit = posit + 1
                            PrintString (GX - 8, GPositionY - 8), Mid$(Word$, posit, 1)
                            HelpA(WordX + posit - 1, WordY).V = 1
                        Next
                End Select
            End If
        Next
        If BlickVal > 0 Then Blick BlickVal '                                                 signaling in writing that this word is already here only happens after rendering all the already entered words in the puzzle

        '                                                                                     Finding the premium word (i.e. the word that is valid but not in the puzzle)
        If Len(o$) > 0 Then
            For t = LBound(correctwords) To UBound(correctwords)
                If Trim$(o$) = Trim$(CorrectWords(t)) Then PremiumWord = PremiumWord + 1: CorrectWords(t) = "": Exit For
            Next
        End If
        PrintString (1100, 100), "Premium Words:" + Str$(PremiumWord)

        '                                                                                       ----------------- HELP -------------------------
        Xpos = 1100
        Ypos = 130

        Line (Xpos + 24, Ypos + 32)-(Xpos, Ypos), , B
        PrintString (Xpos + 6, Ypos + 8), "H"
        Mouse mx, my, lb

        '                                                                                       letters will be printed here, which are already with a help set as visibile
        NoCh2 = 0
        For sx = 0 To 23
            For sy = 0 To 22
                If HelpA(sx, sy).V = 1 Then
                    'spocitat graficke souradnice
                    GPositionX = 10 + sx * 40
                    GPositionY = 50 + sy * 40
                    PrintString (GPositionX - 8, GPositionY - 8), Chr$(HelpA(sx, sy).Char)
                End If
                If HelpA(sx, sy).V = -1 Then NoCh2 = NoCh2 + 1 '                                 count the number of still invisible letters
        Next sy, sx

        If mx > Xpos And mx < Xpos + 24 Then
            If my > Ypos And my < Ypos + 32 Then
                If lb = -1 Then HelpMe NoCh2: lb = 0
            End If
        End If
        o$ = WoWKeyBoard$(Kbd$, 1100, 800)
        Display
        Limit 20

        If Correct = UBound(words) + 1 Then
            Sleep 2
            CLS2
            If Command$ <> "" Then
                message$ = "Crossword from command line complete."
                PrintString (Width / 2 - PrintWidth(message$) / 2, 376), message$: Display: Sleep 2: System
            End If
            Level = Level + 1
            If Level < 10 Then message$ = "Level" + Str$(Level) + " done!" Else message$ = "Next Crosswords you can yourself making by Petr's CrossWords editor. Demo over."
            PrintString (Width / 2 - PrintWidth(message$) / 2, 376), message$
            Display
            Sleep 2
            Correct = 0
            Kbd$ = ""
            Game = 1
        End If
        PrintString (Width / 2 - PrintWidth(message$) / 2, 376), Space$(PrintWidth(message$))
    Loop

    Erase Words
    ReDim CW(23, 22) As Unsigned Byte '                                                           for own words in crossword
    Kbd$ = ""
Next
End

Sub CLS2 '                                                                                        CLS set not transparent background. CLS2 set transparent background, as if is NEWIMAGE created.
    D = Dest
    S& = Width(D) * Height(D) * PixelSize(D)
    Dim m As MEM, C As Unsigned Long
    m = MemImage(D)
    C~& = &H00000000
    MemFill m, m.OFFSET, S&, C~& As UNSIGNED LONG
    MemFree m
End Sub

Sub HelpMe (Nch)
    NoCh = Nch

    If NoCh > 0 Then
        '                                                                                          in the auxiliary field HELP (x,y), a letter is written to help the help display
        ShowChar = Int((NoCh \ 2) * Rnd) + 1
        If ShowChar > NoCh Then ShowChar = NoCh
        For sx = 0 To 23
            For sy = 0 To 22
                If HelpA(sx, sy).V = -1 Then ShowChar = ShowChar - 1 '                             count the number of still invisible letters
                If ShowChar = 0 Then HelpA(sx, sy).V = 1: Exit For
        Next sy, sx
    End If


    '                                                                                             it is still necessary to check whether help did not reveal the whole word. If so, it must be recorded
    '                                                                                             the check will take place based on the sum of the cells in the HelpA field with a cell value of 1 according
    '                                                                                             to the orientation of the entry in the Words field:

    For WordCompleteControl = LBound(visible) To UBound(visible)
        WordX = Words(WordCompleteControl).Xpos
        WordY = Words(WordCompleteControl).Ypos
        WordO = Words(WordCompleteControl).O
        Word$ = Trim$(Words(WordCompleteControl).W)
        WLen = Len(Word$)
        HelpLen = 0
        Select Case WordO
            Case 1 '                                                                             check in vertical orientation (WordO = 1)
                For T = WordY To WordY + WLen
                    If HelpA(WordX, T).V = 1 Then HelpLen = HelpLen + 1: CW(WordX, T) = HelpA(WordX, T).Char 'number of characters from the word that can be seen according to the HelpA field
                Next T
                If HelpLen = WLen Then '                                                         the number of exposed characters is the same as the length of the word. Check if it is marked as resolved
                    Visible(WordCompleteControl) = 1
                End If
            Case -1 '                                                                            check in horizontal orientation (WordO = -1)
                For T = WordX To WordX + WLen
                    If HelpA(T, WordY).V = 1 Then HelpLen = HelpLen + 1: CW(T, WordY) = HelpA(T, WordY).Char
                Next T
                If HelpLen = WLen Then '                                                         the number of exposed characters is the same as the length of the word. Check if it is marked as resolved
                    'Beep
                    Visible(WordCompleteControl) = 1
                End If
        End Select
    Next
    KeyClear
    Delay .3
End Sub

Sub Blick (i) '                                                                                   it flashes written words when you enter the same word again
    WordX = Words(i).Xpos
    WordY = Words(i).Ypos
    WordO = Words(i).O
    Word$ = Trim$(Words(i).W)

    GPositionX = 10 + WordX * 40
    GPositionY = 50 + WordY * 40
    NoCh = Len(Word$) - 1
    Display
    Select Case WordO
        Case -1
            bc& = BackgroundColor
            For Warning = 1 To 50
                posit = 0
                For GX = GPositionX To GPositionX + 40 * NoCh Step 40
                    posit = posit + 1
                    PrintString (GX - 8, GPositionY - 8), Mid$(Word$, posit, 1)
                    Color , RGB32(255 - 4 * Warning)
                Next
                Display
                Limit 20
            Next
            Color , RGB32(bc&)
        Case 1
            bc& = BackgroundColor
            For Warning = 1 To 50
                posit = 0
                For GY = GPositionY To GPositionY + 40 * NoCh Step 40
                    posit = posit + 1
                    PrintString (GPositionX - 8, GY - 8), Mid$(Word$, posit, 1)
                    Color , RGB32(255 - 4 * Warning)
                Next
                Display
                Limit 20
            Next
            Color , RGB32(bc&)
    End Select
End Sub

Sub WoWLoad (file$)
    '                                                                                                                    load WoW file to RAM
    ff = FreeFile
    If FileExists(file$) Then
        Dim ID As String * 42
        Dim B As Unsigned Byte
        Open file$ For Binary As ff
        Get ff, 1, ID$
        If ID$ = "Petr's World of Words for QB64 file format" Then
            Get ff, , B
            Kbd$ = Space$(B)
            Get ff, , Kbd$ '                                                                                            keyboard characters
            Get ff, , B '                                                                                               counter of words in crossword
            ReDim Words(B) As WoW
            Get ff, , Words() '                                                                                         load WoW structure array type
            Close ff

            '                                                                                                           fill field CW using Words array
            ReDim CW(23, 22) As Unsigned Byte
            For LW = 0 To B
                Select Case Words(LW).O
                    Case 1 '                                                                                            vertical [Y]
                        wp = 0
                        For GY = Words(LW).Ypos To Words(LW).Ypos + Len(Trim$(Words(LW).W)) - 1
                            wp = wp + 1
                            CW(Words(LW).Xpos, GY) = Asc(Words(LW).W, wp)
                        Next

                    Case -1 '                                                                                           horizontal [X]
                        wp = 0
                        For GX = Words(LW).Xpos To Words(LW).Xpos + Len(Trim$(Words(LW).W)) - 1
                            wp = wp + 1
                            CW(GX, Words(LW).Ypos) = Asc(Words(LW).W, wp)
                        Next
                End Select
            Next LW


            Find Kbd$, CorrectWords()

            '                                                                                                            valid words must be deleted from the found words, so that only premium words remain in the
            '                                                                                                            CorrectWords field (not used in the quiz)

            For EraseValid = LBound(CorrectWords) To UBound(CorrectWords)
                For T = LBound(words) To UBound(words)
                    If Trim$(CorrectWords(EraseValid)) = Trim$(Words(T).W) Then CorrectWords(EraseValid) = ""
                Next
            Next
            '                                                                                                            delete blank spaces in the Correctwords field
            Dim RW(0) As String
            iRW = 0
            For CutCorrectWords = LBound(correctwords) To UBound(correctwords)
                If Trim$(CorrectWords(CutCorrectWords)) <> "" Then iRW = iRW + 1: ReDim Preserve RW(iRW) As String: RW(iRW) = CorrectWords(CutCorrectWords)
            Next
            ReDim CorrectWords(UBound(rw))
            For reload = LBound(rw) To UBound(rw)
                CorrectWords(reload) = RW(reload)
            Next
            Erase RW

        Else
            Print "File "; file$; " exists, but file has unknown format.": Display: Sleep 3: System
        End If
    Else
        Print "File "; file$; " not found.": Display: Sleep 3: System
    End If
End Sub


Function WoWKeyBoard$ (characters As String, Xpos, Ypos)
    image& = CopyImage(0, 32)

    NoC = Len(characters)
    O = Pi(2) * NoC

    Type WoWKbdType
        char As Unsigned Byte
        Xpos As Integer
        Ypos As Integer
        Act As Byte
    End Type

    Dim ch(1 To NoC) As WoWKbdType
    Dim LI(1 To NoC) As Byte

    For C = 1 To NoC
        ch(C).char = Asc(characters, C)
    Next
    kStp = 360 / NoC

    i = 0
    p = 0

    Do Until i = NoC
        i = i + 1
        angle = D2R(p)
        ch(i).Xpos = Xpos + Cos(angle) * O
        ch(i).Ypos = Ypos + Sin(angle) * O
        PrintString (ch(i).Xpos, ch(i).Ypos), Chr$(ch(i).char)
        p = p + kStp
    Loop
    Mouse mx, my, lb
    PosInWord = 0
    ii = 0
    OldX = 0
    OldY = 0
    OldT = 0

    If mx > Xpos - O - 32 And mx < mx + Xpos + O + 32 Then
        If my > Ypos - O - 32 And my < my + Ypos + O + 32 Then

            Do Until lb = 0
                Mouse mx, my, lb
                Line (Xpos - O - 32, Ypos - O - 32)-(Xpos + O + 32, Ypos + O + 32), &HFF000000, BF 'clear keyboard window
                LIi = 2

                For test = 1 To NoC


                    '                                                                               block mouse cursor in keyboard window
                    Mouse mx, my, lb
                    ControlMx = MIN(mx, Xpos - O - 32)
                    ControlMx = MAX(ControlMx, Xpos + O + 32)
                    ControlMy = MIN(my, Ypos - O - 32)
                    ControlMy = MAX(ControlMy, Ypos + O + 32)



              REM      MouseMove ControlMx, ControlMy
                    mx = ControlMx
                    my = ControlMy
                    '-----------------------------

                    Status = CircleDetect(mx, my, ch(test).Xpos, ch(test).Ypos)
                    If Status = 1 Then

                        '                                                                           test if it is not already registered

                        used = 0
                        u = 0
                        output$ = ""
                        LIindex = 0

                        For T = 1 To NoC
                            If ch(T).Act Then output$ = output$ + Chr$(ch(ch(T).Act).char)
                            PrintString (1100, 300), Space$(50)
                            PrintString (1100, 300), output$ '                                      ok, it shows the text continuously

                            If ch(T).Act = test Then
                                '                                                                   lock the logic so that the character is sold only once in the chain, OK
                                used = 1
                                OldT = T
                            End If
                            '                                                                       filter the positions of all used .ACT and paint the circle in one step
                            If ch(T).Act > 0 Then

                                '                                                                   used letters are marked with a circle
                                Circle (ch(ch(T).Act).Xpos + 6, ch(ch(T).Act).Ypos + 8), 16, &H50FFFFFF

                                '                                                                   the indexes numbers of all used letters are written in field LI
                                LIindex = LIindex + 1
                                LI(LIindex) = ch(T).Act
                            End If
                        Next T

                        '                                                                           drawn LINE OK, this is for the case that the mouse is on the correct letter
                        If LIindex > 0 Then
                            Line (mx, my)-(ch(LI(LIindex)).Xpos, ch(LI(LIindex)).Ypos)
                            For AllChars = 1 To LIindex - 1
                                Line (ch(LI(AllChars)).Xpos, ch(LI(AllChars)).Ypos)-(ch(LI(AllChars + 1)).Xpos, ch(LI(AllChars + 1)).Ypos)
                            Next
                        End If

                        If used = 0 Then
                            If ii < NoC Then
                                ii = ii + 1
                                ch(ii).Act = test
                                used = 1
                                LockCh = 1
                            End If
                        End If
                        '                                                                           deleting the last character
                        If ii > 1 And LockCh = 0 Then
                            If ch(ii - 1).Act = test Then
                                LockCh = 1
                                ch(ii).Act = 0
                                ii = ii - 1
                            End If
                        End If

                    Else
                        For T = 1 To NoC
                            If ch(T).Act > 0 Then
                                '                                                                   used letters are marked with a circle even when the mouse is not in the detection zone
                                Circle (ch(ch(T).Act).Xpos + 6, ch(ch(T).Act).Ypos + 8), 16, &H50FFFFFF
                            End If
                        Next

                        '                                                                           drawing a line between letters even if the mouse is outside the letter
                        If LIindex > 0 Then
                            Line (mx, my)-(ch(LI(LIindex)).Xpos, ch(LI(LIindex)).Ypos)
                            For AllChars = 1 To LIindex - 1
                                Line (ch(LI(AllChars)).Xpos, ch(LI(AllChars)).Ypos)-(ch(LI(AllChars + 1)).Xpos, ch(LI(AllChars + 1)).Ypos)
                            Next
                        End If
                    End If
                Next test
                LockCh = 0

                '                                                                                    rendered keyboard letters
                i = 0
                p = 0

                Do Until i = NoC
                    i = i + 1
                    angle = D2R(p)
                    ch(i).Xpos = Xpos + Cos(angle) * O
                    ch(i).Ypos = Ypos + Sin(angle) * O
                    PrintString (ch(i).Xpos, ch(i).Ypos), Chr$(ch(i).char)
                    p = p + kStp
                Loop

                PutImage , image&, 0
                Display
                Limit 20
            Loop

        End If
    End If
    FreeImage image&
    WoWKeyBoard$ = output$
    KeyClear
End Function


Sub Mouse (mx, my, lb)
    While MouseInput
    Wend
    mx = MouseX
    my = MouseY
    lb = MouseButton(1)
End Sub

Function CircleDetect (x As Long, y As Long, cx As Long, cy As Long)
    CircleDetect = 0
    r& = 16
    xy& = ((x& - cx&) ^ 2) + ((y& - cy&) ^ 2) 'Pythagorean theorem
    If r& ^ 2 >= xy& Then CircleDetect = 1 Else CircleDetect = 0
End Function

Sub Find (ij$, a() As String) '                                                         according to the keyboard character, finds valid words in the database (that is, those that can be written using the character from the keyboard)
    i$ = ij$
    ReDim Cache(0) As String
    NoCh = Len(i$)

    Restore database
    For r = 1 To 420 '                                                                  420 words (QB64 statements, metacommands and functions) in database
        Read d$
        If Len(d$) <= NoCh Then
            Cache(ci) = d$
            ci = ci + 1
            ReDim Preserve Cache(ci) As String
        End If
    Next r
    ReDim Preserve Cache(ci - 1) As String

    '                                                                                   check characters
    For l = 0 To ci - 1 '                                                               go through the entire field of words
        If IsValid(ij$, Cache(l)) Then
            a(fi) = Cache(l)
            fi = fi + 1
            ReDim Preserve a(fi) As String
        End If
    Next

    database:
    'A    26 recs
    Data "ACCEPTFILEDROP","ACOS","ACOSH","ALLOWFULLSCREEN","ALPHA","ALPHA32","ARCCOT","ARCCSC","ARCSEC","ASIN","ASINH","ASSERT","ASSERTS","ATAN2","ATANH","AUTODISPLAY","AXIS","ABS","ABSOLUTE","ACCESS","ALIAS","AND","APPEND","AS","ASC","ATN"
    'B    14 recs
    Data "BEEP","BINARY","BLOAD","BSAVE","BYVAL","BACKGROUNDCOLOR","BIT","BLEND","BLINK","BLUE","BLUE32","BUTTON","BUTTONCHANGE","BYTE"
    'C    32+19 recs
    Data "CALL","CASE","CHAIN","CHDIR","CHR","CINT","CIRCLE","CLEAR","CLNG","CLOSE","CLS","COLOR","COMMAND","COMMON","CONST","COS","CSNG","CSRLIN","CVD","CVDMBF","CVI","CVL","CVS","CVSMBF","CAPSLOCK","CHECKING","CEIL","CINP","CLEARCOLOR","CLIP","CLIPBOARD","CLIPBOARDIMAGE"
    Data "COLOR","COMMANDCOUNT","CONNECTED","CONNECTIONADDRESS","CONSOLE","CONSOLEINPUT","CONSOLETITLE","CONTINUE","CONTROLCHR","COPYIMAGE","COPYPALETTE","COT","COTH","COSH","CSC","CSCH","CV","CWD"
    'D    28+6 recs
    Data "DATA","DATE","DECLARE","DEFDBL","DEFINT","DEFLNG","DEFSNG","DEFSTR","DIM","DO","DOUBLE","DRAW","DYNAMIC","D2G","D2R","DEBUG","DEFAULTCOLOR","DEFINE","DEFLATE","DELAY","DEPTHBUFFER","DESKTOPHEIGHT","DESKTOPWIDTH","DEST","DEVICE","DEVICEINPUT","DEVICES","DIR"
    Data "DIREXISTS","DISPLAY","DISPLAYORDER","DONTBLEND","DONTWAIT","DROPPEDFILE"
    'E    22 recs
    Data "ELSE","ELSEIF","END","ENVIRON","ENVIRON","EOF","EQV","ERASE","ERL","ERR","ERROR","EXIT","EXP","ECHO","ENVIRONCOUNT","ERROR","ERRORLINE","ERRORMESSAGE","EXEICON"
    'F    17 recs
    Data "FIELD","FILES","FIX","FOR","FREE","FREEFILE","FUNCTION","FILEEXISTS","FINISHDROP","FLOAT","FONT","FONTHEIGHT","FONTWIDTH","FREEFONT","FREEIMAGE","FREETIMER","FULLSCREEN"
    'G    7 recs
    Data "GET","GOSUB","GOTO","G2D","G2R","GREEN","GREEN32"
    'H    4 recs
    Data "HEX","HEIGHT","HIDE","HYPOT"
    'I    18 recs
    Data "IF","IMP","INCLUDE","INKEY","INP","INPUT","INSTR","INT","INTEGER","INTERRUPT","INTERRUPTX","ICON","INCLERRORFILE","INCLERRORLINE","INFLATE","INSTRREV","INTEGER64"
    'J    0 recs
    'K    5 recs
    Data "KEY","KILL","KEYCLEAR","KEYDOWN","KEYHIT"
    'L    25 recs
    Data "LBOUND","LCASE","LEFT","LEN","LET","LINE","LIST","LOC","LOCATE","LOCK","LOF","LOG","LONG","LOOP","LPOS","LPRINT","LSET","LTRIM","LASTAXIS","LASTBUTTON","LASTWHEEL","LIMIT","LOADFONT","LOADIMAGE","LOAD"
    'M    28+6 recs
    Data "MID","MKD","MKDIR","MKDMBF","MKI","MKL","MKS","MKSMBF","MOD","MAPTRIANGLE","MAPUNICODE","MEM","MEMCOPY","MEMELEMENT","MEMEXISTS","MEMFILL","MEMFREE","MEMGET","MEMIMAGE","MEMNEW","MEMPUT","MEMSOUND","MIDDLE","MK","MOUSEBUTTON","MOUSEHIDE","MOUSEINPUT","MOUSEMOVE"
    Data "MOUSEMOVEMENTX","MOUSEMOVEMENTY","MOUSESHOW","MOUSEWHEEL","MOUSEX","MOUSEY"
    'N    6 recs
    Data "NAME","NEXT","NOT","NEWIMAGE","NOPREFIX","NUMLOCK"
    'O    13 recs
    Data "OCT","OFF","ON","OPEN","OR","OUT","OUTPUT","OFFSET","OPENCLIENT","OPENCONNECTION","OPENHOST","OPTION","OS"
    'P    22 recs
    Data "PAINT","PALETTE","PCOPY","PEEK","PLAY","PMAP","POINT","POKE","POS","PRESET","PRINT","PSET","PUT","PALETTECOLOR","PI","PIXELSIZE","PRESERVE","PRINTIMAGE","PRINTMODE","PRINTSTRING","PRINTWIDTH","PUTIMAGE"
    'Q    0 recs
    'R    30 recs
    Data "RANDOM","RANDOMIZE","READ","REDIM","REM","RESET","RESTORE","RESUME","RETURN","RIGHT","RMDIR","RND","RSET","RTRIM","RUN","R2D","R2G","RED","RED32","READBIT","RESETBIT","RESIZE","RESIZE","RESIZEHEIGHT","RESIZEWIDTH","RGB","RGB32","RGBA","RGBA32","ROUND"
    'S    26+22+23 recs
    Data "SADD","SCREEN","SEEK","SELECT","SGN","SHARED","SHELL","SIN","SINGLE","SLEEP","SOUND","SPACE","SPC","SQR","STATIC","STEP","STICK","STOP","STR","STRIG","STRING","SUB","SWAP","SYSTEM"
    Data "SCREENCLICK","SCREENEXISTS","SCREENHIDE","SCREENICON","SCREENIMAGE","SCREENMOVE","SCREENPRINT","SCREENSHOW","SCREENX","SCREENY","SCROLLLOCK","SETALPHA","SETBIT","SHELLHIDE","SHL","SHR","SINH","SNDBAL","SNDCLOSE","SNDCOPY"
    Data "SNDGETPOS","SNDLEN","SNDLIMIT","SNDLOOP","SNDOPEN","SNDOPENRAW","SNDPAUSE","SNDPAUSED","SNDPLAY","SNDPLAYCOPY","SNDPLAYFILE","SNDPLAYING","SNDRATE","SNDRAW","SNDRAWDONE","SNDRAWLEN","SNDSETPOS","SNDSTOP","SNDVOL","SOURCE","STARTDIR","STRCMP","STRICMP"
    'T    13 recs
    Data "TAB","TAN","THEN","TIME","TIMER","TO","TYPE","TANH","TITLE","TOGGLEBIT","TOTALDROPPEDFILES","TRIM"
    'U    5 recs
    Data "UBOUND","UCASE","UNLOCK","UNTIL","UNSIGNED"
    'V    5 recs
    Data "VAL","VARPTR","VARSEG","VIEW"
    'W    9 recs
    Data "WAIT","WEND","WHILE","WIDTH","WINDOW","WRITE","WHEEL","WINDOWHANDLE","WINDOWHASFOCUS"
    'X    1 rec
    Data "XOR"
End Sub

Function IsValid (keyboard2$, database$) 'check if a character from keyboard2$ can be used to build the some word in database$ (if yes, return 1, otherwise return 0)
    K$ = keyboard2$: W$ = database$
    keyboard$ = K$
    WordLenght = Len(W$)
    Pass = 0
    For test = 1 To Len(K$)
        keyboard$ = Mid$(K$, test, 1)
        Position = InStr(1, W$, keyboard$)
        If Position > 0 Then W$ = Mid$(W$, 1, Position - 1) + Mid$(W$, Position + 1, Len(W$) - Position): Pass = Pass + 1
    Next
    If Pass = WordLenght Then IsValid = 1 Else IsValid = 0
End Function

Function MIN (variable, value)
    If variable < value Then MIN = value Else MIN = variable
End Function

Function MAX (variable, value)
    If variable > value Then MAX = value Else MAX = variable
End Function


RE: Words of Wonders by Fugo - basic clone - Petr - 09-05-2022

I found a problem with MOUSEMOVE in the source code above, so I disabled it (doesn't affect the functionality of the program) so the source code above is fixed. To enter letters - if you don't hit the right letter when entering a word, move the mouse to the last selected one and the last character will be deleted (example - instead of MOUSEMOVE you make a mistake and have MOUSEMOVF - move to the letter F, the word will be shortened to MOUSEMOV, now move to the letter E , you will get the word MOUSEMOVE. Release the left mouse button. This will send the word to the program.

RE: Words of Wonders by Fugo - basic clone - SMcNeill - 09-05-2022

We just patched _MOUSEMOVE yesterday. you'll probably find the fix available in next week's release. (We're hoping for a weekly release schedule.)