if 0 { Richard Suchenwirth 2003-04-21: This little Tk game features a snake that creeps around its place, eating fruit where available and growing from it, while touching itself or eating poison mean sure death.

WikiDbImage TkSnake.jpg

package require Tk

set info "TkSnake 1.0 - Richard Suchenwirth 2003

Click 'New' to start.
Steer snake with cursor keys.
Snake dies if it touches itself.
Red fruit is good, makes snake grow.
Blue fruit is poison, makes snake die."

frame .f
button .f.1 -text New -command {reset .c}
button .f.2 -text Pause -command {set pause [expr {!$pause]}}
set pause 0
label .f.3 -textvar g(score) -background black -foreground green -width 6
checkbutton .f.4 -text Poison -variable g(poison)
eval pack [winfo children .f] -side left
canvas .c -bg lightgreen
.c create rect 5 5 235 235 -fill {} -width 3 -tag barrier
.c create text 20 20 -text $info -anchor nw -tag snake
eval pack [winfo children .] 
wm geometry . 240x300+0+0
bind . <Up>    {set g(direction) {0 -1}}
bind . <Down>  {set g(direction) {0  1}}
bind . <Left>  {set g(direction) {-1 0}}
bind . <Right> {set g(direction) {1  0}}
bind . <Return> {reset .c}

proc reset c {
    global g
    array set g {score 0 snake {} direction {0 -1} poison 0}
    $c delete snake food poison
    set x 100
    set y 140
    foreach i {1 2 3 4} {box $c $x [incr y -8]}
    somewhere $c food
    foreach event [after info] {after cancel $event}
    every 250 {move .c}

proc box {c x y} {
    global g
    set id [$c create rect [expr {$x-4}] [expr {$y-4}] \
        [expr {$x+4}] [expr {$y+4}] -fill darkgreen -tag snake]
    set g(snake) [linsert $g(snake) 0 $id]

proc every {ms body} {eval $body; after $ms [namespace code [info level 0]]}

proc somewhere {c tag} {
    set ok 0
    while {!$ok} {
        set x [expr {12+int(rand()*27)*8}]
        set y [expr {12+int(rand()*27)*8}]
        set closest [$c find closest $x $y 3]
        set tags [$c gettags $closest]
        if {$tags != "snake"} {incr ok}
    set color [expr {$tag eq {food}? {red} : {blue}}]
    $c create oval [expr {$x-3}] [expr {$y-3}] [
        expr {$x+3}] [expr {$y+3}] -fill $color -outline $color -tag $tag

proc move c {
    if $::pause return
    global g
    set neck [lindex $g(snake) 0]
    foreach {x0 y0 x1 y1} [$c bbox $neck] break
    foreach {fx fy} $g(direction) break
    set x [expr {($x1+$x0)/2 + 8*$fx}]
    set y [expr {($y1+$y0)/2 + 8*$fy}]
    set next [$c find closest $x $y 2]
    set target [$c gettags $next]
    if {$next == [lindex $g(snake) 1]} return ;# (1)
    if {$next == $neck} {set target ""}
    set fed 0
    switch -- $target {
        poison - snake {
            $c itemconfig snake -fill red
            $c create text 120 120 -text "GAME OVER" \
                -font {Helvetica 24 bold} -tag snake
        barrier {
            set g(direction) [list $fy $fx]
        food {
            set lsnake [llength $g(snake)]
            if {$g(score)<100 && $g(score)+$lsnake>100} {
                set g(poison) 1
            incr g(score) $lsnake
            $c delete food
            $c itemconfig snake -fill yellow
            after 200 $c itemconfig snake -fill darkgreen
            somewhere $c food
            if $g(poison) {somewhere $c poison}
            incr fed
    box $c $x $y
    if !$fed {
        $c delete [lindex $g(snake) end]
        set g(snake) [lrange $g(snake) 0 end-1]

if 0 {

escargo 2003-04-22: Note that hitting a cursor key that makes you go backward counts as hitting yourself and is instantly fatal. - RS: Thanks for testing and reporting! The added line marked (1) above changes the behavior to more intuitive: the snake stops when directed backward, and moves on when you hit another arrow key. An alternative to the [Pause] button.

escargo 2003-04-23: It occurred to me that snake-relative navigation would require only two cursor keys, left and right since you can't reasonably go backward and you are going forward by default. There are probably at least two mental styles of navigation, either absolute, where the keys indicate absolute direction (or direction relative to the playing field), and snake-relative, where the keys indicate a relative change in direction. Pressing the left arrow key multiple times in absolute navigation would make you turn left at most once. In snake-relative navigation, pressing the left arrow key multiple times would make you do counterclockwise circles or spirals.

I don't know what other snake games do, but it might be interesting to see how different modes of navigation affect play.