Wordle puzzle game in TCL by [FrBa], based on the popular online game found on http://www.powerlanguage.co.uk/wordle%|%Wordle%|%web site and mobile app.

A game similar to Mastermind, but with a five letter word as the hidden solution. The player has six guesses to solve the puzzle. Correct letters in the correct position are highlighted in green, correct letters in the incorrect position are highlighted in yellow. Unmatched letters are a dark gray.

The script needs an external word dictionary words.txt that is not included here. This can be found online or from most any linux system at path /usr/share/dict/linux.words

----

[Jeff Smith] 2022-01-23 : Below is an online demo using [CloudTk]. This demo runs "Wordle" in an Alpine Linux Docker Container. It is a 27.7MB image which is made up of Alpine Linux + tclkit + Wordle.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories. 

<<inlinehtml>>

<iframe height="500" width="325" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=Wordle" allowfullscreen></iframe>

<<inlinehtml>>

----

======
#!/bin/sh
# \
exec wish "$0" "$@"

if 0 {
Wordle in TCL/TK, based on web game found at url www.powerlanguage.co.uk/wordle
started 2022-01-16 Frank Bannon
updated 2022-01-21 FB
six guesses of five-letter word
correct guess letter and position turns green
correct guess of letter but wrong position turns yellow
keyboard input shows unused letters dark, used letters green
word dictionary can be found on Linux under /usr/share/dict/linux.words
guessed word must be in word list to be accepted, no random letters accepted
Future updates to add:
flip animation on letters
add hints if selected
add Share button to hide letters but keep colors
add random compliment to each guess level
add Hard mode to force use of partial correct letters on later guesses
}

#catch {console show}

# global variables
array set var {
        wordlen 5
        guesses 6
        font_guess {Arial 30}
        font_keyboard {Arial 18}
        file_words words.txt
        delay 300
        word ""
}
# guesses
array set table {}
# colors
array set color {
        font white
        new gray70
        match green3
        close yellow3
        no gray40
        bg gray20
}

# prefer widgets to canvas
wm title . "TclWordle v0.4 by Frank Bannon 2022-01-21"
#catch {wm iconbitmap . -default wordle.ico}
wm resizable . 0 0
. configure -bg $color(bg)
# create the board of empty guesses
for {set row 1} {$row <= $var(guesses)} {incr row} {
        grid rowconfigure . $row -pad 8
        for {set col 1} {$col <= $var(wordlen)}  {incr col} {
                grid columnconfigure . $col -pad 8
                label .${row}_$col -textvariable table($row,$col) -width 2 \
                        -bg $color(new) -fg $color(font) -font $var(font_guess) \
                        -justify center -relief flat
                grid .${row}_$col -row $row -column $col
        }
}
label .status -bg $color(bg) -fg $color(font) -font $var(font_keyboard)
grid .status -column 1 -columnspan $var(wordlen)
# create the keyboard at bottom
frame .key -border 0 -bg $color(bg)
grid .key -column 1 -columnspan $var(wordlen)
# QWERTY LAYOUT, must find a better method
set row 1
set col 1
foreach k {Q W E R T Y U I O P} {
        label .key.k$k -text $k -width 2 -bg $color(new) -fg $color(font) \
                -font $var(font_keyboard) -justify center -relief flat
        grid .key.k$k -row $row -column $col -padx 2 -pady 1
        incr col
}
incr row
set col 1
foreach k {A S D F G H J K L} {
        label .key.k$k -text $k -width 2 -bg $color(new) -fg $color(font) \
                -font $var(font_keyboard) -justify center -relief flat
        grid .key.k$k -row $row -column $col -padx 2 -pady 1
        incr col
}
incr row
set col 1
foreach k {Z X C V B N M} {
        label .key.k$k -text $k -width 2 -bg $color(new) -fg $color(font) \
                -font $var(font_keyboard) -justify center -relief flat
        grid .key.k$k -row $row -column $col -padx 2 -pady 1
        incr col
}

button .key.new -text New -command new_game -bg $color(bg) -fg $color(font)
grid .key.new -row $row -column 9 -columnspan 2 -sticky e

# read the raw word dictionary, save only words of length 5
# could create a custom dictionary of only desired words
proc read_dict {args} {
        global var words dict_size
        set dict_size 0
        set whole_size 0
        set words {}
        if {[catch {set fid [open $var(file_words) r]} result]} {
                set msg "Dictionary file $var(file_words) not found."
                puts $msg
                tk_messageBox -default ok -icon error -type ok \
                -message $msg -title "Error reading word dictionary"
                exit
        } else {
                puts "Reading dictionary file $var(file_words)"
                catch {. configure -cursor watch}
                update
                while {[gets $fid word] > -1} {
                        # discard blank lines
                        if {[string length $word] < 1} {continue}
                        incr whole_size
                        # discard words of unneeded length
                        if {[string length $word] != $var(wordlen)} {continue}
                        # discard pronouns
                        if {[string is upper [string index $word 0]]} {continue}
                        # discard numbers and non-letter symbols
                        if {![string is alpha $word]} {continue}
                        # repeat letters are allowed in words
                        # discard words with repeated letters, compare unique chars wih word length
                #        if {[llength [lsort -unique [split $word ""]]] != [string length $word]} {continue}
                        # save word to list
                        lappend words $word
                        incr dict_size
                }
                puts "$whole_size words in dictionary file $var(file_words)"
                puts "$dict_size words of length $var(wordlen)"
                catch {. configure -cursor {}}
                close $fid
        }
        analyze
}
# analyze word database
proc analyze {args} {
        global words freq
        if {![info exists words]} {
                puts "No words database found."
                return
        }
        # overall data
        set numwords [llength $words]
        puts "Word database:"
        puts [format "%-10d %s" $numwords Words]
        puts "Top letters in each position:"
        array set c {}
        foreach word $words {
                set col 1
                foreach char [split $word ""] {
                        if {![info exists c($col,$char)]} {set c($col,$char) 1} else {incr c($col,$char)}
                        incr col
                }
        }
        catch {array unset freq}
        array set freq {}        
        for {set col 1} {$col <= [string length $word]} {incr col} {
                set data [lsort -decreasing -index 1 -dict -stride 2 [array get c $col,*]]
                foreach {l n} $data {
                        set l [lindex [split $l ,] end]
                        lappend freq($col) $l
                }
        }
        parray freq
}
# save reduced list of acceptable words
proc save_words {args} {
        global var words
        set fid [open $var(file_words) w]
        foreach w $words {if {[string length $w] > 1]} {puts $fid $w}}
        close $fid
        puts "wrote [llength $words] words to $var(file_words)"
}
# user enters guess, make uppercase on input, display on input
bind . <Key> {add_input %K}
bind . <Return> check

proc status {str} {
        if {[string length $str]} {puts $str}
        catch {.status configure -text $str}
}

proc add_input {str} {
        global var row col table
        # check if game over
        if {$row > $var(guesses)} {return}
        set str [string trim [string toupper $str]]
        # remove a character
        if {($str == "BACKSPACE" ) || ($str == "DELETE")} {
                if {$col < 2} {return}
                incr col -1
                set table($row,$col) ""
                return
        }
        if {$col > $var(wordlen)} {return}
        # special char
        if {[string length $str] > 1} {return}
        # extra chars are discarded
        if {$col > $var(wordlen)} {return}
        if {![string is alpha $str]} {return}
        status ""
        # display
        set table($row,$col) $str
        incr col
}

# check guess against hidden word
proc check {args} {
        global var row col table color words
        # check if game over
        if {$row > $var(guesses)} {return}
        # check last entry in row is filled
        if {[string length $table($row,$var(wordlen))] < 1} {return}
        # check guess is a valid word, not random letters
        set word ""
        # grab guess letters and construct a word
        for {set col 1} {$col <= $var(wordlen)} {incr col} {
                append word $table($row,$col)
        }
        if {[lsearch $words [string tolower $word]] < 0} {
                # clear guess
                for {set col 1} {$col <= $var(wordlen)} {incr col} {
                        set table($row,$col) ""
                }
                set col 1
                status "$word not a valid guess"
                return
        }
        # check letters against hidden word
        set match 0
        for {set col 1} {$col <= $var(wordlen)} {incr col} {
                # mark with colors
                # slow animated so user can follow
                after $var(delay)
                set char $table($row,$col)
                if {[string match $char [string index $var(word) $col-1]]} {
                        incr match
                        .${row}_$col configure -bg $color(match)
                        .key.k$char configure -bg $color(match)
                } elseif {[string first $char $var(word)] > -1} {
                        .${row}_$col configure -bg $color(close)
                        .key.k$char configure -bg $color(close)
                } else {
                        .${row}_$col configure -bg $color(no)
                        .key.k$char configure -bg $color(no)
                }
                update idletasks
        }
        status "Guess #$row $word"
        if {$match == $var(wordlen)} {
                # win
                status "WIN in $row guesses!"
                # prevent further play
                set row $var(guesses)
        } else {
                # game continues
                if {$row > $var(guesses)} {status "GAME OVER, the word was $var(word)"}
        }
        incr row
        set col 1        
}

proc random {{num 10}} {return [expr {int(rand() * $num)}]}
# new game
proc new_game {args} {
        global var row col table color words freq
        status "New Game"
        # select random word
        set num [random [llength $words]]
        set var(word) [string toupper [lindex $words $num]]
        puts "word is number $num in words list"
        # clear the board
        for {set row 1} {$row <= $var(guesses)} {incr row} {
                for {set col 1} {$col <= $var(wordlen)}  {incr col} {
                        set table($row,$col) ""
                        .${row}_$col configure -bg $color(new)
                }
        }
        # clear the keyboard
        foreach w [winfo children .key] {$w configure -bg $color(new)}
        .key.new configure -bg $color(bg) -fg $color(font)
        set row 1
        set col 1
}

read_dict
new_game
======
----
'''[kpv] - 2022-01-23 05:00:21'''

I have a question about game play. Suppose the hidden word is "SNEER" and my guess is "TEPEE", what should the result be? One "E" is correct, another "E" is in the wrong place but how should the third "E" be marked? There is no "correct" answer: this program highlights it as misplaced but I could see how that could imply there are three "E" in the answer and so instead mark it as wrong. Do you know how the original behaves?

[KPV] Follow up: On 2022-02-01 on the official Wordle page, the hidden word was "THOSE". My first guess was "BREED" and the score was one miss on the first "E". This differs from the score this program gives: two misses on both "E"s.

[FrBa] offers an explanation for the behavior. This code was written in just one day, the result of a challenge to replicate the online web game. During the coding I was not aware the game allowed words with duplicate letters. I didn't want to prepare a complete word dictionary, but instead reuse my word dictionary of over 450,000 words. I put some filters in the dictionary read process to remove unwanted words. The resulting word set included no words with repeated letters, so this condition was not discovered during play testing. Thank you for the discovery. I will need to modify the check algorithm to properly mark reused letters.
Future efforts will add more features of the online game such as the Hard mode that forces use of misplaced letters in subsequent guesses. I also intend to provide hints on what letter is most likely in each position, with improvements to the analyze function.