... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... no changes ... Welcome!!! Links: car insurance : [http://www.insurance-top.com auto insurance] - [HTTP://www.insurance-top.com auto insurance] : [Insurance car|http://www.insurance-top.com] - [Insurance car|HTTP://www.insurance-top.com] : http://www.insurance-top.com/auto/ : [[http://www.insurance-top.com insurance quote]] : [[http://www.insurance-top.com | home insurance]] : "cars insurance" http://www.insurance-top.com : [http://www.insurance-top.com|insurance auto] [Keith Vetter] 2003-11-11 : Here's a fun little anagram game. It scrambles and displays
the letters of a 6-letter word, and you have to find all 3, 4, 5 and 6 letter words that
can be created from those letters within a time limit.
You can play the game either with a mouse--click on a letter to select it, right-click
to undo, click on buttons as needed--or with the keyboard (see help for details).
'''Word List''': ''Word Jumble'' has built into it a small 1,200 word list that should
suffices for a short while. I also have a larger 15,000 word list of just 3-6 letter
words but thought its 100k size was too big for a Wiki page (although such a resource
I find quite valuable). Instead, you can download the word list from [http://www.klimb.org/tcl/wordlist36.eng] (just name it "wordlist36.eng" and save
it in the same directory as this code). Actually you can any word list that you may
have (in any language) as long as the data is parsable with ''foreach''.
----
[KPV] 2004-04-20 : Alas, Google found my wordlist web site and now that page is getting lots
of bogus hits--my page contains all the words in the query so it comes up often.
It's kind of interesting (in a sick way) to see what some people are
searching for, such as "''free men seducing there (pet doges) links''". Anyway, I renamed
the wordlist file and instructed the various crawlers to ignore it so the problem
should go away.
One consequences is that I had to update the code to know about the new wordlist
file name, and while I was at it I added two new features: '''auto plural''' -- when you
enter a word, it will also check for that word with an "''S''" appended is also valid; and
'''Three letter words''' -- you can chooses whether to include 3-letter words in the
list of anagrams--see '''LES''''s comment below.
----
[LES]: Cool. I used to have that game in a Franklin handheld dictionary and wasted many hours of my life playing it. Now I wish the code provided a more straightforward method for determining the minimum and maximum length of the words. In my experience, 3 is not a good minimum because it generates too many words that make you go "heck, I'd '''never''' have thought of that". A bit too frustrating, I mean.
----
Frank Bannon: I wrote a Word Search script that is similar to this one. It uses an external text file of over 100,000 words. The word list was generated in Red Hat Linux 9 using the command:
aspell dump master | sort > words.txt
The script and the word list are available for download from [http://www.geocities.com/frankbannon/].
----
##+##########################################################################
#
# Word Jumble
# http://www.gamehouse.com/affiliates/template.jsp?AID=1406
# by Keith Vetter, November 2003
#
# BUGS: palest & prates overflow display area
# TODO: pause, help about left click & double click, click on up letter
# 2004-04-20: added auto plural, three letter & wordlist36.eng
#
package require Tk
set S(title) "Word Jumble"
set S(lm) 20 ;# Left margin
set S(sp) 20 ;# Word spacing
set S(state) 1
set S(color) #248c7c
set S(wordlist) "wordlist3_6.eng"
set S(wordlist2) "wordlist36.eng"
set S(autoPlural) 1
set S(three) 1
array set S {score,3 90 score,4 160 score,5 250 score,6 1360}
proc DoDisplay {} {
global S
wm title . $S(title)
foreach font [font names] { font delete $font }
font create bigFont -family Times -size 24
font create midFont -family Times -size 18
font create smallFont -family Times -size 12
font create tinyFont -family Helvetica -size 8 -weight bold
font create scoreFont -family Times -size 12 -weight bold
catch {font config scoreFont -family {Monotype Corsiva} -weight bold -size 14}
set S(cell) [expr {[font measure bigFont "W"] + 10}]
set S(cell2) [expr {$S(cell) / 2}]
menu .m -tearoff 0
. configure -menu .m
.m add cascade -menu .m.game -label "Game" -underline 0
.m add cascade -menu .m.help -label "Help" -underline 0
menu .m.game -tearoff 0
.m.game add checkbutton -label "Three letter words" -variable S(three)
-command Three
.m.game add checkbutton -label "Auto Plurals" -variable S(autoPlural)
.m.game add separator
.m.game add command -label "End Round" -command [list EndRound "gaveup"]
.m.game add separator
.m.game add command -label "Exit" -command exit -underline 1
menu .m.help -tearoff 0
.m.help add command -label "Help" -command Help
.m.help add separator
.m.help add command -label "About" -command About
canvas .c -width 770 -height 380
.c create rect -100 -100 1000 1000 -tag scrim -fill $S(color)
pack .c -fill both -expand 1
frame .f -bg $S(color)
button .doit -text "End Word" -padx 3 -pady 5 -command EndWord
.doit configure -font "[font actual [.doit cget -font]] -size 10"
option add *Button.font [.doit cget -font]
button .clear -text "Clear" -padx 3 -pady 5 -command Clear
button .jumble -text "Jumble" -padx 3 -pady 5 -command Jumble
button .bgiveup -text "End Round" -padx 3 -pady 5
-command [list EndRound "gaveup"]
set x 250 ; set y 10
.c create text $S(lm) $y -tag title -font scoreFont -fill white -anchor nw
-text "Word
Jumble"
.c create text $x $y -tag score -font scoreFont -anchor nw -fill white
foreach {x0 y0 x1 y1} [.c bbox score] { set dy [expr {$y1 - $y0}] }
incr y $dy
.c create text $x $y -tag round -font scoreFont -anchor nw -fill white
incr y $dy
.c create text $x $y -tag time -font scoreFont -anchor nw -fill white
.c create text 180 200 -tag msg -fill red -font midFont
set x1 [expr {$S(lm) + $S(cell2)}] ;# Random letter row
set y1 260
set x2 [expr {$S(lm) + $S(cell2)}] ;# Selected letter row
set y2 150
for {set n 0} {$n < 6} {incr n} {
set xy [box $x1 $y1 $S(cell2)]
.c create rect $xy -fill black -tag [list l l$n s$n]
.c move s$n -7 7
.c create rect $xy -fill [GetColor] -outline black -tag [list l l$n r$n]
.c create text $x1 $y1 -font bigFont -tag [list l l$n t$n]
.c bind l$n [list DoClick $n]
# Row where selected letters go
set xy [box $x2 $y2 $S(cell2)]
.c create rect $xy -fill cyan -outline white -width 3 -tag [list b b$n]
.c create text $x2 $y2 -font bigFont -tag [list b b$n bt$n]
incr x1 [expr {$S(cell) + $S(sp)}]
incr x2 [expr {$S(cell) + 5}]
}
set x [lindex [.c bbox l] 2]
set S(rm) [expr {$x + $S(lm)}]
.c create line $S(rm) -100 $S(rm) 1000
.c create window [expr {$x+5}] 345 -window .f -tag window -anchor e
pack .jumble .clear .doit .bgiveup -in .f -side left -padx 2
bind all Do3Click
bind all [list KeyPress %A %K]
.c bind scrim EndWord
# Debugging bindings
bind .c {puts "point %x %y"}
bind all {console show}
bind .doit {if {$S(state) == 0} {set ::S(time) 10}}
bind .clear {FillGrid 0}
trace variable S(score) w Tracer
trace variable S(time) w Tracer
trace variable S(round) w Tracer
}
# KeyPress - handle all keypresses, filtering out what we want
proc KeyPress {char sym} {
global L B W S
if {$S(state) != 0} return
if {$sym == "Return"} { ;# Return == EndWord
if {$B(end) == 0 && $W(last) != ""} {
set chars [split [string toupper $W(last)] ""]
} else {
if {$B(end) >= [expr {$S(three) ? 3 : 4}]} EndWord
return
}
} elseif {$sym == "BackSpace" || $sym == "Delete"} { ;# Backspace == undo
Do3Click
return
} elseif {$sym == "space"} { ;# Space == jumble
Jumble
return
} elseif {$sym == "Escape" || $char == "�"} {
Clear
return
} elseif {$char == "�"} { ;# Ctrl-S
if {$B(end) != 0 || $W(last) == ""} return
set n1 [regsub -all {s} $W(last) {s} .]
set n2 [regsub -all {s} $W(word) {s} .]
if {$n2 <= $n1} return
set chars [split [string toupper $W(last)] ""]
lappend chars "S"
} else {
set chars [string toupper $char] ;# Find first matching letter
}
# Chars is the list of characters to put up
foreach char $chars {
for {set i 0} {$i < 6} {incr i} { ;# Find which tile it is
if {$L($i,hid) == 1} continue
if {$L($i) == $char} {
DoClick $i
break
}
}
}
}
##+##########################################################################
#
# NewGame -- starts a new games, resetting score and round
#
proc NewGame {} {
set ::S(score) 0
set ::S(round) 0
NewRound
}
proc NewRound {{word {}}} {
global S
PickWord $word ;# Pick word to play with
ShowWord ;# Create its letters
MakeGrid ;# And its answer grid
set S(state) 0 ;# Play mode
set S(time) 120 ;# Time remaining
set S(timer,last) 0
incr S(round)
Warn ""
Timer ;# Start the clock
}
##+##########################################################################
#
# EndRound -- handles when time is up or all words are found.
#
proc EndRound {{how ""}} {
global S W
Timer 1 ;# Be safe and turn off timer
Clear ;# Return all letters
set S(state) 1 ;# Disable all interactions
FillGrid 0 ;# Show answers
if {$how eq "three"} {
Dialog 6
NewGame
return
}
set got6 0 ;# Did we get a 6 letter word
foreach word $W(found) {
if {[string length $word] == 6} {
set got6 1
break
}
}
if {[llength $W(found)] == $W(cnt)} { ;# Got all the words
incr S(score) 3000
Dialog 1
} elseif {$got6} { ;# Timed out, but next round
Dialog 2
} else { ;# Game over
Dialog [expr {$how eq "gaveup" ? 5 : 3}]
NewGame
return
}
NewRound
}
##+##########################################################################
#
# Tracer -- variable trace to update display of score, time and round
#
proc Tracer {var1 var2 op} {
global S
if {$var1 != "S" && $var1 != "::S"} return
switch $var2 {
score {.c itemconfig score -text "Score: [comma $::S(score)]"}
time {
set s [clock format $::S(time) -format "%M:%S"]
set fill [expr {$::S(time) < 10 ? "red" : "white"}]
.c itemconfig time -text "Time: [string range $s 1 end]" -fill $fill
}
round {.c itemconfig round -text "Round: $::S(round)"}
}
}
##+##########################################################################
#
# ShowWord -- puts current word into the letter squares
#
proc ShowWord {} {
global W L B S
.c raise l ;# Make word visible
for {set i 0} {$i < 6} {incr i} {
set L($i) [string toupper [string index $W(display) $i]]
set L($i,hid) 0
set L($i,up) -1
.c itemconfig t$i -text $L($i)
.c itemconfig r$i -fill [GetColor]
.c itemconfig bt$i -text {}
}
set B(end) 0
.doit config -state disabled
.clear config -state disabled
}
##+##########################################################################
#
# MakeGrid -- makes the boxes for the anagram words
#
proc MakeGrid {} {
global W S
.c delete grid
array unset GRID
set lines [split [Wrap $W(all) 23] "
"]
set cell [expr {[font measure tinyFont "m"] + 3}]
set cell2 [expr {$cell / 2}]
set blank $cell
if {[llength $lines] > 25} { set blank $cell2 }
set rm [expr {$S(rm) + $S(lm)/2 + $cell2}]
set y 20
set idx 0
foreach line $lines {
if {$line == {}} { ;# Blank line
incr y $blank
continue
}
set x $rm
foreach word $line {
foreach letter [split $word ""] {
set xy [box $x $y $cell2]
.c create rect $xy -fill white -outline black
-tag [list grid gb gb$idx]
.c create text $x $y -tag [list grid g$idx] -font tinyFont
incr idx
incr x $cell
}
incr x $cell2 ;# Interword spacing
}
incr y $cell
}
return
}
##+##########################################################################
#
# DoClick -- handles clicking on a letter
#
proc DoClick {who} {
global B L S
if {$S(state) != 0} return ;# Inactive
Warn ""
.c lower l$who ;# Make letter disappear
set L($who,hid) 1
set B($B(end)) $L($who)
set B($B(end),undo) $who
set L($who,up) $B(end)
.c itemconfig bt$B(end) -text $L($who) -fill black
incr B(end)
if {$B(end) >= [expr {$S(three) ? 3 : 4}]} {
.doit config -state normal
}
.clear config -state normal
}
##+##########################################################################
#
# Do3Click -- handles left click on a word which is undo
#
proc Do3Click {} {
global B L S
if {$S(state) != 0} return
Warn ""
if {$B(end) == 0} return
incr B(end) -1
set who $B($B(end),undo)
.c raise l$who ;# Make visible again
set L($who,hid) 0
#.c itemconfig b$B(end) -fill {}
.c itemconfig bt$B(end) -text ""
if {$B(end) < 3} {
.doit config -state disabled
}
if {$B(end) == 0} {
.clear config -state disabled
}
}
##+##########################################################################
#
# shuffle -- randomly shufffles a list
#
proc shuffle { list } {
set len [llength $list]
set len2 $len
for {set i 0} {$i < $len-1} {incr i} {
set n [expr {int($i + $len2 * rand())}]
incr len2 -1
# Swap elements at i & n
set temp [lindex $list $i]
lset list $i [lindex $list $n]
lset list $n $temp
}
return $list
}
##+##########################################################################
#
# PickWord -- randomly pick a word for this round
#
proc PickWord {{word {}}} {
global sixes W
array unset W
set W(found) ""
set W(last) ""
set W(word) $word
if {$word == {}} {
set n [expr {int (rand() * [llength $sixes])}]
set W(word) [lindex $sixes $n]
}
set tmp [split $W(word) ""]
set W(display) [join [shuffle $tmp] ""]
set W(ana) [join [lsort $tmp] ""]
BuildWordList
}
proc Three {} {
EndRound three
}
##+##########################################################################
#
# BuildWordList -- creates the master list of all legal subwords
#
proc BuildWordList {} {
global ANA W S
set subwords [subwords $W(ana)]
foreach n {3 4 5 6 all} {set W($n) {}; set W($n,cnt) 0}
foreach word $subwords {
if {! [info exists ANA($word)]} continue;# Not in our dictionary
set n [string length $word]
set W($n) [concat $W($n) $ANA($word)] ;# Handle duplicates later
}
set W(cnt) 0
if {! $S(three)} {
set W(3) {}
}
foreach n {3 4 5 6} {
set W($n) [lsort -unique $W($n)]
set W(all) [concat $W(all) $W($n)]
set W($n,cnt) [llength $W($n)]
incr W(cnt) $W($n,cnt)
}
}
##+##########################################################################
#
# MakeAnaDict -- creates our anagram dictionary from a word list file
#
proc MakeAnaDict {{fname ""}} {
global ANA sixes S
array unset ANA
set sixes {}
set data {}
if {$fname == ""} {
if {[file readable $S(wordlist)]} {
set fname $S(wordlist)
} elseif {[file readable $S(wordlist2)]} {
set fname $S(wordlist2)
} else {
set data $::ShortWordList
}
}
if {$fname != ""} {
set FIN [open $fname r]
set data [read $FIN]
close $FIN
}
foreach word $data {
set len [string length $word]
if {$len < 3 || $len > 6} continue
if {$len == 6} {lappend sixes $word}
set word2 [join [lsort [split $word ""]] ""]
lappend ANA($word2) $word
}
}
##+##########################################################################
#
# subwords -- returns list of all 3+ letter combinations of word
#
proc subwords {word} {
# Build up all possible subsets (as individual lists)
set subsets [list [list]]
foreach e [split $word ""] {
foreach subset $subsets {
lappend subsets [lappend subset $e]
}
}
# Turn subset lists into strings and filter out too short subsets
set subsets2 {}
foreach e $subsets {
if {[llength $e] < 3} continue
lappend subsets2 [join $e ""]
}
return $subsets2
}
##+##########################################################################
#
# EndWord -- handles when a user signals that a word is complete
#
proc EndWord {} {
global B W S
if {$S(state) != 0} return
set word ""
for {set i 0} {$i < $B(end)} {incr i} { ;# This is the user's word
append word $B($i)
}
set word [string tolower $word]
set n [lsearch $W(found) $word]
if {$n != -1} {return [Warn ""$word" used already"]}
set n [lsearch $W(all) $word]
if {$n == -1} {return [Warn "What is "$word"?"]}
Warn ""
set W(last) $word
incr S(score) $S(score,[string length $word])
set W(found) [concat $W(found) $word]
AutoPlural
FillGrid 1 ;# Show word in answer grid
Clear ;# Return letters back down
if {[llength $W(found)] == $W(cnt)} EndRound;# Did we find all the words?
}
proc AutoPlural {} {
global W S
if {! $S(autoPlural)} return
set n1 [regsub -all {s} $W(last) {s} .] ;# Number of "s" in current word
set n2 [regsub -all {s} $W(word) {s} .] ;# Number of "s" in jumble
if {$n2 <= $n1} return
set word "$W(last)s"
if {[lsearch $W(found) $word] != -1} return ;# Already used
if {[lsearch $W(all) $word] == -1} return ;# Bad word
# Here on a valid word
incr S(score) $S(score,[string length $word])
set W(found) [concat $W(found) $word]
}
proc Clear {} {
global B S
if {$S(state) != 0} return
while {$B(end) > 0} Do3Click ;# Put letter back down
}
##+##########################################################################
#
# Jumble -- rearranges the order of the letters. All up letter go to the end
#
proc Jumble {} {
global L B S
if {$S(state) != 0} return
set hid {}
set new {}
foreach i {0 1 2 3 4 5} {
if {$L($i,hid)} {
lappend hid $i
} else {
lappend new $i
}
}
set len [llength $new]
set new2 [shuffle [lrange {0 1 2 3 4 5} 0 [expr {$len - 1}]]]
set hid2 [shuffle [lrange {0 1 2 3 4 5} $len end]]
set l1 [concat $new $hid]
set l2 [concat $new2 $hid2]
foreach o $l1 n $l2 {
set LL($n) $L($o)
set LL($n,hid) $L($o,hid)
set LL($n,up) $L($o,up)
if {$L($o,hid)} { ;# Is this one selected
set B($L($o,up),undo) $n ;# Update its return location
}
.c itemconfig t$n -text $LL($n)
.c itemconfig r$n -fill [GetColor]
.c [expr {$LL($n,hid) ? "lower" : "raise"}] l$n
}
array set L [array get LL]
}
proc Wrap {words length} {
set result ""
set line ""
set len 0
foreach word $words {
set len2 [string length $word]
if {$len2 != $len} { ;# New width
if {$line != ""} { append line "
" }
append result $line "
"
set line ""
}
set len $len2
if {$line == ""} {
set line $word
} else {
set line2 "$line $word"
if {[string length $line2] > $length} {
append result $line "
"
set line2 $word
}
set line $line2
}
}
if {$line != ""} {
append result $line
}
return [string trim $result]
}
##+##########################################################################
#
# FillGrid -- shows all the words the user has either found or not found
#
proc FillGrid {found} {
if {$found} { ;# Want found list
set l [FoundList]
set fill white
} else {
set l [MissingList] ;# Want not found words
set fill yellow
}
set idx -1
foreach word $l {
foreach letter [split $word ""] {
incr idx
if {$letter == "?"} {
if {! $found} continue
set letter ""
}
.c itemconfig g$idx -text $letter
.c itemconfig gb$idx -fill $fill
}
}
}
##+##########################################################################
#
# FoundList -- merges the words the user has found w/ the complete list
# but unfound word's letters are replaced with question marks.
#
proc FoundList {} {
global W
foreach len {3 4 5 6} { set r($len) {}}
foreach word $W(found) {lappend r([string length $word]) $word}
foreach len {3 4 5 6} {
set r($len) [lsort $r($len)]
set n [expr {$W($len,cnt) - [llength $r($len)]}]
while {[incr n -1] >= 0} {
lappend r($len) [string repeat "?" $len]
}
}
return [concat $r(3) $r(4) $r(5) $r(6)]
}
##+##########################################################################
#
# MissingList -- like FoundList but w/ "?" for the found words
#
proc MissingList {} {
global W
foreach len {3 4 5 6} { set r($len) {}}
foreach word $W(found) {
set len [string length $word]
lappend r($len) [string repeat "?" $len]
}
foreach len {3 4 5 6} {
foreach word $W($len) {
if {[lsearch $W(found) $word] >= 0} continue
lappend r($len) $word
}
}
return [concat $r(3) $r(4) $r(5) $r(6)]
}
proc Missing {} {
global W
set result {}
foreach word $W(all) {
if {[lsearch $W(found) $word] == -1} {
lappend result $word
}
}
Wrap $result 60
}
proc GetColor {{v .7}} {
set light [expr {255 * $v}] ;# What we consider "light"
while {1} {
set r [expr {int (255 * rand())}]
set g [expr {int (255 * rand())}]
set b [expr {int (255 * rand())}]
if {$r > $light || $g > $light || $b > $light} break
}
return [format "#%02x%02x%02x" $r $g $b]
}
proc Warn {msg} {
.c itemconfig msg -text $msg
}
proc box {x y n} {
list [expr {$x - $n}] [expr {$y - $n}] [expr {$x + $n}] [expr {$y + $n}]
}
proc comma {num} {
while {[regsub {^([-+]?d+)(ddd)} $num "\1,\2" num]} {}
return $num
}
proc Timer {{off 0}} {
global S
foreach aid [after info] {after cancel $aid};# Be safe
if {$off} return
if {$S(state) != 0} return
set last $S(timer,last)
set S(timer,last) [clock seconds]
if {$last > 0} {
set delta [expr {$last - $S(timer,last)}]
incr S(time) $delta
if {$S(time) <= 0} { set S(time) 0 }
}
if {$S(time) <= 0} {
EndRound
} else {
after 1000 Timer
}
}
proc Dialog {type} {
array set msgs {
1,l1 "Congratulations!"
1,l2 "You got all the words
3,000 point bonus"
1,b "Next Round"
2,l1 "End of Round"
2,l2 "You qualify for the next round"
2,b "Next Round"
3,l1 " Game over "
3,l2 "Out of time"
3,b "New Game"
4,l1 "Click to start
new game"
4,l2 ""
4,b "New Game"
5,l1 " Game over "
5,l2 "You gave up"
5,b "New Game"
6,l1 " Game over "
6,l2 ""
6,b "New Game"
}
destroy .top
toplevel .top
wm geom .top +8888+8888
wm transient .top .
wm title .top $::S(title)
set col $::S(color)
set col2 [::tk::Darken $col 90]
.top config -bg $col
frame .top.top -bd 2 -relief ridge -bg $col
label .top.title -text "Word
Jumble" -font scoreFont -padx 10 -pady 10
-fg white -bg $col
label .top.l1 -text $msgs($type,l1) -font midFont -bg $col -padx 10
label .top.l2 -text $msgs($type,l2) -font smallFont -bg $col -padx 10
button .top.b -text $msgs($type,b) -command {destroy .top} -bg $col
-activebackground $col2 -highlightthickness 0 -default disabled
pack .top.top -side top -fill x
grid .top.title .top.l1 -in .top.top -sticky n
grid ^ .top.l2 -in .top.top
if {$msgs($type,l2) == ""} {destroy .top.l2}
pack .top.b -pady 10
if {$type == 4} {update idletasks}
CenterWindow .top
focus .top.b
tkwait window .top
}
##+##########################################################################
#
# CenterWindow -- places a toplevel window where we want it
#
proc CenterWindow {w} {
update idletasks
set wh [winfo reqheight $w] ; set ww [winfo reqwidth $w]
set sh [winfo height .] ; #set sw [winfo width .]
set sy [winfo y .] ; set sx [winfo x .]
set sw $::S(rm)
set x [expr {$sx + ($sw - $ww)/2}] ; set y [expr {$sy + ($sh - $wh)/2}]
if {$x < 0} { set x 0 } ; if {$y < 0} {set y 0}
wm geometry $w +$x+$y
}
proc About {} {
set m "$::S(title)
by Keith Vetter
November, 2003"
append m "
[llength $::sixes] words in the word list."
tk_messageBox -icon info -title "About $::S(title)" -message $m -parent .
}
proc Help {} {
catch {destroy .help}
toplevel .help
wm transient .help .
wm title .help "$::S(title) Help"
if {[regexp {(+[0-9]+)(+[0-9]+)$} [wm geom .] => wx wy]} {
wm geom .help "+[expr {$wx+$::S(rm)+20}]+[expr {$wy+35}]"
}
set w .help.t
text $w -wrap word -width 70 -height 21 -pady 10 -padx 5
button .help.quit -text Dismiss -command {catch {destroy .help}}
pack .help.quit -side bottom
pack $w -side top -fill both -expand 1
$w tag config header -justify center -font bold -foreground red
$w tag config header2 -justify center -font bold
set margin [font measure [$w cget -font] " o "]
set margin2 [font measure [$w cget -font] " o - "]
$w tag config header3 -lmargin2 $margin
$w tag config header3 -font "[font actual [$w cget -font]] -weight bold"
$w tag config n -lmargin1 $margin -lmargin2 $margin
$w tag config bold -font "[font actual [$w cget -font]] -weight bold"
-lmargin1 $margin -lmargin2 $margin
$w tag config indent -lmargin1 [expr {2*$margin}]
$w delete 1.0 end
$w insert end "Word Jumble" header "
by Keith Vetter
" header2
set m "The goal of the game is to form as many words possible from "
append m "the letters given. To advance to the next round you must form "
append m "at least one word using all the letters. Longer words score "
append m "more points and there's a bonus if you find all the words.
"
$w insert end "Overview
" header3 $m n
set m "Click on the letters to form words then press '''End Word'''. Click "
append m "the right button to undo. If "
append m "you get stuck, press '''Jumble''' to rearrangle the letters. You "
append m "can also use the keyboard to enter letters:
"
$w insert end "How to Play
" header3 $m n
$w insert end " '''Alpha''' - Enter that letter
" indent
$w insert end " '''Enter''' - Enter word or repeat last word
" indent
$w insert end " '''Backspace''' - Delete last letter
" indent
$w insert end " '''Esc''' - Clear
" indent
$w insert end " '''Space''' - Jumble
" indent
$w insert end " '''Ctrl-s''' - mystery
" indent
while {1} {
set n [$w search -count cnt -regexp {'''.*?'''} 1.0]
if {$n == ""} break
set txt [$w get $n "$n + $cnt chars"]
$w delete $n "$n + $cnt chars"
$w insert $n [string trim $txt "'"] bold
}
$w config -state disabled
}
set ShortWordList {
aba abbe abed able abuse ace aced aces acne acnes acorn act actor
actors acts acyl add adds ade adept ado ads age aged aging agley
ago ague aid aide ail ails aim air akin alb albs ale alee ales all
alley allot allots ally alms also alto alum amulet ana anas and
anise anode ant ante anted ants anus ape aped apt arc arcs are arm
arming art arts ascot ash ass assn ate atoll atolls aught august
aunt aunts auto awe awed awes awing awn axe axed aye baa babe bad
bade bald bale baled bales ball balled ban bane banner bantam bar
bare barn base bat batman bead bean bear beau beaus bed bee beef
beer beers bees beet beg begin begins begs being beings bell belt
belted bet betel big bin binge binges bingo bins blab blade bled
bleed blue blues bog bogs bole boles bone bong bonnie boo boom
booms boos bosom bosomy box boxing boy bra brae bran bus cad can
cane caned canes canoe canoed cans cant canto cantor car cars cart
carton carts case casein cast castor cat cats cavity cavy cay cays
cee cheep cheeps chi chin chink chinks chins city class classy
clay clays clog cloggy cloy coast coat coats cod coda code coed
cog col con cone contra corn cost cot cots coy crag craggy crier
criers cries cry dab dabble dad dads dale dam dame dance dart dash
date day deacon dead deal dealt dean deans debt deck dee deign
dell delta demo den dens dent dents dew dice dick dickey did die
died diet dig dike dim dimly dimply din dine ding dip dire dirt
dive diver divert diving doc dodo doe dome don done dope dory dot
dour dourly draw dried drip drive dry due duet duly duo durst dust
dusty duty dye ear earn east eat eats ebb edge edit eel eft efts
egad ego egos eke ekes elate elated elf ell ells elm elms ember
embers emit emu end ends entad eon era ere erg err errs eta etas
eve eves evoke evokes fee feeble feel fetor fie fir fire fires
firs first fist fit fits flee flex flu flue flues flux fluxes foe
foes for fore fores forest fort forte fortes forts foster free
fret frets fries fro frost fuel fuels fugue fugues fuse gad gag
gain gained gait gal gale gam game gamely gamin gamy gang gar gas
gate gaunt gay gee gel geld gels gem gene get giant gibe gibes gig
gilt gin gins girl girlie gleam glee glen glint glob globe globes
globs gnat gnaw gnu goat gob gobs goes gone got gout grain gram
gray grim grin grins gun gust gut guts gym had hag hah hale haled
halve halved hang has hash hast haste hat hate hates hath hating
hats haunt have haw hawed haws head heads heal heat heath heaths
heats held helium helm hem hen hens hep her hero hew hewing hewn
hews hex hexing hey hick hicks hie hies hilum him hinge hinges
hint his hit hoax hoaxed hod hoe hoed hoer hood hooded hot hue hug
hum hung hunt hut ice iced ices icy idea idly ifs ileum ill ills
imp imply impute incase inch ink inks inn ins ion ire ires iris
item its ivy jet jib jibing jig jitney jut jute jutted kayo kayoed
key kid kin king kiosk kiosks kiss kisses lab label labs lac lacy
lad lade ladle lag lain lam lame lass last late lately lave laved
lay lays lea lead leas led ledge lee leer leg legend legit legs
lei lend less let lid lie lien lieu lilt lilts lime limn limp limy
line ling lint lip list lists lit loam loams loan loans lob lobe
lobes lobs log loge loges logs logy lord lose lost lot lots loud
lube lubes lump lumps lust lute lye lyes lying mad made magi main
making male malt malty man mans manta mar margin mason mat mate
maul maw may mead meadow meal mealy meat meaty melt men meow meows
mere meres met metal mew mid mien mil mild mile min mine mingle
mink mite moan moans mob mobs mod mode mol mols mono moo moon moos
mop mope moped mopped mow mowed mule muss mute muzzle nab nag nail
nails nap nape naught neap near neat nebs nee need neigh neighs
neon nest net nets new nib nibs nice nick nicks nigh night nil
nine nip nit nix nod node non none nor not nth nun nuns nut nuts
oak oar oars oat oats obi ocean odd ode oft ogle ogles okay okayed
old ole once one onyx ore ores ort orts other our out outage over
overs owe owed oxen oxygen pad pan pane pant panted pat pate paten
pea peat pedant pee pees peg pelt pen pend pent pep per pert peso
pet pie pied pier pig piglet pile pin pip pippin pit pits pitter
plum plums plus ply pod poem pomp pompon poop pop pope pore pores
pose poser pride prided pried prose prove proves pry psi purist
pus puss put puts quilt quilts quit quits racy rag rain ram ran
rang rant rat rats raw ray red reds reef reel ref refit refits
reflex refs rend rends rent rents rep resift rest ret rets rev
revs rex rho rice rices rid ride rife rift rifts rig rigs rile rim
ring rings rip ripe rips rise riser rising rite rites rive rived
rivet road roan roast roc rocs rod roe roes rope ropes rose rot
rote rots rove roves row run runs runt runts rusk rust rusty rut
ruts rye sable sac sacs sad sadden sag sail sails sale salmon
salon salt sand sanded sane sans sat sate saw sawed say says scaly
scan scar scat scrota sea seal seat sedan see seek seem seep seer
self sell sells send sent sere serf serif servo set seta sew sex
shad shade shah shaw she sheath shed sheep shin shine sic sick
sift sifter sigh sign sill sills silt silts sin since sine sing
singe sink sins sip sir sire siring sis sisal sit site sits ski
skies skin skis slab slain slam slat slay slays slit slits slob
sloe slog slot slue slum slump slumps slums slut sly smell smelly
snail snails soar sob soft softer sol sole son sop sore sort sot
soy spec speech spell spells spit spore spry spur spurt spy stag
stall star stern still stills stir store strife strip stud study
stun stunk stunt sturdy sty sub sue suit sum sums sun sunk suntan
sup sups surd syrup syrupy tab tad tag tags tale tall tally tam
tame tamely tan tang tans tao tap tape taped tar tarn taro tars
tat tats tau taunt taunts taut tea teal team teas ted teds tee
teed tell temp tempi ten tend tends tens tern terns than the
theory they thin thing throe thug thy tic tide tie tied tier tiers
ties tile tiling till tills time tin tine tingly tiny tip tips
tire tired tires tit toad toe toes tog toga toll tolls ton tor
tore torn tow toward toy trend trends tried tries trip tripe trips
trite trod troy trunk trunks try tsar tug tugs tun tuna tunas tung
tuns turd turn turns tusk two tying tyro ump umps ups uptime urn urns
usable use vade vale vat vatic veal vee vees vela verso vet via
vie vied vita wad wade wades wads wag waging wan war ward wart was
wash washed wed weds weigh wen when whine wig win wine wing woad
woe word yak yam yea yell yells yen yes yet yip yoke yoked yon
yore you your yurt yurts
}
################################################################
MakeAnaDict
DoDisplay
NewGame ;# Looks nicer
Timer 1 ;# Quit this game
FillGrid 0 ;# and show the answers
Dialog 4
NewGame
return
----
[Category Games] | [Category Application] | [Tcl/Tk Games]