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 [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=="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
return
}
barrier {
set g(direction) [list $fy $fx]
return
}
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]
}
}escargo 22 Apr 2003 - 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 23 Apr 2003 - 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.
