PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Wordle and othe word game helper

https://www.purebasic.fr/english/viewtopic.php?t=78969

Page 1 of 1

Wordle and othe word game helper

Posted: Sat Apr 09, 2022 6:26 pm
by Jeff8888
Like many of you, I started playing "Wordle." I decided to write a program to help to play it. Although I can usually guess the word in three to four guesses without the program. I use it mainly for curiousity to see number of potential answers for given guess words. It also can be used for other word games such as acrostics (using option 3, see program). This version has a user interface. Feel free to change. Only tested on Windows OS.

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
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited