NOTE: You need to download a word list to your computer to use. See program for a site to download the list I use.
Code: Select all
;Program to help playing Wordle. It uses a wordlist I found at
;http://www-personal.umich.edu/~jlawler/wordlist.html
;download this or whatever list you find and store in Readfile$ location
;Note option 3 is useful to search for good guess words, to use it to search for all five letter
;words containing e,a,u make guessword$(1)=eau??) and first line of results section 33300
;or for all words containing e,a, and u in 3 position use 33100
Enumeration 100 Step 10
#Win1: #Menu1: #Readit: #Writeit: #Title: #Search: #Clear: #Tbox1: #Tbox2: #test1:#test2
#Wordbox: #Resultbox: #Nhits: #Words: #CBox1: #CBox2: #Display: #Info: #Winfo: #Rinfo
EndEnumeration
Dim wordtext$(500000)
Dim FoundText$(500000)
Dim Guessword$(7)
Dim GuessResult$(6)
Dim NumWords(10)
ReadFile$="C:\Users\Public\Documents\wordlist.txt"
;ReadFile$="C:\Users\Public\Documents\words_alpha.txt"
StoreFile$="C:\Users\Public\Documents\wordfound.txt"
directions$=" Input word and results from wordle games to show possible words. Or use to show good guess words."+
" For example, put in ?e?a? to find all words with second letter e and fourth letter a, the result"+
" input doesn't matter for ? input character postions. In this example if you put 11111 for the result all words"+
" with an e in the second position and an a in the fourth position would be shown. If you put in 33333 all words"+
" with an e and an a would be shown."+#CRLF$+#CRLF$+" Note, length of word is determined by first word length."+
" If you put in a test word, the results will be automatically filled in."+#CRLF$+#CRLF$+
" Note word length can be different than five letters long. No check is made if guess words are actual words."
Resultinfo$=" Result inputs"+#CRLF$+"0=letter not in word"+#CRLF$+" or identified elsewhere"+#CRLF$+"1=letter at position"+
#CRLF$+"2=letter in word not at position and not"+#CRLF$+" identified elsewhere unless multiples"+
#CRLF$+"3=letter anywhere in word"
ColorBack1=$ECFCFA ;Background color light yellow
ColorBack2=$FDF0E5 ;Background color light blue
ColorBack3=$F0DC0C ;Background color med blue
If ReadFile(#Readit,ReadFile$)
WordCount=0
While Eof(#Readit) = 0
t$=ReadString(#Readit)
If Mid(t$,1,1)<>" "
WordCount=WordCount+1
wordtext$(WordCount)=t$
EndIf
Wend
CloseFile(#Readit)
Else
MessageRequester("", "Couldn't read word file", #PB_MessageRequester_Ok)
EndIf
ExamineDesktops()
Windowsize=(DesktopWidth(0)-1000)/2
OpenWindow(#Win1,Windowsize, 50, 1000, 600,"", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
SetWindowColor(#Win1,ColorBack1)
CreateMenu(#Menu1, WindowID(#Win1))
MenuTitle("File")
MenuItem(1, "Reshow Directions"):MenuItem(2, "Save Result"):MenuItem(3, "Quit")
DisableMenuItem(#Menu1,2,1)
font1=LoadFont(#PB_Any, "arie1",14) ;use fonts with unicode
font2=LoadFont(#PB_Any, "Courier New",10)
font3=LoadFont(#PB_Any, "ariel",10)
font4=LoadFont(#PB_Any, "ariel",12)
;Draw Title Page
TextGadget(#Title,385,5,200,50,"Jeff's Wordle Helper",#PB_Text_Center)
SetGadgetFont(#Title,FontID(font1)):SetGadgetColor(#Title,#PB_Gadget_BackColor,ColorBack1)
ButtonGadget(#Search,600,80,80,30,"Search"): SetGadgetColor(#Search,#PB_Gadget_FrontColor,ColorBack1): SetGadgetFont(#Search,FontID(font4))
ButtonGadget(#Clear,735,80,90,30,"Clear Inputs"): SetGadgetColor(#Clear,#PB_Gadget_BackColor,ColorBack1): SetGadgetFont(#Clear,FontID(font4))
CheckBoxGadget(#CBox1,600,450,15,15,""):TextGadget(#Nhits,625,450,125,25,"Show Number of Hits"): SetGadgetColor(#Nhits,#PB_Gadget_BackColor,ColorBack1)
CheckBoxGadget(#CBox2,600,470,15,15,""):TextGadget(#Words,625,470,125,25,"Show Hit Words"): SetGadgetColor(#Words,#PB_Gadget_BackColor,ColorBack1)
SetGadgetFont(#Nhits,FontID(font3))
SetGadgetFont(#Words,FontID(font3))
SetGadgetState(#CBox1,1)
SetGadgetState(#CBox2,1)
TextGadget(#test1,145,80,190,50,"Test Word (blank ok)")
SetGadgetColor(#test1,#PB_Gadget_BackColor,ColorBack1):SetGadgetFont(#test1,FontID(font1))
StringGadget(#test2, 330, 80, 120, 25,"",#PB_String_BorderLess)
SetGadgetColor(#test2,#PB_Gadget_BackColor,ColorBack3):SetGadgetFont(#test2,FontID(font1))
For a = 1 To 6
TextGadget(#Tbox1+a,50,80+50*a,80,50," Word "+Str(a))
SetGadgetColor(#Tbox1+a,#PB_Gadget_BackColor,ColorBack1):SetGadgetFont(#Tbox1+a,FontID(font1))
TextGadget(#Tbox2+a,260,80+50*a,80,50," Result ")
SetGadgetColor(#Tbox2+a,#PB_Gadget_BackColor,ColorBack1):SetGadgetFont(#Tbox2+a,FontID(font1))
StringGadget(#Wordbox+a, 130, 80+50*a, 120, 25,"",#PB_String_BorderLess)
SetGadgetColor(#Wordbox+a,#PB_Gadget_BackColor,ColorBack3):SetGadgetFont(#Wordbox+a,FontID(font1))
StringGadget(#Resultbox+a, 330, 80+50*a,120, 25,"",#PB_String_BorderLess)
SetGadgetColor(#Resultbox+a,#PB_Gadget_BackColor,ColorBack3):SetGadgetFont(#Resultbox+a,FontID(font1))
Next
SetGadgetText(#Wordbox+1,"caret")
SetGadgetText(#Wordbox+2,"solid")
TextGadget(#Rinfo,330,430,250,200,Resultinfo$)
SetGadgetFont(#Rinfo,FontID(font3)): SetGadgetColor(#Rinfo,#PB_Gadget_BackColor,ColorBack1)
TextGadget(#Winfo,130,430,180,200," Word Inputs"+#CRLF$ +"a to z or ?" +#CRLF$+"?=ignore this position")
SetGadgetFont(#Winfo,FontID(font3)): SetGadgetColor(#Winfo,#PB_Gadget_BackColor,ColorBack1)
TextGadget(#Info, 500,415,420,20,"",#PB_Text_Center)
SetGadgetFont(#Info,FontID(font3)):SetGadgetColor(#Info,#PB_Gadget_BackColor,ColorBack1)
SetGadgetColor(#Info,#PB_Gadget_FrontColor,$6401CF)
EditorGadget(#Display, 500, 130,420,275,#PB_Editor_ReadOnly|#PB_Editor_WordWrap)
SetGadgetFont(#Display,FontID(font3)): SetGadgetColor(#Display,#PB_Gadget_BackColor,ColorBack2)
SetGadgetText(#Display,directions$)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow
End
EndIf
If Event = #PB_Event_Menu
Select EventMenu()
Case 1
ClearGadgetItems(#Display)
SetGadgetFont(#Display,FontID(font3))
SetGadgetText(#Display,directions$)
Case 2
CreateFile(#Writeit,StoreFile$)
For i=1 To WordsToGuess
WriteStringN(#Writeit,Guessword$(i)+" "+GuessResult$(i)+" "+RSet(Str(NumWords(i)),4))
Next
WordsPerLine=0: outtext$=""
If FoundCount>0
For i=1 To FoundCount
outtext$=outtext$+" "+FoundText$(i) ;construct output line
WordsPerLine=WordsPerLine+1
If WordsPerLine=10 ;output line of text after ten words
WriteStringN(#Writeit,outtext$)
WordsPerLine=0
outtext$=""
EndIf
Next
If WordsPerLine>0 ;if left over words, output
WriteStringN(#Writeit,outtext$)
EndIf
Else
WriteStringN(#Writeit,"No words found")
EndIf
CloseFile(#Writeit)
SetGadgetText(#Info,"Data written to file: "+StoreFile$)
Case 3
End
EndSelect
EndIf
If Event = #PB_Event_Gadget
BadInput=0
Select EventGadget()
Case #Search
SetGadgetText(#Info,""):ClearGadgetItems(#Display)
SetGadgetFont(#Display,FontID(font2))
SetGadgetColor(#Display,#PB_Gadget_FrontColor,#PB_Default)
For i=1 To 6 ;Get inputs
Guessword$(i)=LCase(GetGadgetText(#Wordbox+i))
GuessResult$(i)=GetGadgetText(#Resultbox+i)
Next
LengthofWords=Len(Guessword$(1)) ;Check for valid input for first word
If LengthofWords<3
SetGadgetText(#Info," Error, first word must be more than two letters long")
BadInput=1
Else
For Position=1 To LengthofWords
If FindString("abcdefghijklmnopqrstuvwxyz?",Mid(Guessword$(1),Position,1))=0
SetGadgetText(#Info," Only a-z and ? allowed for guessword")
BadInput=1
EndIf
Next
EndIf
If BadInput=0
For j=2 To 7 ;Check for valid input for rest of words
If Guessword$(j)=""
WordsToGuess=j-1
Break
ElseIf Len(Guessword$(j))<>LengthofWords
SetGadgetText(#Info," Word "+Str(j)+" must be same length as first word")
BadInput=1
Break
Else
For Position=1 To LengthofWords
If FindString("abcdefghijklmnopqrstuvwxyz?",Mid(Guessword$(j),Position,1))=0
SetGadgetText(#Info," Only a-z and ? allowed for guessword "+Str(j))
BadInput=1
Break
EndIf
Next
EndIf
Next
EndIf
If BadInput=0
ltest$=GetGadgetText(#test2) ;if have a testword, fill-in results
If Len(ltest$)>0
If Len(ltest$)=LengthofWords ;see if valid
For Position=1 To LengthofWords
If FindString("abcdefghijklmnopqrstuvwxyz",Mid(ltest$,Position,1))=0
SetGadgetText(#Info," Only a-z allowed for testword")
BadInput=1
Break
EndIf
Next
If BadInput=0
For j=1 To WordsToGuess ;construct result words
Result$=""
Letter_to_Test$=GetGadgetText(#test2)
For Position=1 To LengthofWords
letter$=Mid(Guessword$(j),Position,1)
If Mid(ltest$,Position,1)=Mid(Guessword$(j),Position,1) ;letter match
Result$=Result$+"1"
Letter_to_Test$=ReplaceString(ltest$,letter$,"$",#PB_String_NoCase,1,1) ;prevent further matches
Else
Result$=Result$+"0" ;set "0" as default
EndIf
Next
For Position=1 To LengthofWords
If Mid(Result$,Position,1)="1" ;ignore if found here
Continue
EndIf
letter$=Mid(Guessword$(j),Position,1) ;is letter
If FindString(ltest$,letter$)>0 ;is letter in word (not here as $ put in above)
Result$=ReplaceString(Result$,"0","2",#PB_String_NoCase,Position,1)
EndIf
Next
GuessResult$(j)=Result$
SetGadgetText(#Resultbox+j,Result$)
Next
EndIf
Else
SetGadgetText(#Info,"Wrong length test word")
BadInput=1
EndIf
EndIf
If BadInput=0
For j=1 To WordsToGuess ;check result words are valid
If Len(GuessResult$(j))<>LengthofWords
SetGadgetText(#Info," Result "+Str(j)+" must be same length as first word")
BadInput=1
Break
Else
For Position=1 To LengthofWords
If FindString("0123",Mid(GuessResult$(j),Position,1))=0
SetGadgetText(#Info," Only 0,1,2,3 allowed for result "+Str(j)+" input")
BadInput=1
Break 2
EndIf
Next
EndIf
Next
EndIf
If BadInput=0 ;if input valid, search
FoundCount=0
For Guessword=1 To WordsToGuess
NumWords(Guessword)=0
Next
For WordtoCheck=1 To WordCount
found=1
text$=wordtext$(WordtoCheck)
If Len(text$)=LengthofWords ;only words of correct length
For Guessword=1 To WordsToGuess
For Position=1 To LengthofWords
letter$=Mid(Guessword$(Guessword),Position,1)
If letter$="?"
Continue
EndIf
Select Mid(GuessResult$(Guessword),Position,1)
Case "0" ;letter not in word or already found somewhere else
fs= FindString(text$,letter$)
If fs>0
If Mid(text$,fs,1)<>Mid(Guessword$(Guessword),fs,1) Or Mid(text$,Position,1)=letter$
found=0
Break
EndIf
EndIf
Case "1" ;letter in position
If Mid(text$,Position,1)<>letter$
found=0
Break
EndIf
Case "2" ;letter in word, but not in position
If CountString(text$,letter$)=0 Or Mid(text$,Position,1)=letter$
found=0
Break
EndIf
Case "3" ;letter in word
If CountString(text$,letter$)<CountString(Guessword$(Guessword),letter$)
found=0
Break
EndIf
EndSelect
Next
If found=0
Break
Else
NumWords(Guessword)=NumWords(Guessword)+1 ;count for each guessword
EndIf
Next
If found=1 ;count and save for all guesswords
FoundCount=FoundCount+1
FoundText$(FoundCount)=text$
EndIf
EndIf
Next
DisableMenuItem(#Menu1,2,0) ;now have something to store if wanted
ClearGadgetItems(#Display) ;Display number of words
If GetGadgetState(#CBox1)=1 ;if wanted
For Guessword=1 To WordsToGuess
AddGadgetItem(#Display,-1,RSet(Str(NumWords(Guessword)),4)+" Words for guess "+Str(Guessword))
Next
EndIf
If GetGadgetState(#CBox2)=1 ;show/hide found words
WordsPerLine=0: outtext$=""
AddGadgetItem(#Display, -1, outtext$)
If FoundCount>0
For i=1 To FoundCount
outtext$=outtext$+" "+FoundText$(i) ;construct output line
WordsPerLine=WordsPerLine+1
If WordsPerLine=5 ;output line of text after five words
AddGadgetItem(#Display, -1, outtext$)
WordsPerLine=0
outtext$=""
EndIf
Next
If WordsPerLine>0 ;if left over words, output
AddGadgetItem(#Display, -1, outtext$)
EndIf
Else
AddGadgetItem(#Display, -1,"No words found")
EndIf
EndIf
EndIf
EndIf
Case #Clear
SetGadgetText(#test2,"")
SetGadgetText(#Info,"")
For i=1 To 6
SetGadgetText(#Wordbox+i,"")
SetGadgetText(#Resultbox+i,"")
Next
EndSelect
EndIf
ForEver