##+##########################################################################
#
# 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]
}
eval pack [winfo children .top] -side left -fill y
focus .c
pack .c -side left -fill both -expand 1
bind .c <Motion> [list MMove %x %y]
bind .c <Button-1> {MDown %x %y}
bind .c <Button-3> {M3Down %x %y}
bind .c <Leave> {.c delete xline}
bind .c <Configure> {ReCenter %W %h %w}
bind .c <Control-s> {ConnectDot 1}
bind .c <Control-a> ConnectDot
bind all <Alt-c> {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"
eval 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 <Configure> 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"} {eval 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)} {
eval .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
eval 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
eval 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 puzzleStatistics: Posted by loozer — Thu May 26, 2005 6:55 pm
]]>