[Keith Vetter] 2002-10-21 - I threw together a quick little dot-to-dot game. I designed it for my 3-year old daughter, so it's intended to be easy to use: the target next dot gets enlarged and highlighted, you don't drag & drop but just click, a line is drawn from the last dot to the mouse, etc. ''[KPV]'' 2003-02-28 -- I've put up an updated version of ''Dot to Dots''. This version includes more puzzles, a revamped GUI, better build mode and sound effects (only if you have the base64 and snack packages). ''[escargo]'' -- When I used wish-reaper to download this and tried to run it on my Windows XP box with [ActiveTcl] 8.4.1 I got this message: ''illegal character found in input while executing...'' ''[KPV]'' - investigation revealed that this is a bug in [tcllib]'s [base64] package--it barfing on leading spaces. (Actually the bug is in [Trf] which gets used for speed up, the tcl-only version works correctly. ActiveTcl version 4.1a and 4.1.0 didn't include Trf while 4.1.1 does.) RFC2045, which defines base64, specifically says that all characters outside the base64 alphabet should be ignored. Anyway, I fixed it by cleaning up the data before passing it to the base64 decoder. ''[Rfox]'' - Feeling picky the RFC is actually self-contradictory: All line breaks or other characters not found in Table 1 must be ignored by decoding software. In base64 data, characters other than those in Table 1, line breaks, and other white space probably indicate a transmission error, about which a warning message or even a message rejection might be appropriate under some circumstances. ''[escargo]'' -- I reaped the newer version and found that it behaves correctly. Would it make sense to do your own volume control? Or is that something more appropriate to leave to external sound processing? ''[Sandy]'' -- I improved the color changes (color change changes item base color, e.g. red or green apple), and automatically now save new dot2dots made in the Build function into a ".dots" directory if (and only if) that directory exists and has a file named "count" in it, that gives the highest existing filename (e.g. dot.9 if you save each individual dot spec into its own file). If you do not have the save directory, it loads the same default internal pics as before. I seperated out each dot into its own file and put them there, to seed it, and now it's easy to draw (using dot2dot.tcl) new drawings for the kiddies. It's somewhat unsafe in that the save files get sourced, and thus could contain any tcl code, but it pleases the kids in my internal machine. I also added an exit button. My four year old loves it, thanks for making this! Queries etc to sandy@rpg.net, this being my first post to this wiki. Say Sandy, how about posting your new version to a second page like "Dot to Dots 2" or some such? Thanks, Roy Terry ''[Sandy]'' Okay, at Keith's beheast I've checked the changes into this version. ====== ##+########################################################################## # # dot2dot.tcl - a simple dot-to-dot game # by Keith Vetter # # Revisions: # KPV Oct 20, 2002 - initial revision # KPV Feb 28, 2003 - added more puzzles, revamped gui, added sounds # # Sandy Nov 18, 2003 - If you create a directory ~/.dots, you can # save your own puzzles there. Also, improved color and an 'Exit' button added. # Note that, if ~/.dots does not exist, it will not save and will just # use the default set only. package require Tk set S(r1) 5 ;# Dot size set S(r2) 10 ;# Dot size when it's next set S(build) 0 ;# Build mode set S(which) -1 ;# Which puzzle we're doing set S(out) 1 set S(color) black set S(sound) 1 set ddata(done) 0 set xdots {} proc DoDisplay {} { wm title . "Dot 2 Dot" pack [frame .ctrl -relief ridge -bd 2] \ -side right -fill both -ipady 5 pack [frame .top -relief raised -bd 2] -side top -fill x pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1 canvas .c -relief raised -borderwidth 0 -height 600 -width 700 \ -highlightthickness 0 .c xview moveto 0 ; .c yview moveto 0 pack .c -in .screen -side top -fill both -expand 1 set colors {red orange yellow green blue cyan purple violet white} lappend colors [lindex [.c config -bg] 3] black foreach color $colors { radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \ -variable S(color) -value $color -command ReColor bind .top.b$color <3> [list .c config -bg $color] } pack {*}[winfo children .top] -side left -fill y focus .c pack .c -side left -fill both -expand 1 bind .c [list MMove %x %y] bind .c {MDown %x %y} bind .c {M3Down %x %y} bind .c {.c delete xline} bind .c {ReCenter %W %h %w} bind .c {ConnectDot 1} bind .c ConnectDot bind all {console show} DoCtrlFrame return } proc DoCtrlFrame {} { option add *Button.borderWidth 4 button .restart -text Restart -command {DoDots -2} button .next -text "Next Puzzle" -command {DoDots -1} button .random -text "Random Puzzle" -command {DoDots -3} frame .pf -bd [.next cget -bd] -relief raised label .pl -text " Pick Puzzle" tk_optionMenu .p S(new) {*}[lsort -dictionary [array names ::dots]] .p config -highlightthickness 0 -bd 0 -width 2 frame .bframe -bd 2 -relief ridge checkbutton .build -text "Build Mode" -variable S(build) -anchor w \ -command ToggleBuildMode button .done -text Done -command Done button .clear -text Clear -command Clear button .copy -text Copy -command Copy button .undo -text Undo -command {M3Down -1 -1} button .exit -text "Exit" -command {exit} checkbutton .sound -text "Sounds" -relief raised -bd [.next cget -bd] \ -variable S(sound) -padx 10 -anchor w button .about -text About -command About grid .pf -in .ctrl -sticky ew -row 0 pack .pl .p -in .pf -side left grid .next -in .ctrl -sticky ew grid .random -in .ctrl -sticky ew grid .restart -in .ctrl -sticky ew grid .exit -in .ctrl -sticky ew grid .bframe -in .ctrl -sticky ew -row 11 grid .sound -in .ctrl -sticky ew -row 51 grid .about -in .ctrl -sticky ew place .build -in .bframe -relx .05 -rely 0 -anchor w grid .clear -in .bframe -sticky ew -row 2 grid .copy -in .bframe -sticky ew grid .undo -in .bframe -sticky ew grid .done -in .bframe -sticky ew grid rowconfigure .ctrl 10 -minsize 50 grid rowconfigure .ctrl 50 -weight 1 grid rowconfigure .bframe 0 -minsize 20 grid rowconfigure .bframe 10 -minsize 5 grid columnconfigure .bframe 0 -weight 1 trace variable ::S(new) w PickPuzzle trace variable ::S(build) w TraceBuild trace variable ::xdots w TraceXDots } proc ReColor {} { global S .c itemconfig done -fill $S(color) ;# .c itemconfig xline -fill $S(color) ;# .c itemconfig line -fill $S(color) .c itemconfig xline -fill black .c itemconfig line -fill black .c itemconfig dot -fill $S(color) -outline $S(color) .c itemconfig extra -fill black catch {.c itemconfig extra -outline black} .c lower done update } proc TraceBuild {var1 var2 op} { if {$::S(build)} {set s normal} {set s disabled} foreach w {.copy .undo .done .clear} { $w config -state $s } TraceXDots x y z } proc TraceXDots {var1 var2 op} { if {! $::S(build)} return set len [llength $::xdots] array set s {0 disabled 1 normal} .undo config -state $s([expr {$len > 0}]) .done config -state $s([expr {$len >= 6}]) } proc PickPuzzle {arr val op} { global S if {$S(new) == $S(which)} return DoDots $S(new) } proc ReCenter {W h w} { ;# Called by event set h [expr {$h / 2.0}] set w [expr {$w / 2.0}] $W config -scrollregion [list -$w -$h $w $h] } proc About {} { tk_messageBox -title About -message \ "Dot 2 Dot\nby Keith Vetter, February 2003" } proc DoDots {which} { ;# Install a new puzzle global dots ddata S if {$which == -2} { ;# Reuse last one set which $S(which) } elseif {$which == -1} { ;# Next one set names [lsort -dictionary [array names dots]] set n [lsearch $names $S(which)] ;# Find which one was last if {[incr n] >= [llength $names]} {set n 0} ;# Wrap set which [lindex $names $n] } elseif {$which == -3} { ;# Random set names [array names dots] set len [llength $names] set n [expr {int($len * rand())}] set which [lindex $names $n] } set S(build) 0 ;# Turn off build mode set S(which) $which ;# Remember which puzzle set S(new) $which .c delete all catch {unset ddata} array set ddata {done 0 last 1 next 2 close 0 xy {}} set cnt 0 foreach {x y} $dots($which) { if {$x == 999 && $y == 999} { ;# Flag to connect to beginning set ddata(close) 1 break } incr cnt set ddata($cnt) [list $x $y] lappend ddata(xy) $x $y DrawOneDot $cnt } DoExtra $which set ddata(end) $cnt MakeTarget } proc DrawOneDot {n} { global ddata S foreach {x y} $ddata($n) break set xy [MakeBox $x $y $S(r1)] .c create oval $xy -tag [list dot d$n] -fill $S(color) -outline $S(color) set x [expr {$x - 3}] ; set y [expr {$y - 3}] .c create text $x $y -anchor se -text $n -tag n$n .c raise d$n n$n } proc DoExtra {which} { ;# Draws extra lines on puzzle global extra ddata if {! [info exists extra($which)]} return set data $extra($which) set len [llength $data] for {set i 0} {$i < $len} {} { set what [lindex $data $i] set meta [lindex $data [incr i]] incr i if {$what == "c"} { foreach {x y} [lrange $data $i [expr {$i + 1}]] break .c create oval [MakeBox $x $y $meta] -width 5 -tag extra incr i 2 continue } if {$what == "l" || $what == "L" || $what == "p"} { if {$what == "p"} {set type polygon} else {set type line} set last [expr {$i + $meta*2 - 1}] set xy [lrange $data $i $last] set n [.c create $type $xy -width 3 -tag extra] set i [expr {$last+1}] if {$what == "L"} {lappend ddata(xy) {*}$xy} continue } } } proc MakeBox {x y d} { return [list [expr {$x-$d}] [expr {$y-$d}] [expr {$x+$d}] [expr {$y+$d}]] } proc MMove {x y} { ;# Called when mouse moves global ddata S if {$S(build) == 1 || $ddata(done)} return .c delete xline set x [.c canvasx $x] ; set y [.c canvasy $y] .c create line [concat $ddata($ddata(last)) $x $y] -tag xline \ -fill $S(color) if {[.c find withtag target] == ""} return foreach {x1 y1 x2 y2} [.c bbox target] break ;# Target for valid click if {$x < $x1 || $y < $y1 || $x > $x2 || $y > $y2} { .c itemconfig target -fill green -outline green set S(out) 1 } else { .c itemconfig target -fill red -outline red if {$S(out) == 1} { PlaySound enter } set S(out) 0 } } proc MDown {x y} { ;# Called on mouse click global ddata dots xdots S set x [expr {int([.c canvasx $x])}] ; set y [expr {int([.c canvasy $y])}] if {$S(build)} { ;# Build dot2dot mode lappend xdots $x $y ;# Add to our list set ddata([incr ddata(last)]) [list $x $y] DrawOneDot $ddata(last) catch {.c coords build $xdots} return } if {$ddata(done)} return foreach {x1 y1 x2 y2} [.c bbox target] break ;# Target for valid click if {$x < $x1 || $y < $y1 || $x > $x2 || $y > $y2} return foreach a [after info] {after cancel $a} PlaySound click ConnectDot } proc M3Down {x y} { ;# Right-click == undo global ddata dots xdots S if {$S(build) == 0} return ;# Not in build mode if {$ddata(last) == 0} return ;# Nothing to undo set xdots [lrange $xdots 0 end-2] ;# Remove last dot .c delete xline build d$ddata(last) n$ddata(last) .c create line -tag build incr ddata(last) -1 if {$ddata(last) <= 0} { ;# Completely empty set S(build) 1 set ddata(last) 0 } elseif {$ddata(last) > 1} { ;# Some completed lines .c coords build $xdots } if {$x != -1} { MMove $x $y } } proc ConnectDot {{all 0}} { global ddata S .c delete xline target while {1} { .c create line [concat $ddata($ddata(last)) $ddata($ddata(next))] \ -fill black -width 3 -tag line -fill $S(color) incr ddata(last) incr ddata(next) if {$ddata(last) == $ddata(end)} { DonePuzzle break } else { MakeTarget } if {! $all} break } } proc MakeTarget {} { ;# Draws where next click goes global ddata S .c delete target foreach {x y} $ddata($ddata(next)) break set xy [MakeBox $x $y $S(r2)] .c create oval $xy -tag target -fill green -outline green } proc DonePuzzle {} { global ddata dots S set ddata(done) 1 if {$ddata(close)} { .c create line {*}$ddata($ddata(last)) {*}$ddata(1) -fill black -width 3 } .c delete target ;# .c create poly $ddata(xy) -tag done -fill yellow .c create poly $ddata(xy) -tag done -fill $S(color) .c lower done # Add to our pick puzzle widget destroy .p tk_optionMenu .p S(new) {*}[lsort -dictionary [array names ::dots]] .p config -highlightthickness 0 -bd 0 -width 2 pack .p -in .pf -side right } proc ToggleBuildMode {} { if {$::S(build)} { GoBuildMode } else { set n [Done] ;# Finish off this build if {! $n} { DoDots -2 } } } proc GoBuildMode {{ifile ""}} { Clear set ::S(build) 1 catch {image delete d2d} if {$ifile != ""} { image create photo d2d -file $ifile .c create image 0 0 -anchor c -image d2d -tag image .c lower image } } proc Clear {{all 1}} { global xdots ddata .c delete done target xline if {$all} {.c delete all} catch {unset ddata} set ddata(last) 0 set ddata(done) 0 set xdots {} .c create line -tag build catch {image delete d2d} } proc Copy {} { global dots ddata xdots regsub -all {\.0} $xdots {} xdots clipboard clear clipboard append $xdots set len [expr {[llength $xdots] / 2}] set ddata(last) 0 set ddata(done) 0 set xdots {} } proc Done {} { global dots extra xdots if {[llength $xdots] <= 3} {return 0} for {set cnt 1} {1} {incr cnt} { set name "n$cnt" if {! [info exists dots($name)]} break } set dots($name) $xdots lappend dots($name) 999 999 set extra($name) {} Copy DoDots $name SaveShape $name return 1 } proc ScaleIt {n s} { global dots extra set d2 [set e2 {}] foreach {x y} $dots($n) { if {$x != 999} { set x [expr {round($x * $s)}] set y [expr {round($y * $s)}] } lappend d2 $x $y } foreach {x y} $extra($n) { if {[string is double $x]} { set x [expr {round($x * $s)}] set y [expr {round($y * $s)}] } lappend e2 $x $y } set dots($n) $d2 set extra($n) $e2 DoDots $n clipboard clear clipboard append "set dots($n) {$d2}\n" clipboard append "set extra($n) {$e2}\n" } proc Shapes {} { global dots extra totalcount env set h $env(HOME) set home [file join $h ".dots"] set fname [file join $home "count"] if [file exists $fname] { set chan [open $fname "r"] set tcount [read $chan] regsub -all {\n} $tcount "" totalcount close $chan for {set i 0} {$i < $totalcount} {incr i} { set fname [file join $home "dot.$i"] source $fname } } ;# puts "debug: loading defaults" DefShapes } proc SaveShape {name} { global env totalcount dots set h $env(HOME) set fout [file join $h ".dots" "dot.$totalcount"] set str1a "set dots($totalcount) {" set str1b "}" set str2 "set extra($totalcount) {}" set chan [open $fout "w"] puts $chan $str1a puts $chan $dots($name) puts $chan $str1b puts $chan $str2 close $chan incr totalcount set fname [file join $h ".dots" "count"] set chan [open $fname "w"] puts $chan $totalcount close $chan # now update the menu gadget destroy .p tk_optionMenu .p S(new) {*}[lsort -dictionary [array names ::dots]] .p config -highlightthickness 0 -bd 0 -width 2 pack .p -in .pf -side right } proc DefShapes {} { global dots extra totalcount set i $totalcount set dots($i) {-286 -8 -242 -18 -217 -37 -191 -66 -176 -89 -173 -133 -146 -132 -103 -106 -51 -134 -2 -147 56 -156 136 -156 222 -132 248 -137 288 -177 297 -176 293 -147 280 -119 298 -95 298 -69 309 -32 310 29 270 110 233 223 177 231 157 156 80 152 0 152 -54 231 -104 231 -107 135 -174 115 -227 88 -284 38 999 999} set extra($i) {c 12 -118 -36 l 5 -129 127 -116 122 -93 110 -78 92 -65 67 l 12 294 -180 308 -186 317 -195 315 -201 306 -208 297 -214 294 -225 304 -233 316 -234 321 -220 318 -218 309 -219} incr i set dots($i) {34 -114 57 -133 90 -145 145 -139 208 -91 224 -30 221 45 196 117 129 199 59 241 26 235 -7 228 -45 239 -110 207 -163 149 -191 66 -197 -19 -161 -90 -112 -131 -45 -138 -6 -108 999 999} set extra($i) { l 11 -99 -87 -111 -77 -130 -54 -139 -38 -151 -11 -159 22 -165 -3 -162 -27 -151 -55 -134 -73 -99 -87 p 20 36 -233 26 -217 20 -202 15 -182 14 -160 18 -124 23 -99 20 -92 16 -80 8 -77 5 -96 -2 -119 -7 -152 -8 -173 -5 -203 0 -231 11 -253 16 -241 26 -232 36 -233 l 14 8 -88 -14 -98 -7 -85 -15 -76 -25 -76 -2 -73 1 -58 10 -75 23 -65 26 -79 46 -79 30 -88 39 -98 21 -96 } incr i set dots($i) {-106 -114 -94 -153 -51 -174 -11 -160 7 -131 6 -87 -28 -26 22 -28 75 -13 100 -69 119 12 96 55 43 81 -34 88 -91 61 -111 11 -83 -46 -80 -72 -128 -58 -166 -85 999 999} set extra($i) { p 6 -75 -124 -72 -119 -74 -111 -77 -109 -82 -116 -81 -123 p 4 -67 -137 -63 -126 -60 -130 -65 -141 l 7 -144 -70 -133 -71 -119 -71 -108 -76 -98 -87 -102 -90 -96 -86 l 6 -39 10 -23 43 0 48 37 46 55 37 66 20 l 4 8 26 29 29 44 26 55 21 l 3 10 15 27 16 47 14 l 18 -107 62 -122 68 -131 79 -126 86 -115 90 -98 96 -71 101 -36 103 -6 105 35 105 70 103 97 99 132 93 151 86 160 82 162 78 156 75 137 72 l 22 -144 71 -158 77 -172 83 -182 90 -188 98 -181 103 -158 110 -119 119 -81 122 -53 124 -20 126 -4 131 28 131 55 131 83 127 119 124 149 120 175 110 187 106 189 100 184 96 177 94 l 16 -146 134 -138 138 -126 140 -115 143 -95 143 -62 146 -42 144 -30 146 -13 150 20 151 53 153 100 150 117 149 155 148 169 144 171 137 l 6 -208 -19 -198 -20 -187 -26 -184 -23 -174 -19 -170 -19 l 5 -182 -14 -169 -18 -153 -25 -149 -23 -132 -21 l 5 -145 -15 -132 -17 -121 -23 -115 -20 -108 -22 l 17 -159 -225 -151 -222 -127 -224 -110 -224 -96 -222 -80 -221 -72 -227 -55 -227 -45 -230 -60 -232 -75 -232 -85 -236 -102 -237 -117 -237 -127 -234 -148 -232 -159 -225 } incr i set dots($i) {-231 -76 -211 -95 -188 -78 -162 -110 -116 -119 -69 -138 14 -130 3 -158 45 -155 37 -187 81 -184 69 -201 111 -212 113 -247 152 -225 171 -259 175 -223 199 -208 233 -152 235 -126 221 -116 155 -144 127 -68 131 -37 115 -6 138 70 120 93 125 165 138 190 132 207 151 222 160 240 127 240 119 221 107 204 91 108 62 116 37 125 9 139 -17 123 8 97 24 109 51 103 80 84 52 31 38 3 -17 -21 -40 -17 -81 27 -100 57 -93 132 -83 158 -87 176 -59 194 -49 210 -93 211 -100 186 -114 173 -116 142 -129 66 -134 25 -104 -17 -122 -67 -113 -103 -137 -85 -187 -38 -208 -44 -225 -60 999 999} set extra($i) {l 4 169 -243 163 -230 163 -225 160 -220 l 4 156 -143 148 -146 143 -154 139 -165 l 7 153 -227 140 -220 127 -208 107 -188 85 -156 68 -144 15 -128 l 7 192 -181 191 -193 185 -197 176 -195 169 -189 175 -182 192 -181 l 3 -47 -71 -45 -51 -33 -30 l 9 104 -29 103 -21 98 -14 91 -4 92 10 97 20 100 47 102 63 116 96 } incr i set dots($i) { -257 -39 -239 -90 -205 -130 -149 -154 -87 -155 -25 -145 17 -121 -6 -156 -23 -203 14 -201 46 -195 41 -220 95 -199 134 -161 152 -113 195 -86 223 -65 244 -38 266 -9 260 17 237 38 205 55 168 58 122 48 144 96 195 103 226 115 224 149 205 173 182 180 152 177 110 161 63 136 37 98 -15 97 -54 90 -83 74 -104 100 -127 115 -129 134 -79 131 -30 130 12 140 27 174 4 179 29 205 -31 221 -101 223 -176 222 -227 218 -263 207 -262 175 -212 115 -244 91 -259 63} set extra($i) {l 6 122 47 107 76 121 104 156 119 199 122 223 148 l 7 -132 -36 -104 -23 -86 -3 -76 21 -73 44 -77 60 -83 73 l 11 -128 115 -147 118 -165 126 -177 141 -180 159 -167 167 -138 174 -97 174 -55 174 -28 173 3 177 c 2 193 -34 c 5 193 -34 c 8 193 -34 l 4 18 -122 40 -106 61 -95 95 -88 l 8 -24 -204 -5 -184 20 -164 52 -140 86 -120 111 -108 122 -105 127 -99 l 7 47 -196 62 -185 79 -175 93 -162 108 -146 123 -128 140 -104 l 5 263 17 254 20 247 20 242 15 241 7 l 7 265 -11 257 -19 249 -11 248 -1 253 7 261 6 265 -8 L 27 -259 63 -266 69 -275 65 -282 58 -275 48 -281 48 -289 46 -282 40 -291 36 -295 31 -289 21 -300 18 -298 11 -293 7 -297 1 -294 -2 -289 -6 -297 -15 -293 -21 -289 -25 -296 -32 -293 -39 -280 -42 -279 -47 -271 -54 -263 -49 -257 -39} incr i set dots($i) {84 -133 72 -93 77 -51 110 -6 104 38 86 77 115 129 123 205 88 266 20 289 -38 275 -86 257 -128 209 -130 136 -115 99 -87 62 -102 23 -107 -21 -68 -66 -75 -118 -75 -144 -110 -150 -62 -188 -93 -242 -42 -262 56 -266 68 -198 115 -167 72 -161 999 999} set extra($i) { l 8 -87 61 -70 80 -50 94 -19 104 11 104 41 101 67 92 86 77 l 5 -59 -59 -40 -45 -6 -28 33 -27 59 -38 75 -52 p 8 -34 -59 -12 -49 15 -45 41 -49 50 -63 34 -59 14 -55 -5 -56 p 9 -38 -175 -5 -171 28 -176 45 -177 59 -185 56 -190 39 -185 11 -186 -18 -177 p 9 -7 -113 -19 -117 -11 -131 3 -129 9 -119 10 -106 -1 -96 -13 -97 -18 -106 p 9 48 -118 36 -121 42 -133 55 -134 62 -123 60 -113 55 -104 42 -102 36 -110 p 14 108 5 210 34 231 27 242 25 243 34 230 41 239 46 258 50 253 59 215 54 219 64 213 69 173 39 105 17 p 15 -106 -12 -138 -9 -154 -12 -170 -6 -177 -6 -229 -29 -235 -20 -212 -5 -250 1 -250 9 -230 12 -238 23 -230 31 -207 10 -104 4 l 8 60 -79 30 -104 16 -100 7 -88 9 -74 14 -68 29 -68 60 -79} incr i set dots($i) {-10 145 -57 165 -94 150 -116 121 -112 80 -75 54 -31 59 -86 -3 -106 -69 -92 -131 -54 -155 -20 -115 3 -162 48 -182 82 -212 124 -219 153 -199 164 -162 164 -115 155 -42 132 13 145 35 138 60 117 77 112 101 94 120 57 129 50 148 66 203 113 189 121 198 64 231 54 209 38 154 15 154 -29 205 -29 226 -92 195 -83 182 -42 203 4 151 1 102 999 999} set extra($i) { c 2 -40 104 c 2 -77 89 l 6 -33 124 -45 140 -63 142 -88 130 -95 119 -93 107 l 4 -55 123 -57 115 -66 111 -76 116 l 11 0 100 -4 84 -13 71 -32 57 -26 61 -13 46 0 38 8 37 25 40 21 64 23 90 l 23 48 -183 42 -172 36 -158 33 -143 34 -129 37 -121 28 -126 14 -129 2 -126 -8 -118 -17 -109 -21 -93 -22 -73 -18 -56 -12 -38 1 -7 13 13 6 26 8 37 5 25 13 12 30 35 24 40 l 7 28 101 44 100 61 91 87 76 105 56 122 34 133 13 l 4 56 128 59 117 62 105 60 90 l 3 118 76 113 69 103 58 } incr i set dots($i) {-6 -15 18 0 88 -4 96 100 156 165 108 219 135 172 72 109 79 20 18 23 -17 3 -19 43 43 137 6 212 24 137 -35 53 -34 2 -77 58 -58 99 -118 162 -88 227 -142 165 -81 96 -101 45 -51 -11 -124 41 -110 80 -155 99 -131 77 -135 26 -69 -28 -143 -36 -134 -150 -144 -204 -111 -157 -124 -47 -84 -46 -99 -141 -58 -224 -84 -146 -69 -60 -52 -75 -59 -137 -28 -192 38 -194 89 -162 87 -99 40 -50 999 999} set extra($i) { l 10 62 -94 56 -87 42 -84 32 -92 22 -97 11 -97 -1 -92 -10 -96 -12 -105 -6 -110 c 5 6 -140 c 5 56 -115 } incr i set dots($i) {-97 -46 -126 46 -91 111 -95 231 -129 267 -84 267 -66 253 -57 151 -34 210 -4 234 -48 267 95 267 108 249 151 244 172 207 176 134 200 36 190 -20 162 -69 127 -31 108 13 141 105 139 161 81 22 13 -97 45 -95 36 -130 1 -160 -13 -192 -50 -218 -70 -252 -85 -244 -80 -207} set extra($i) {l 7 -29 192 -31 169 -22 153 -10 136 14 129 31 130 45 136 p 4 -4 -137 3 -118 32 -106 18 -129 c 3 -39 -171 L 9 -80 -207 -99 -238 -112 -239 -112 -220 -108 -196 -109 -175 -109 -150 -108 -113 -97 -46} incr i set dots($i) {-72 102 -98 161 -107 207 -122 219 -122 236 -81 240 -47 227 -53 189 -30 147 -3 206 -21 237 10 255 39 254 51 234 46 162 36 111 94 129 76 191 67 212 108 227 129 206 139 162 157 134 213 177 199 218 234 230 265 218 252 150 211 105 232 24 187 -37 139 -69 91 -72 85 -96 39 -108 -3 -108 -42 -133 -126 -127 -164 -148 -179 -184 -164 -201 -144 -199 -134 -183 -125 -201 -138 -222 -167 -226 -191 -213 -204 -180 -197 -145 -183 -123 -171 -103 -155 -84 -185 -75 -122 -45 -99 -33 -68 6 -71 78 999 999} set extra($i) {c 10 -95 -108 l 12 -75 -95 -32 -104 6 -98 18 -83 23 -70 22 -54 4 -36 -16 -20 -35 -11 -56 -11 -67 -20 -76 -40} incr i set dots($i) {-268 -8 -272 -39 -244 -80 -177 -120 -121 -132 -70 -196 -33 -224 13 -220 -14 -176 -25 -120 41 -98 107 -42 161 34 183 84 208 94 262 93 293 113 281 126 226 150 202 186 191 218 163 198 155 168 158 120 117 73 49 29 -2 12 -49 8 -53 41 -16 83 -62 88 -80 83 -110 57 -152 29 -207 39 -239 31} set extra($i) { l 5 -146 22 -133 22 -124 18 -115 18 -96 15 L 7 -239 33 -300 68 -313 67 -319 52 -312 42 -268 0 -267 -9 l 3 -239 29 -224 -4 -267 -4 l 5 -257 18 -256 23 -260 33 -272 43 -287 59 l 4 -222 -28 -212 -43 -203 -48 -195 -49 l 6 -219 -37 -218 -27 -207 -25 -204 -32 -208 -40 -219 -37 c 2 -212 -30 l 6 -205 -93 -212 -89 -211 -81 -200 -84 -191 -93 -201 -97 l 17 -139 -42 -117 -47 -67 -46 -33 -43 14 -33 47 -17 81 8 119 41 153 76 176 108 185 124 201 135 214 142 220 141 211 130 204 118 197 114 } } proc DoSounds {} { set ::S(sound) 0 .sound config -state disabled if {[catch {package require base64}]} return if {[catch {package require snack}]} return .sound config -state normal foreach e {snd_click snd_enter} { sound $e regsub -all { } [set ::$e] {} b64data $e data [::base64::decode $b64data] } set ::S(sound) 1 } proc PlaySound {what} { if {! $::S(sound)} return set snd "snd_$what" if {[info commands $snd] == ""} return after 1 [list $snd play -blocking 0] } set snd_click { UklGRrEHAABXQVZFZm10IBAAAAABAAEAESsAABErAAABAAgAZGF0YY0HAAB/f39/gICAgICAgICA f39/fn9/f4CAgICAf3+AgICBgYGBf359fX5/gIGChISEgX14dXZ6f4OFiIuMiYB2bm52foSHio+S k4x+bWBXY3mHjY2NlZqSg3NtcXp6eHd5goqLiY6Nf2tqeIKLnLGrhmJCOWF8h4+xvJJ3WTJTeX6E ja+/mH1qUE5lfoKIlsK6h3tbL2l/go28xIR9Qz15gIq9w31+Qjp2f4a0y4yBbkM9b3mDls6zgnY3 Q3d5goWSp8yxjoF4VRlVc3iHvdGGhVYlWnt6o9irf4NAKmh2fpnYuYOLRytleX2w2KKGg0cpYnZ9 sdaiiXc7Qmx0jsbAknUvT32Dw7uhhXo+NGF1g7LPpoqEWj9GYXV+jK3gq4+FVihab3uJv9OWjXdE MmJxjqGsr4xqXm96iH1zflphcoqyv4xvaVNpiZSAf4qCgIiloJh+TFRja259nbiphnxnbGJfdpKX maKPbl1fX26JnKOYe3BiaXqMinyHgn18fYeAe29xiot2fYiIi4h7dn+Fl6eMamNmcYGFg5Gbjn56 cHVzdYWXnpB+bmhgdIibqqWHbFpUYnGHm6igjXlrX1hohJWkjnd2e397en1/b2NufYKSoqqUe2hb VVtte5KjpKKhgmFaZ3B3f5GclYp/gnxyamdwgIyapaGOgXFdaHeBhYN9h5eMjImBfm1pfIJ/g46W iXx1cm92gYeKkZeNf3h7fGhbaHmAkamqnIt1X09Vb3+PoqSQhXFcYXGAhI+moYp2alZRbIKLm62t mHtkTk9hc4KVpKmehHBlXmh4hI6TlpOMdmpnaHOBi5OUjoRwcG5tfIWLj5GPgXl8fXyChICDeWpt d3qCiYyLjI2BfYJ9d3d3fIB/h4h+enh+g4OHhoKAeXV5gIOCgoOAfHd7gYeNj4+LgXNsam12foOM jYqLhoB+eXqDhYeMhHVtam55h4yNjYd/fH18fH6AgYGCgoWJhnxxbnR8g4uQjIN7eXt5e36AgYGE h4N8eXp+goSEg358e3l7gIGEh4WDgHl3eHqAhYeIhoJ7dnV3fYKEhoWDgHt8gYSGhX95dXV3fYSJ iYWDfXl6e31+gYSEg4SCfXp4d3Z5gYmNjIh+c3F0e4OHiYuKhX56eHh5fYGDg4F/fn1/hYaDgX16 eHl9gIOFh4mGgHx6d3Z6gYaJiIWCfXl4eXyBhIOBfn+Cg4SFg396dHJ0eoOLjouFgH57e36AgH58 enp7fYCFioiFgX17ent9fH+Cg4F/fn+Af3+AgYODg4OBfnt4d3l8foGFiYmGg4F/e3h2d3uAhIaH hYJ+e3t+gIGChIOAfXp5eXt+gIOFhoOCg4F+fX19fXx8fX6AgYKDgX9/goOCgH58e3l5fICDhYaF g4B9fn9+fXx8fH6AgoSFhYKAfnp6e35/gYKDgoB/f3+AgIGCgICAgIGBfnp4eHyAhouNi4V8c29x eYGIjY2Gfnh1eHyBg4ODg4F+fX5+fXt7fYCEiImGgXx2dHd9g4eIh4WBfXp5e36ChoaDf3p4eXx+ gYWGhYKAfXp7fH6Ag4SDf318fH1+gYSEgoB9fH1/goODgYB9e3t8gISIiIaAenZ2eX2Ch4qIhYB6 d3h6foGFh4aDgH17ent9f4GCg4OCgX9+fX19fXx9gIKEhYSBfnt6enx/g4SDgYB/fn59fX1+gIGB goOCf3x7fH1/gYODgH9/f39/gYGAf318e31/goOEhIJ/fHp6fYCDhYWDf3x6e32Ag4WFhIF+fHt8 fX+AgYOEhIF/fHp6fYGEhYWDf3t6e32Ag4aGg397enp7foCCg4OCgH9+fn5+f4CBgYGAf359fX5+ foGDhIWFgn57eHh6foKFhoSAfHp6fICEh4eDfnp4eHt/goSFhIF+fHx9gIKDgoF/fXx8fn+BgoKC gYCAf359foCAgYB/fn9/f4CBgYB+fn+AgYKCgX99fX1+gIGCgoGAfn18fX5/gYOEg4F+fHt7fX+C g4OCgH58fHx+gIOEhIOBfnx7e31/gYOEhIKAfXx8fn+AgYGAf35+f3+BgoKBgH99fX5/gIGBgYB/ fn1+f4GDg4OAfnx8fH6AgoODgX59fX5/gYGBgIB/f3+AgYGBgH9+fn5/f4CAgICAgH9+fX5+gIGC goF/fn19fX+AgoKCgYB/fn19foCBgoKAf359fn5/gIGBgIB/f39+fn5+f4CBgoKBgH9+fX1+gIGB gYGAgH9/fn9/f39/f3+AgICAgICAgIB/f39/f4CAgICAgICAgYCAf35+f39/gIGAgH9+fn5/gIGC goB/fn1+fn+AgYGAf39/f3+AgICAgIB/f39/f3+AgICAgICAgH9/fn5/f4CAgIB/f39/gICAgIB/ f35+fn9/gIGBgIB/f39/f39/f39/f39/f4CBgYGBgH9+fX1+gIGCgoGAfn5+fn+AgYGAf35+fn5/ gIGBgYB/f35+f3+AgICAf39/f3+AgICAgH9/f39/gICAf39/f3+AgICAgICAf39/f3+AgICAgICA f39/f39/gICAgIB/f4CAgH9/f39/f3+AgICAgICAf39/f4CAgICA } set snd_enter { UklGRkACAABXQVZFZm10IBAAAAABAAEAESsAABErAAABAAgAZGF0YRwCAACA gId0ZHZbU5aMj7/MsIZ6UX6nWIiITWiIRUGUlZesvrGCiKiKTl96Fit3YF5e mrGHqcqhlJuAdWxgW01EbWSHubW1uJ2MkqGPYFVSamtvgHmEh5ybraWLkHp5 Xm5oWGRvb3WSlYqMi4+JhY6Ac25xdXp5jYR/hoODdIN8e356goCHgoqGgIV/ g35/d3N2eHZ6gIOIgouHioaNioGAfHpycHp2dH2HiouNiYiKhIF9enZzd3l+ dX2BgYKIjoaJhIJ/fX6AfHl8fICAgICEgISFhYF/gH+AfIJ/gH6AfX6AfICA fYB+gn2DfoGAgIOAgYB8e3x9gIKChYCDgIN/g32Afn+BgIF+gH+BgIOAgX2C fYGAgIB/gH9/fIB/gICBgH+Df4KAgIB9gHuBfYKAgoCAhICDgIN+gH+Af4CA gIGAg4CFgIOAgICAgH9/f32AfoF/gn+BgICAf4B/gICAgICAgIKAgYCAgH+A fYB8f4CAgoGBgIKBgHt0cnqEi4yIhoKHioOBeoF+gHRvbW10eYSHhoyMmI+P hIF5dm9tbW92fICJjpKRkY6JhHx5b2xlbnWAhYeOjpSQkIiAe3R1cnNzdnx/ gomLj4yJhICAfHp3d3d6fYKDhoKGgIeAhX1/eXt9foCAg4GCg4CDfYF6gHmA fYCBgIR/h4CEf4B9fn98gHuEfYV/g4CAgn6Fe4R6gn1/gHuDe4V+g4CAgn8= } set totalcount 0; # initialize global to no images loaded yet Shapes ;# Load all our dot2dot shapes DoDisplay DoSounds DoDots -3 ;# Pick and show a puzzle ====== ---- [http://img849.imageshack.us/img849/3030/dottodothorsrtclwiki.gif] [gold] added pix ---- [uniquename] 2013aug01 The image above is at an 'external website' imageshack.us. Since links at such sites have a habit of going dead, here is an image of Vetter's GUI that is 'locally stored' on this wiki site. [vetter_dot2dot_screenshot_1015x663.jpg] Furthermore, note that this script provides a 'rubber-banding' feature: as lines are drawn to connect the dots, the line stretches until the user clicks on the next dot to complete the drawing of the next line segment. The code for doing this type of drawing on the Tk canvas may be of interest to various Tclers who make GUI's for drawing on the canvas. Also note that Vetter supplies Tcl lists of point coordinates for drawing about eleven different shapes: dolphin, elephant, horse, rabbit, snowman, etc. <> Application | Games | Tcl/Tk games