##+##########################################################################
#
# 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 <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"
   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"} {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