[Keith Vetter] 2004-09-16 : Here's another little game that I wrote for my daughter who's just learning to read. It's the classic game of finding words hidden in a grid of letters. You can adjust most of the parameters of the game such as board size, number of words, etc. The only aspect you can't control is the word list--it uses a built in list of 500 words. If you want to create themed word searches you'll have to hack this game. The trickiest part was getting nicely shaped ovals for highlighting words, especially diagonal words. Luckily I found a solution here on this wiki. The other tricky part was figuring out what size font for a given board size to make everything fit nicely. [MG] September 20th 2004 - Added a small fix to the ''BUp''. Now, if $CLICK(last) isn't set (which only happens if you click outside the grid of letters when the program starts), BUp returns, instead of raising an error. ---- ##+########################################################################## # # Word Search -- creates and solves word search puzzles # by Keith Vetter, September 14, 2004 # package require Tk set S(title) "Word Search" set S(rows) 11 set S(cols) 11 set S(count) 15 set S(backwards) 1 set S(diagonals) 1 set S(shortest) 1 set S(longest) 99 set S(debug) 0 set WORDS {THE OF AND TO IN THAT IS WAS HE FOR IT WITH AS HIS ON BE AT BY THIS HAD NOT ARE BUT FROM OR HAVE AN THEY WHICH ONE YOU WERE HER ALL SHE THERE WOULD THEIR WE HIM BEEN HAS WHEN WHO WILL MORE NO IF OUT SO SAID WHAT UP ITS ABOUT INTO THAN THEM CAN ONLY OTHER NEW SOME TIME COULD THESE TWO MAY THEN DO FIRST ANY MY NOW SUCH LIKE OUR OVER MAN ME EVEN MOST MADE AFTER ALSO DID MANY BEFORE MUST THROUGH BACK YEARS WHERE MUCH YOUR WAY WELL DOWN SHOULD BECAUSE EACH JUST THOSE PEOPLE HOW TOO LITTLE US STATE GOOD VERY MAKE WORLD STILL SEE OWN MEN WORK LONG HERE GET BOTH BETWEEN LIFE BEING UNDER NEVER DAY SAME ANOTHER KNOW YEAR WHILE LAST MIGHT GREAT OLD OFF COME SINCE GO AGAINST CAME RIGHT STATES TAKE THREE HIMSELF FEW HOUSE USE DURING WITHOUT AGAIN PLACE AROUND HOWEVER HOME SMALL FOUND THOUGHT WENT SAY PART ONCE HIGH GENERAL UPON SCHOOL EVERY GOT LEFT NUMBER COURSE WAR UNTIL ALWAYS AWAY FACT WATER THOUGH LESS PUBLIC PUT THINK KEITH ALMOST HAND ENOUGH FAR TOOK HEAD YET SYSTEM SET BETTER TOLD NOTHING NIGHT END WHY FIND GOING LOOK LATER POINT KNEW CITY NEXT PROGRAM GIVE GROUP TOWARD YOUNG LET ROOM SIDE SOCIAL PRESENT GIVEN SEVERAL ORDER SECOND RATHER PER FACE AMONG FORM OFTEN EARLY WHITE JOHN CASE BECOME LARGE NEED BIG FOUR WITHIN FELT ALONG SAW BEST CHURCH EVER LEAST POWER THING LIGHT FAMILY WANT MIND COUNTRY AREA DONE OPEN GOD SERVICE PROBLEM CERTAIN KIND THUS BEGAN DOOR HELP MEANS SENSE WHOLE MATTER PERHAPS ITSELF LAW HUMAN LINE ABOVE NAME EXAMPLE ACTION COMPANY LOCAL SHOW WHETHER FIVE HISTORY GAVE TODAY EITHER ACT FEET ACROSS TAKEN PAST QUITE SEEN HAVING DEATH WEEK BODY WORD HALF REALLY FIELD AM CAR ALREADY TELL COLLEGE SHALL MONEY PERIOD HELD KEEP SURE REAL FREE CANNOT BEHIND MISS AIR OFFICE MAKING BROUGHT WHOSE SPECIAL MAJOR HEARD FEDERAL BECAME STUDY AGO MOMENT KNOWN RESULT STREET BOY REASON CHANGE SOUTH BOARD JOB SOCIETY WEST CLOSE TURN LOVE TRUE COURT FORCE FULL COST SEEM WIFE FUTURE AGE VOICE CENTER WOMAN CONTROL COMMON POLICY FRONT SIX GIRL CLEAR FURTHER LAND RUN PROVIDE FEEL PARTY ABLE MOTHER MUSIC CHILD EFFECT LEVEL STOOD TOWN SHORT MORNING TOTAL OUTSIDE RATE FIGURE CLASS ART CENTURY NORTH USUALLY PLAN LEAVE TOP MILLION SOUND BLACK STRONG HARD VARIOUS BELIEVE TYPE VALUE PLAY SURFACE SOON MEAN NEAR TABLE PEACE MODERN TAX ROAD RED BOOK PROCESS IDEA ENGLISH ALONE WOMEN GONE NOR LIVING AMERICA LONGER CUT FINALLY THIRD NATURE PRIVATE SECTION GREATER CALL FIRE KEPT GROUND VIEW DARK BASIS SPACE EAST FATHER UNION SPIRIT EXCEPT WROTE SUPPORT RETURN RECENT LATE HOPE LIVE ELSE BROWN TAKING PERSON BEYOND REPORT COMING INSIDE DEAD LOW STAGE READ INSTEAD LOST HEART LOOKING DATA PAY AMOUNT FEELING SINGLE BASIC HUNDRED MOVE COLD SIMPLY HOLD ISLAND DEFENSE SON SHOWN TEN RIVER GETTING CENTRAL SORT DOING TRYING REST MEDICAL CARE PICTURE INDEED FINE SUBJECT HIGHER SIMPLE RANGE WALL MEETING} proc Init {} { global S B CLICK if {[lsearch [font names] myFont] == -1} { font create myFont -family Helvetica } set size [expr {$S(rows) > $S(cols) ? $S(rows) : $S(cols)}] if {$size < 10} { set S(fontsize) 24 } elseif {$size < 16} { set S(fontsize) 18 } elseif {$size < 26} { set S(fontsize) 12 } else { set S(fontsize) 8 } font config myFont -size $S(fontsize) set S(cell) [font measure myFont "Wi"] set S(cell2) [expr {$S(cell) / 2.0}] set S(cell3) [expr {$S(cell) * 2 / 3.0}] set S(margin) [expr {$S(cell2) + 5}] set S(width) [expr {$S(cell) * $S(cols) + 2*$S(margin)}] set S(height) [expr {$S(cell) * $S(rows) + 2*$S(margin)}] set S(rows2) [expr {($S(rows)-1) / 2.0}] set S(cols2) [expr {($S(cols)-1) / 2.0}] if {[winfo exists .c]} { if {[winfo width .c] < $S(width) || [winfo height .c] < $S(height)} { .c config -height $S(height) -width $S(width) wm geom . {} } NewBoard 100 } else { NewBoard 0 } } proc DoDisplay {} { global S B wm title . $S(title) frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5 canvas .c -relief raised -bd 2 -highlightthickness 0 \ -width $S(width) -height $S(height) grid .c .ctrl -sticky news grid rowconfigure . 0 -weight 1 grid columnconfigure . 0 -weight 1 bind all {console show} bind .c {ReCenter %W %h %w} DoCtrlFrame update } proc DoCtrlFrame {} { button .reset -text "Reset" -command ShowBoard -bd 4 .reset configure -font "[font actual [.reset cget -font]] -weight bold" option add *Button.font [.reset cget -font] option add *Checkbutton.font [.reset cget -font] option add *Label.font [.reset cget -font] button .new -text "New Game" -command NewBoard -bd 4 button .hint -text "Hint" -command Hint -bd 4 bind .hint {Hint 1} checkbutton .bconfig -text "Configure" -command ::Config::Go -bd 4 \ -relief raised button .about -text About -command \ [list tk_messageBox -message "$::S(title)\nby Keith Vetter, Sept 2004"] #listbox .lb -yscrollcommand {.sb set} -listvariable B(all) text .tb -width 10 -height 10 -bg white -yscrollcommand {.sb set} -padx 2 \ -font {Times 12} scrollbar .sb -orient vertical -command {.tb yview} .tb tag configure found -background red \ -font "[font actual [.tb cget -font]] -overstrike 1" grid .tb .sb -in .ctrl -sticky ns -row 0 grid rowconfigure .ctrl 0 -weight 1 grid rowconfigure .ctrl 50 -minsize 20 grid .new - -in .ctrl -sticky ew -pady 5 -row 51 grid .reset - -in .ctrl -sticky ew -pady 5 grid .hint - -in .ctrl -sticky ew grid rowconfigure .ctrl 99 -minsize 30 grid .bconfig - -in .ctrl -sticky ew -pady 5 -row 100 grid .about - -in .ctrl -sticky ew grid columnconfigure .ctrl 0 -weight 1 grid rowconfigure .ctrl 0 -weight 1 } proc DrawBoard {} { global S B .c delete all # Outer border foreach {x0 y0} [GetCellXY 0 0] break foreach {x1 y1} [GetCellXY [expr {$S(rows)-1}] [expr {$S(cols)-1}]] break set x0 [expr {$x0 - $S(margin)}] set y0 [expr {$y0 - $S(margin)}] set x1 [expr {$x1 + $S(margin)}] set y1 [expr {$y1 + $S(margin)}] .c create rect $x0 $y0 $x1 $y1 -width 3 # The letter grid for {set row 0} {$row < $S(rows)} {incr row} { for {set col 0} {$col < $S(cols)} {incr col} { set xy [GetCellXY $row $col] set tag letter,$row,$col .c create text $xy -text $B($row,$col) -anchor c -font myFont \ -tag [list letter letter,$row,$col] } } bind .c [list BDown %x %y] bind .c [list BMove %x %y] bind .c [list BUp %x %y] } proc NewBoard {{show 1}} { global B WL ::Create::Board B if {$show} ShowBoard } proc ShowBoard {} { global B set B(state) 1 ;# Playing set B(found) {} DrawBoard .tb config -state normal ;# Add words to list box .tb delete 0.0 end .tb insert end [join $B(words) "\n"] .tb config -state disabled } proc GetCellXY {row col} { set x [expr {[expr {$col - $::S(cols2)}] * $::S(cell)}] set y [expr {[expr {$row - $::S(rows2)}] * $::S(cell)}] return [list $x $y] } proc GetCellBox {row col} { foreach {x y} [GetCellXY $row $col] break return [list [expr {$x - $::S(cell2)}] [expr {$y - $::S(cell2)}] \ [expr {$x + $::S(cell2)}] [expr {$y + $::S(cell2)}]] } proc GetCellRowCol {x y} { set row [expr {int(($y+$::S(cell2)) / $::S(cell) + $::S(rows2))}] set col [expr {int(($x+$::S(cell2)) / $::S(cell) + $::S(cols2))}] return [list $row $col] } proc ReCenter {W h w} { ;# Called by configure event set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}] $W config -scrollregion [list -$w2 -$h2 $w2 $h2] } proc BDown {x y} { global CLICK B S if {! $B(state)} return set xx [.c canvasx $x] set yy [.c canvasy $y] foreach {row col} [GetCellRowCol $xx $yy] break if {$row < 0 || $col < 0 || $row >= $S(rows) || $col >= $S(cols)} return set CLICK(arow) $row set CLICK(acol) $col set CLICK(last) {} BMove $x $y } proc BMove {x y} { global CLICK B S if {! $B(state)} return set x [.c canvasx $x] set y [.c canvasy $y] foreach {row col} [GetCellRowCol $x $y] break if {$row < 0 || $col < 0 || $row >= $S(rows) || $col >= $S(cols)} return set CLICK(last) [AlignSelection $CLICK(arow) $CLICK(acol) $row $col] foreach {row col} $CLICK(last) break ShowSelection $CLICK(arow) $CLICK(acol) $row $col } # Figure out if mouse selection is horizontal, vertical or diagonal proc AlignSelection {r0 c0 r1 c1} { set dr [expr {abs($r1 - $r0)}] set dc [expr {abs($c1 - $c0)}] if {$dr == 0 || $dc == 0} {return [list $r1 $c1]} if {$::S(diagonals) && $dr == $dc} {return [list $r1 $c1]} if {! $::S(diagonals)} { if {$dr < $dc} { return [list $r0 $c1] } return [list $r1 $c0] } # Could be improved here--snap to diagonal if close to it if {$dr < $dc} { return [list $r0 $c1] } return [list $r1 $c0] } proc BUp {x y} { global B CLICK if {!$B(state) || ![info exists CLICK(last)]} return foreach {r1 c1} $CLICK(last) break CheckWord $CLICK(arow) $CLICK(acol) $r1 $c1 0 } proc CheckWord {r0 c0 r1 c1 hint} { global B set dr [expr {$r1 > $r0 ? 1 : $r1 < $r0 ? -1 : 0}] set dc [expr {$c1 > $c0 ? 1 : $c1 < $c0 ? -1 : 0}] set word "" set r $r0 set c $c0 while {1} { append word $B($r,$c) ;# Build up selected word if {$r == $r1 && $c == $c1} break incr r $dr incr c $dc } .c delete select if {[FoundWord $word]} { ;# Found a word ShowWord $r0 $c0 $r1 $c1 $hint ;# Highlight found word Winner ;# Did we win } } proc ShowSelection {r0 c0 r1 c1} { .c delete select Highlight $r0 $c0 $r1 $c1 -tag select -fill yellow } proc ShowWord {r0 c0 r1 c1 {hint 0}} { set color [expr {$hint ? "red" : "orange"}] Highlight $r0 $c0 $r1 $c1 -tag word -fill $color Highlight $r0 $c0 $r1 $c1 -tag outword -fill {} } proc Highlight {r0 c0 r1 c1 args} { global S if {$r0 != $r1 && $c0 != $c1} { ;# Diagonal highlight if {$c1 < $c0} { foreach {r0 c0 r1 c1} [list $r1 $c1 $r0 $c0] break } foreach {x0 y0 x1 y1} [GetCellBox $r0 $c0] break foreach {x2 y2 x3 y3} [GetCellBox $r1 $c1] break if {$r0 < $r1} { ;# Going down set xy [list $x0 $y0 \ [expr {$x0 + $S(cell3)}] $y0 \ $x3 [expr {$y3 - $S(cell3)}] \ $x3 $y3 \ [expr {$x3 - $S(cell3)}] $y3 \ $x0 [expr {$y0 + $S(cell3)}]] } else { set xy [list $x0 $y1 \ $x0 [expr {$y1 - $S(cell3)}] \ [expr {$x3 - $S(cell3)}] $y2 \ $x3 $y2 \ $x3 [expr {$y2 + $S(cell3)}] \ [expr {$x0 + $S(cell3)}] $y1] } set radii [list 100 100 100 100 100 100] } else { ;# Horizontal or vertical if {$r1 < $r0 || $c1 < $c0} { foreach {r0 c0 r1 c1} [list $r1 $c1 $r0 $c0] break } foreach {x0 y0 x1 y1} [GetCellBox $r0 $c0] break foreach {x2 y2 x3 y3} [GetCellBox $r1 $c1] break set xy [list $x0 $y0 $x3 $y0 $x3 $y3 $x0 $y3] set radii [list 100 100 100 100] } set n [eval RoundPoly .c [list $xy] [list $radii] -outline black $args] .c lower $n .c lower word } proc FoundWord {word} { global S B set n [lsearch -exact $B(words) $word] ;# Is it a word we want??? if {$n == -1} { ;# No, try backwords set word [Reverse $word] set n [lsearch -exact $B(words) $word] if {$n == -1} {return 0} } if {[lsearch $B(found) $word] != -1} {return 0} ;# Already found .tb tag add found [expr {$n+1.0}] [expr {$n+2.0}] lappend B(found) $word return 1 } proc Reverse {word} { for {set i [expr {[string length $word] - 1}]} {$i >= 0} {incr i -1} { append rword [string index $word $i] } return $rword } namespace eval ::Create { variable BOARD variable backwards 0 variable diagonals 0 variable FREQ array set FREQ {A 8.2 B 1.5 C 2.8 D 4.3 E 12.7 F 2.1 G 2.0 H 6.1 I 7.0 J 0.1 K 0.8 L 4.0 M 2.4 N 6.7 O 7.5 P 1.9 Q 0.1 R 6.0 S 6.3 T 9.1 U 2.7 V 1.0 W 2.4 X 0.2 Y 2.0 Z 0.1} } proc ::Create::Board {n_board} { variable BOARD variable backwards $::S(backwards) variable diagonals $::S(diagonals) upvar $n_board master ::Create::ClearBoard set words [::Create::GetWords $::S(count)] ::Create::InsertWords $words ::Create::FinishBoard array unset master array set master [array get BOARD] } proc ::Create::InsertWords {wordlist} { variable BOARD variable backwards variable diagonals global S # Sort biggest word first for easier layout set i -1 foreach word $wordlist { incr i lset wordlist $i [list $word [string length $word]] } set wordlist [lsort -decreasing -index 1 $wordlist] set dirs {r d} if {$backwards} {lappend dirs l u} if {$diagonals} {lappend dirs ne se} if {$backwards && $diagonals} {lappend dirs nw sw} set BOARD(words) {} set BOARD(found) {} foreach word $wordlist { set word [lindex $word 0] for {set try 0} {$try < 100} {incr try} { set row [expr {int(rand() * $S(rows))}] set col [expr {int(rand() * $S(cols))}] set dir [lindex $dirs [expr {int(rand() * [llength $dirs])}]] set n [::Create::TryToPlace $word $row $col $dir] if {$n != {}} { lappend BOARD(words) $word set BOARD(soln,$word) $n break } } } set BOARD(words) [lsort $BOARD(words)] if {$S(debug) && [llength $BOARD(words)] != [llength $wordlist]} { set msg "ERROR: could only fit [llength $BOARD(words)] words" tk_messageBox -icon error -title "$S(title) Error" -message $msg } } proc ::Create::GetWords {cnt} { global WORDS # Shuffle the whole list--it's short enough set len [llength $WORDS] 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 $WORDS $i] lset WORDS $i [lindex $WORDS $n] lset WORDS $n $temp } set myWords {} foreach word $WORDS { if {[string length $word] > $::S(longest)} continue if {[string length $word] < $::S(shortest)} continue lappend myWords $word if {[incr cnt -1] <= 0} break } return $myWords set len [llength $WORDS] if {$cnt > $len} {set cnt $len} for {set i 0} {$i < $cnt} {incr i} { set n [expr {int($i + $len * rand())}] incr len -1 # Swap elements at i & n set temp [lindex $WORDS $i] lset WORDS $i [lindex $WORDS $n] lset WORDS $n $temp } return [lrange $WORDS 0 [expr {$cnt - 1}]] } proc ::Create::ClearBoard {} { variable BOARD global S array unset BOARD foreach row [list -1 $S(rows)] { for {set col -1} {$col <= $S(cols)} {incr col} { set BOARD($row,$col) -1 } } foreach col [list -1 $S(cols)] { for {set row -1} {$row <= $S(rows)} {incr row} { set BOARD($row,$col) -1 } } } proc ::Create::TryToPlace {word row col dir} { variable BOARD array set delta {u {-1 0} d {1 0} l {0 -1} r {0 1}} array set delta {nw {-1 -1} ne {-1 1} sw {1 -1} se {1 1}} foreach {dr dc} $delta($dir) break set len [string length $word] for {set i 0} {$i < $len} {incr i} { set r [expr {$row + $i*$dr}] set c [expr {$col + $i*$dc}] if {[info exists BOARD($r,$c)]} { return {}} } for {set i 0} {$i < $len} {incr i} { set r [expr {$row + $i*$dr}] set c [expr {$col + $i*$dc}] set BOARD($r,$c) [string index $word $i] } return [list $row $col $r $c] } proc ::Create::FinishBoard {} { variable BOARD global S for {set row 0} {$row < $S(rows)} {incr row} { for {set col 0} {$col < $S(cols)} {incr col} { if {[info exists BOARD($row,$col)]} continue set BOARD($row,$col) [::Create::RandomLetter] if {[info exists S(debug)] && $S(debug)} { set BOARD($row,$col) "." } } } } proc ::Create::RandomLetter {} { variable FREQ set n [expr {rand() * 100}] set nn $n foreach {letter perc} [array get FREQ] { if {$n < $perc} {return $letter} set n [expr {$n - $perc}] } error "ERROR: RandomLetter failed: $nn" } # From http://mini.net/tcl/DrawingRoundedPolygons proc RoundPoly {w xy radii args} { set lenXY [llength $xy] set lenR [llength $radii] if {$lenXY != 2 * $lenR} { error "wrong number of vertices and radii: $lenXY $lenR" } # Walk down vertices keeping previous, current and next foreach {x0 y0} [lrange $xy end-1 end] break foreach {x1 y1} $xy break eval lappend xy [lrange $xy 0 1] set knots {} ;# These are the control points for {set i 0} {$i < $lenXY} {incr i 2} { set radius [lindex $radii [expr {$i/2}]] set r [winfo pixels $w $radius] foreach {x2 y2} [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] break set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r] eval lappend knots $z foreach {x0 y0} [list $x1 $y1] break ;# Current becomes previous foreach {x1 y1} [list $x2 $y2] break ;# Next becomes current } set n [eval $w create polygon $knots -smooth 1 $args] return $n } proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} { set d [expr { 2 * $radius }] set maxr 0.75 set v1x [expr {$x0 - $x1}] set v1y [expr {$y0 - $y1}] set v2x [expr {$x2 - $x1}] set v2y [expr {$y2 - $y1}] set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}] set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}] if {$d > $maxr * $vlen1} { set d [expr {$maxr * $vlen1}] } if {$d > $maxr * $vlen2} { set d [expr {$maxr * $vlen2}] } lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}] lappend xy $x1 $y1 lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}] return $xy } proc Winner {} { global B if {[llength $B(words)] != [llength $B(found)]} {return 0} Banner " You Won! " set bg [.c cget -bg] ;# Blink the screen for {set i 0} {$i < 4} {incr i} { foreach color [list white $bg] { .c config -bg $color update after 100 } } .c bind banner NewBoard .c bind banner2 NewBoard set B(state) 0 ;# Not playing return 1 } proc Banner {msg} { .c create text 0 0 -tag banner -text $msg -font {Times 36 bold} -fill white set xy [.c bbox banner] .c create rect $xy -tag banner2 -fill black -outline gold -width 4 .c raise banner } proc Hint {{all 0}} { if {! $::B(state)} return foreach word $::B(words) { if {[lsearch $::B(found) $word] != -1} continue eval CheckWord $::B(soln,$word) 1 if {! $all} break update } } namespace eval ::Config { variable C variable vars {count rows cols shortest longest backwards diagonals debug} } proc ::Config::Go {} { global S # Check for toggling off if {[winfo exists .config] && [winfo ismapped .config]} { grid forget .config return } # Here to display it if {! [winfo exists .config]} { foreach var $::Config::vars {set ::Config::C($var) $S($var)} frame .config -relief ridge -bd 2 -padx 5 -pady 5 label .config.title -text "Configuration" -bd 2 -relief raised label .config.rows -text "Rows:" -anchor e entry .config.erows -textvariable ::Config::C(rows) -width 5 -justify c label .config.cols -text "Columns:" -anchor e entry .config.ecols -textvariable ::Config::C(cols) -width 5 -justify c label .config.cnt -text "Words:" -anchor e entry .config.ecnt -textvariable ::Config::C(count) -width 5 -justify c label .config.short -text "Shortest:" -anchor e entry .config.eshort -textvariable ::Config::C(shortest) -width 5 -justify c label .config.long -text "Longest:" -anchor e entry .config.elong -textvariable ::Config::C(longest) -width 5 -justify c checkbutton .config.back -text "Backwards" -anchor w -relief ridge \ -variable ::Config::C(backwards) checkbutton .config.diag -text "Diagonals" -anchor w -relief ridge \ -variable ::Config::C(diagonals) checkbutton .config.debug -text "Debug" -anchor w -relief ridge \ -variable ::Config::C(debug) button .config.easy -text "Easy" -command {::Config::Preset easy} button .config.medium -text "Medium" -command {::Config::Preset medium} button .config.hard -text "Hard" -command {::Config::Preset hard} button .config.apply -text "Apply" -command ::Config::Apply \ -state disabled grid .config.title - -sticky ew -row 0 grid rowconfigure .config 1 -minsize 10 grid .config.rows .config.erows -sticky ew -row 2 grid .config.cols .config.ecols -sticky ew grid .config.cnt .config.ecnt -sticky ew grid .config.short .config.eshort -sticky ew grid .config.long .config.elong -sticky ew grid rowconfigure .config 10 -minsize 20 grid .config.back - -sticky ew -row 11 grid .config.diag - -sticky ew grid .config.debug - -sticky ew grid rowconfigure .config 20 -minsize 20 grid .config.easy - -sticky ew -row 21 grid .config.medium - -sticky ew -pady 5 grid .config.hard - -sticky ew grid rowconfigure .config 30 -minsize 20 grid .config.apply - -sticky ew -row 31 grid rowconfigure .config 100 -weight 1 trace variable ::Config::C w ::Config::Tracer } grid .config -row 0 -column 2 -sticky n } proc ::Config::Tracer {var1 var2 op} { if {! [winfo exists .config.apply]} return .config.apply config -state disabled foreach var $::Config::vars { if {$::S($var) != $::Config::C($var)} { .config.apply config -state normal return } } } proc ::Config::Apply {} { variable vars variable C global S set resize [expr {$S(rows) != $C(rows) || $S(cols) != $C(cols)}] foreach var $vars { if {[info exists C($var)]} { set S($var) $C($var) } } set C(count) $C(count) ;# Cause trace to fire if {$resize} { Init } else { NewBoard 1 } } proc ::Config::Preset {how} { variable C array set H {"easy" {8 8 10 0 1 2 4} "medium" {10 10 10 1 1 3 99} "hard" {15 15 20 1 1 3 99} } foreach {C(rows) C(cols) C(count) C(backwards) C(diagonals) \ C(shortest) C(longest)} $H($how) break ::Config::Apply } Init DoDisplay if {$argc == 1 && [lsearch [list "easy" "medium" "hard"] $argv] > -1} { ::Config::Preset $argv } ShowBoard ---- [Category Games] | [Category Application] | [Tcl/Tk Games]