# --------------------------------------------------------- # The Tcl/Tk wordsearch application. # Written by Hattie Schroeder, 1997 # # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # --------------------------------------------------------- # --------------------------------------------------------- # list_words: refreshes the word list # --------------------------------------------------------- proc list_words { } { global words .top1.f1.text1 delete 1.0 end for {set i 1} {$i <=[array size words]} {incr i} { .top1.f1.text1 insert end "$words($i)\n" word$i .top1.f1.text1 tag configure word$i -foreground black } } # --------------------------------------------------------- # expand_box: starts drawing the circle around the word. # Calls round_box and binds the motion and button of mouse # --------------------------------------------------------- proc expand_box {w x y} { global wordbox set begx $x set begy $y round_box $w $x $y bind $w "shape_round_box %W $begx $begy %x %y" bind $w "finish_box %W $x $y %x %y" } # --------------------------------------------------------- # round_box: Starts the circle the # user is drawing. # --------------------------------------------------------- proc round_box {w x y} { global wordbox set begx $x set begy $y set wordbox($begx$begy$x$y) [ $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 0 -extent 180 -style arc -fill black -tag beg_d $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 180 -extent 180 -style arc -fill black -tag beg_u $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 90 -extent 180 -style arc -fill black -tag beg_f $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 270 -extent 180 -style arc -fill black -tag beg_b ] } # --------------------------------------------------------- # shape_round_box: determines what is the direction of the # box, deletes unnecessary parts of the circle and creates new # circle as the mouse is moving # --------------------------------------------------------- proc shape_round_box {w begx begy x y} { global wordbox $w delete shape if {$y > [expr $begy+10]} { $w delete beg_f $w delete beg_b $w delete beg_u $w create line [expr $begx-10] $begy [expr $x-10] $y -tag shape $w create line [expr $begx+10] $begy [expr $x+10] $y -tag shape } elseif {$y < [expr $begy-10]} { $w delete beg_f $w delete beg_b $w delete beg_d $w create line [expr $begx-10] $begy [expr $x-10] $y -tag shape $w create line [expr $begx+10] $begy [expr $x+10] $y -tag shape } elseif {$x > [expr $begx+10]} { $w delete beg_d $w delete beg_b $w delete beg_u $w create line $begx [expr $begy-10] $x [expr $y-10] -tag shape $w create line $begx [expr $begy+10] $x [expr $y+10] -tag shape } elseif {$x < [expr $begx-10]} { $w delete beg_f $w delete beg_d $w delete beg_u $w create line $begx [expr $begy-10] $x [expr $y-10] -tag shape $w create line $begx [expr $begy+10] $x [expr $y+10] -tag shape } } # --------------------------------------------------------- # finish_box: Deletes the users drawn circle, calls check # to determine if the circle corresponds with a word, and # configures the bindings # --------------------------------------------------------- proc finish_box { w begx begy x y } { global wordbox dir $w delete shape if {$y > [expr $begy+10]} { $w delete beg_d } elseif {$y < [expr $begy-10]} { $w delete beg_u } elseif {$x > [expr $begx+10]} { $w delete beg_f } elseif {$x < [expr $begx-10]} { $w delete beg_b } check $w $begx $begy $x $y bind $w {expand_box %W %x %y} bind $w { } } proc check {w begx begy x y} { global wordbox coords for {set i 1} {$i <= [array size coords]} {incr i} { set accept 0 set wordbx [lindex $coords($i) 0] set wordby [lindex $coords($i) 1] set wordx [lindex $coords($i) 2] set wordy [lindex $coords($i) 3] if {$begx > [expr $wordbx -10] && $begx < [expr $wordbx +10]} { if {$begy > [expr $wordby - 10] && $begy < [expr $wordby +10]} { set accept 1 } else { continue } if {$x > [expr $wordx -10] && $x < [expr $wordx+10]} { set accept 1 } else { set accept 0 continue } if {$y > [expr $wordy -10] && $y < [expr $wordy+10]} { set accept 1 } else { set accept 0 continue } } elseif {$x > [expr $wordbx -10] && $x < [expr $wordbx +10]} { if {$y > [expr $wordby - 10] && $y < [expr $wordby +10]} { set accept 1 } else { continue } if {$begx > [expr $wordx -10] && $begx < [expr $wordx+10]} { set accept 1 } else { set accept 0 continue } if {$begy > [expr $wordy -10] && $begy < [expr $wordy+10]} { set accept 1 } else { set accept 0 continue } } else { continue } if {"$accept" } { $w itemconfigure "origline($i)" -fill black $w addtag final withtag origline($i) $w itemconfigure "origarc($i)" -outline black $w addtag arc withtag origarc($i) $w raise origarc($i) $w raise origline($i) .top1.f1.text1 tag configure word$i -foreground LightGrey break } else { continue } } } # --------------------------------------------------------- # Create frame and canvas # --------------------------------------------------------- frame .top1 pack .top1 set Parent .top1 set Name $Parent.c canvas $Name -background white \ -height 425 \ -relief raised \ -width 425 pack $Name -side left focus .top1.c # --------------------------------------------------------- # Specify rows of letters # --------------------------------------------------------- array set row { 1 "S D D D E S I G N I N T E R F A C E W I" 2 "E Y R I A B T S S T O P S T O H O S E L" 3 "R O S A A M R C E T E G C R E A T E B B" 4 "V E W T W N N K L C I S R X I B P G L Y" 5 "E S P E E N I S P E U K R A W F A A E Y" 6 "R I S O B M U M A R T R L E P D M M T G" 7 "T G M P L R G Q A L I S I O V H Z I S R " 8 "P N U A A E O T P T O V B T O I I N E E" 9 "I E M P G M V U E F E E A K Y T D C X N" 10 "R D F E Q I E E S N P D U T W U O I S Y" 11 "C W N D A Y N G D E A I D D E E R H T P" 12 "S O R O L O C A A Z R R E F E J B N R S" 13 "Q T M C M K J S T M F Y T P A M A T E M" 14 "T T W P X S U L W I I Z S N H Q R Y A Q" 15 "P C S I L N Y E I Y O Q E B I N P T P I" 16 "U R L U D E L X O G H N N H L O O C P F" 17 "L I N K R G X I C U S Y E M A R F R L G" 18 "G E F P B T E P T E C H N O L O G I E S" 19 "D I W F G B W T C O L O R K E Y Z M T U" 20 "V J F L N P V A S F I N T E R N E T S Y" } # --------------------------------------------------------- # Put letters on the canvas # --------------------------------------------------------- for {set i 1} {$i <=20} {incr i} { set t 1 foreach item $row($i) {$Name create text [expr $t*20] [expr $i*20] -text $item -tag letter incr t } } # --------------------------------------------------------- # Create buttons to dim and brighten circles around words. # --------------------------------------------------------- set Name $Parent.f1 frame $Name pack $Name -side left set Name $Parent.f1.f2 frame $Name pack $Name set Name $Parent.f1.f2.b1 button $Name -text "Dim" -command {.top1.c itemconfigure arc -outline grey .top1.c itemconfigure final -fill grey} pack $Name -side left set Name $Parent.f1.f2.b2 button $Name -text "Bright" -command {.top1.c itemconfigure arc -outline black .top1.c itemconfigure final -fill black} pack $Name -side left # --------------------------------------------------------- # Clear button - "erases" all circles by turning them white # and lowering them. Displays word list # --------------------------------------------------------- set Name $Parent.f1.b1 button $Name -text "Clear board" -bg white -command {.top1.c itemconfigure final -fill white .top1.c itemconfigure arc -outline white .top1.c lower final .top1.c lower arc .top1.c dtag final final .top1.c dtag arc arc .top1.c itemconfigure letter -fill black list_words } pack $Name -fill x # --------------------------------------------------------- # Text box and accompanying scrollbar # --------------------------------------------------------- set Name $Parent.f1.text1 text $Name -height 20 -width 15 -background white pack $Name -side left set Name $Parent.f1.s1 scrollbar $Name -width 10 -command ".top1.f1.text1 yview" pack $Name -side left -fill y .top1.f1.text1 configure -yscrollcommand ".top1.f1.s1 set" # --------------------------------------------------------- # Words # --------------------------------------------------------- array set words { 1 "Animated" 2 "Applets" 3 "Code" 4 "Color" 5 "Colorkey" 6 "Complex" 7 "Cool" 8 "Create" 9 "Design" 10 "Developer" 11 "Diverse" 12 "Drawn" 13 "Eolas" 14 "First" 15 "Frame" 16 "Gif" 17 "Graphics" 18 "GUI" 19 "Hotspots" 20 "Imagemaps" 21 "Images" 22 "Imagination" 23 "Interface" 24 "Internet" 25 "Intranet" 26 "Link" 27 "Metamap" 28 "Nested" 29 "PGP" 30 "Pixels" 31 "Private" 32 "Script" 33 "Security" 34 "Server" 35 "Signed" 36 "Spynergy" 37 "System" 38 "TCL" 39 "Tclets" 40 "Technologies" 41 "Three-D" 42 "Toolkit" 43 "Trust" 44 "URL" 45 "Web" 46 "Weblets" 47 "WebRouser" 48 "Widgets" 49 "ZMap" } # --------------------------------------------------------- # Put words in text widget # --------------------------------------------------------- list_words # --------------------------------------------------------- # Coordinates of each word # --------------------------------------------------------- array set coords { 1 "100 60 240 200" 2 "380 280 380 400" 3 "80 200 80 260" 4 "60 240 140 240" 5 "180 380 320 380" 6 "20 220 140 340" 7 "300 320 360 320" 8 "260 60 360 60" 9 "80 20 180 20" 10 "20 60 180 220" 11 "220 60 340 180" 12 "40 20 120 100" 13 "160 100 240 180" 14 "240 20 320 100" 15 "260 340 340 340" 16 "20 360 60 400" 17 "240 60 380 200" 18 "140 100 140 140" 19 "180 40 320 40" 20 "60 120 220 280" 21 "360 40 360 140" 22 "40 120 240 320" 23 "200 20 360 20" 24 "220 400 360 400" 25 "160 160 300 300" 26 "20 340 80 340" 27 "280 260 400 260" 28 "260 220 260 320" 29 "80 360 120 400" 30 "160 260 160 360" 31 "180 100 300 220" 32 "20 140 20 240" 33 "160 40 300 180" 34 "20 20 20 120" 35 "40 100 40 200" 36 "400 100 400 240" 37 "20 20 120 120" 38 "20 280 60 320" 39 "140 40 240 140" 40 "180 360 400 360" 41 "280 220 380 220" 42 "200 60 320 180" 43 "40 280 120 360" 44 "20 320 60 320" 45 "300 200 340 240" 46 "380 20 380 140" 47 "60 80 220 240" 48 "60 280 180 400" 49 "340 80 340 140" } # --------------------------------------------------------- # Create a circle around each of the words # --------------------------------------------------------- for {set i 1} {$i <=[array size coords]} { incr i} { set bx [lindex $coords($i) 0] set by [lindex $coords($i) 1] set x [lindex $coords($i) 2] set y [lindex $coords($i) 3] set w .top1.c if {$by < $y} { if { $bx == $x} { $w create arc [expr $bx-10] [expr $by-10] [expr $bx+10] [expr $by+10] -start 0 -extent 180 -style arc -fill black -tags "origarc($i)" $w create line [expr $bx-10] $by [expr $x-10] $y -tags "origline($i)" $w create line [expr $bx+10] $by [expr $x+10] $y -tags "origline($i)" $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 180 -extent 180 -style arc -fill black -tags "origarc($i)" } else { $w create arc [expr $bx - 10] [expr $by -10] [expr $bx+5] [expr $by +5] -start 35 -extent 210 -style arc -fill black -tags "origarc($i)" $w create line [expr $bx-5] [expr $by+5] [expr $x-5] [expr $y +5] -tags "origline($i)" $w create line [expr $bx+5] [expr $by-5] [expr $x +5] [expr $y-5] -tags "origline($i)" $w create arc [expr $x -5] [expr $y-5] [expr $x +10] [expr $y +10] -start 210 -extent 215 -style arc -fill black -tags "origarc($i)" } } elseif {$bx <$x} { if {$by ==$y} { $w create arc [expr $bx-10] [expr $by-10] [expr $bx+10] [expr $by+10] -start 90 -extent 180 -style arc -fill black -tag "origarc($i)" $w create line $bx [expr $by-10] $x [expr $y-10] -tag "origline($i)" $w create line $bx [expr $by+10] $x [expr $y+10] -tag "origline($i)" $w create arc [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] -start 270 -extent 180 -style arc -fill black -tag "origarc($i)" } else { $w create arc [expr $bx -10] [expr $by -10] [expr $bx+10] [expr $by +10] -start 315 -extent 180 -style arc -fill black -tags "origarc($i)" $w create line [expr $bx-5] [expr $by+5] [expr $x-5] [expr $y +5] -tags "origline($i)" $w create line [expr $bx+5] [expr $by-5] [expr $x +5] [expr $y-5] -tags "origline($i)" $w create arc [expr $x -10] [expr $y-10] [expr $x +10] [expr $y +10] -start 135 -extent 180 -style arc -fill black -tags "origarc($i)" } } } # --------------------------------------------------------- # Whiten and lower all the original boxes # --------------------------------------------------------- for {set i 1} {$i <=[array size coords]} { incr i} { .top1.c itemconfigure origline($i) -fill white .top1.c itemconfigure origarc($i) -outline white .top1.c lower origline($i) .top1.c lower origarc($i) } # --------------------------------------------------------- # Bind the mouse button to the expand_box procedure # --------------------------------------------------------- bind .top1.c {expand_box %W %x %y} #------< End of File >-----