Updated 2015-02-08 13:24:10 by dkf

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.

 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.