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]](https://i.ibb.co/BsBJqbY/wow.jpg)
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.
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