Wordle puzzle game in TCL by FrBa, based on the popular online game found on 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.
#!/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_gamekpv - 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.