[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.

I've included a half-dozen or so puzzles that I copied off the web. Hidden only on a key-binding (<control-b>) is a build mode, that lets build your own puzzles. Build mode is not polished, but works well for the unimtimidated.

----

##+##########################################################################
#
# dot2dot.tcl
#
# A simple dot-to-dot game
# by Keith Vetter
#
# Revisions:
# KPV Oct 20, 2002 - initial revision
#
##+##########################################################################
#############################################################################

 set st(r1) 5                                    ;# Dot size
 set st(r2) 10                                   ;# Dot size when it's next
 set st(build) 0                                 ;# Build mode
 set st(which) -1                                ;# Which puzzle we're doing
 set ddata(done) 0
 
 set dots(0) {-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(0) {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}
 set dots(1) {-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(1) {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}
 set dots(2) {-69 -33 -90 33 -65 79 -68 165 -92 191 -60 191 -47 181 -41 108
    -24 150 -3 167 -34 191 68 191 77 178 108 174 123 148 126 96 143 26 136
    -14 116 -49 91 -22 77 9 101 75 99 115 58 16 9 -69 32 -68 26 -93 1 -114
    -9 -137 -36 -156 -50 -180 -61 -174 -57 -148}
 set extra(2) {l 7 -21 137 -22 121 -16 109 -7 97 10 92 22 93 32 97
    p 4 -3 -98 2 -84 23 -76 13 -92 c 3 -28 -122
    L 9 -57 -148 -71 -170 -80 -171 -80 -157 -77 -140 -78 -125 -78 -107
        -77 -81 -69 -33}
 set dots(3) {-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(3) {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
 }
 set dots(4) {
    -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(4) {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}
 
 proc DoDisplay {} {
    canvas .c -width 700 -height 600 -bd 2 -relief raised -highlightthickness 0
    focus .c
    frame .fb -bd 2 -relief ridge
    frame .fbuild -bd 2 -relief ridge
    button .restart -text Restart -command {DoDots -2}
    button .new -text "New Puzzle" -command {DoDots -1}
 
    button .clear -text Clear -command {GoBuildMode 1}
    button .copy -text "Copy to Clipboard" -command {Copy}
    button .undo -text Undo -command {M3Down -1 -1}
    pack .c -side top -fill both -expand 1
    pack .fb -side top -fill x -expand 1
    pack .new .restart -in .fb -side left -pady 5 -expand 1
    pack .clear .copy .undo -in .fbuild -side left -pady 5 -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-b> {GoBuildMode 0}
 }
 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 DoDots {{which -1}} {                      ;# Install a new puzzle
    global dots ddata st
 
    pack forget .fbuild
    if {$which == -2} {                         ;# Reuse last one
        set which $st(which)
    } elseif {$which == -1} {                   ;# Pick one at random
        catch {unset dots(new)}
        set d [array names dots]
        while {1} {
            set which [lindex $d [expr {int(rand() * [llength $d])}]]
            if {$which != $st(which)} break
        }
    }
    
    set st(build) 0                             ;# Turn off build mode
    set st(which) $which                        ;# Remember which puzzle
    .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 st
    foreach {x y} $ddata($n) break
    .c create oval [MakeBox $x $y $st(r1)] -tag d$n -fill black
    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 st
    if {$st(build) == 1 || $ddata(done)} return
    .c delete xline
    set x [.c canvasx $x] ; set y [.c canvasy $y]
    eval .c create line $ddata($ddata(last)) $x $y -tag xline
 }
 proc MDown {x y} {                              ;# Called on mouse click
    global ddata st dots
 
    set x [.c canvasx $x] ; set y [.c canvasy $y]
    if {$st(build)} {                           ;# Build dot2dot mode
        lappend dots(new) $x $y                 ;# Add to our list
        set ddata([incr ddata(last)]) [list $x $y]
        DrawOneDot $ddata(last)
        if {$st(build) == 1} {
            incr st(build)
        } else {
            .c coords build $dots(new)
        }
        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
    ConnectDot
 }
 proc M3Down {x y} {                             ;# Right-click == undo
    global st ddata dots
    if {$st(build) == 0} return                 ;# Not in build mode
    if {$ddata(last) == 0} return               ;# Nothing to undo
    
    set dots(new) [lrange $dots(new) 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 st(build) 1
        set ddata(last) 0
    } elseif {$ddata(last) > 1} {               ;# Some completed lines
        .c coords build $dots(new)
    }
    if {$x != -1} { MMove $x $y }
 }
 proc ConnectDot {{all 0}} {
    global ddata
 
    .c delete xline target
    while {1} {
        eval .c create line $ddata($ddata(last)) $ddata($ddata(next)) \
            -fill black -width 3
        incr ddata(last)
        incr ddata(next)
        if {$ddata(last) == $ddata(end)} {
            Done
            break
        } else {
            MakeTarget
        }
        if {! $all} break
    }
 }
 proc MakeTarget {} {                            ;# Draws where next click goes
    global ddata st
    .c delete target
 
    foreach {x y} $ddata($ddata(next)) break
    set xy [MakeBox $x $y $st(r2)]
    .c create oval $xy -tag target -fill green -outline green
 }
 proc Done {} {
    global st ddata dots
    
    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 lower done
 }
 
 proc GoBuildMode {clear {ifile ""}} {
    global st dots ddata
 
    if {! [winfo ismapped .fbuild]} {
        pack .fbuild -side bottom -fill x
    }
    .c delete done target
    if {$clear} {
        .c delete all
    }
    catch {unset ddata}
    set st(build) 1
    set ddata(last) 0
    set ddata(done) 0
    set dots(new) {} 
 
    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
    }    
    .c create line -tag build
 }
 proc Copy {} {
    global st dots ddata
 
    regsub -all {\.0} $dots(new) {} dots(new)
    clipboard clear
    clipboard append $dots(new)
    set st(build) 1
    set ddata(last) 0
    set ddata(done) 0
    set dots(new) {} 
 }
 DoDisplay
 DoDots -1                                       ;# Pick one at random

----
[Category games] - [Tcl/Tk games] - [Category Applications]