Word Search

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.

uniquename 2013aug01

This expenditure of coding energy deserves an image to show what this script hath wrought.

vetter_WordSearch_screenshot_474x483.jpg


 ##+##########################################################################
 #
 # 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 <Key-F2> {console show}
    bind .c <Configure> {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 <Button-3> {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 <Button-1> [list BDown %x %y]
    bind .c <B1-Motion> [list BMove %x %y]
    bind .c <ButtonRelease-1> [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 https://wiki.tcl-lang.org/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 <Button-1> NewBoard
    .c bind banner2 <Button-1> 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