Posted to tcl by hardkorebob at Fri Aug 07 18:01:40 GMT 2026view pretty
# plugins/snake.tcl ? classic Snake game inside a buffer
#
# :eval snake ? start or switch to the game
# Arrow keys ? change direction
# Escape ? quit
namespace eval Snake {
variable buffer_name "*snake*"
variable container ""
variable canvas ""
variable direction "right"
variable snake {} ;# list of {x y} head first
variable food {}
variable score 0
variable interval 150 ;# ms between moves
variable after_id ""
variable game_over 0
}
# ----------------------------------------------------------------------
# Public command
# ----------------------------------------------------------------------
proc snake {} {
set bufname $::Snake::buffer_name
if {$bufname ni $Core::buffer_list} {
Core::SwitchToBuffer $bufname
Snake::SetupUI
} else {
Core::SwitchToBuffer $bufname
}
}
Core::PluginAddCommand snake
# optional keybinding (uncomment if desired)
# Core::PluginBindKey CoreText <Control-x>s { snake; break }
# ----------------------------------------------------------------------
# Build the game UI inside the buffer's container
# ----------------------------------------------------------------------
proc Snake::SetupUI {} {
variable container
variable canvas
set wid [dict get $Core::buffer_widget $::Snake::buffer_name]
set container ".workspace.$wid"
if {![winfo exists $container]} return
set ::Snake::container $container
# Remove old content
foreach child [winfo children $container] {
pack forget $child
}
catch { destroy $container.game }
frame $container.game -bg "#1e1e1e"
pack $container.game -fill both -expand true
set canvas [canvas $container.game.canvas -bg "#111111" -highlightthickness 0]
pack $canvas -fill both -expand true
# Bind arrow keys to direction changes
foreach key {Up Down Left Right} {
bind $canvas <Key-$key> [list Snake::SetDirection [string tolower $key]]
}
bind $canvas <Escape> [list Snake::Quit]
# Start the game
Snake::NewGame
focus $canvas
}
# ----------------------------------------------------------------------
# Initialise / reset game state
# ----------------------------------------------------------------------
proc Snake::NewGame {} {
variable snake
variable food
variable score
variable direction
variable game_over
variable after_id
# Cancel any existing game loop
if {$after_id ne ""} { after cancel $after_id; set after_id "" }
set direction "right"
set score 0
set game_over 0
# Initial snake in the middle of the canvas
set center_x 20
set center_y 15
set snake [list [list $center_x $center_y] \
[list [expr {$center_x - 1}] $center_y] \
[list [expr {$center_x - 2}] $center_y]]
Snake::PlaceFood
Snake::Draw
Snake::StartLoop
}
# ----------------------------------------------------------------------
# Place food at a random cell not occupied by the snake
# ----------------------------------------------------------------------
proc Snake::PlaceFood {} {
variable snake
variable food
variable canvas
set w [expr {[winfo width $canvas] / 20}]
set h [expr {[winfo height $canvas] / 20}]
if {$w < 1 || $h < 1} { set w 30; set h 20 } ;# fallback
while 1 {
set fx [expr {int(rand() * $w)}]
set fy [expr {int(rand() * $h)}]
set occupied 0
foreach seg $snake {
if {[lindex $seg 0] == $fx && [lindex $seg 1] == $fy} {
set occupied 1
break
}
}
if {!$occupied} break
}
set food [list $fx $fy]
}
# ----------------------------------------------------------------------
# Redraw the canvas
# ----------------------------------------------------------------------
proc Snake::Draw {} {
variable canvas
variable snake
variable food
variable score
$canvas delete all
set cellSize 20
# Draw food
if {[llength $food] == 2} {
set fx [expr {[lindex $food 0] * $cellSize}]
set fy [expr {[lindex $food 1] * $cellSize}]
$canvas create rectangle $fx $fy [expr {$fx + $cellSize}] [expr {$fy + $cellSize}] \
-fill red -outline ""
}
# Draw snake
foreach seg $snake {
set x [expr {[lindex $seg 0] * $cellSize}]
set y [expr {[lindex $seg 1] * $cellSize}]
$canvas create rectangle $x $y [expr {$x + $cellSize - 1}] [expr {$y + $cellSize - 1}] \
-fill #00ff00 -outline ""
}
# Score
$canvas create text 5 5 -text "Score: $score" -fill white -anchor nw -font {Courier 12 bold}
}
# ----------------------------------------------------------------------
# Game loop
# ----------------------------------------------------------------------
proc Snake::StartLoop {} {
variable after_id
variable interval
set after_id [after $interval Snake::Move]
}
proc Snake::Move {} {
variable game_over
if {$game_over} return
variable direction
variable snake
variable food
variable score
variable canvas
# Determine new head position
set head [lindex $snake 0]
set x [lindex $head 0]
set y [lindex $head 1]
switch $direction {
"up" { incr y -1 }
"down" { incr y 1 }
"left" { incr x -1 }
"right" { incr x 1 }
}
# Check collision with walls
set gridW [expr {[winfo width $canvas] / 20}]
set gridH [expr {[winfo height $canvas] / 20}]
if {$gridW < 1} { set gridW 30 }; if {$gridH < 1} { set gridH 20 }
if {$x < 0 || $x >= $gridW || $y < 0 || $y >= $gridH} {
Snake::GameOver
return
}
# Check collision with self
foreach seg $snake {
if {[lindex $seg 0] == $x && [lindex $seg 1] == $y} {
Snake::GameOver
return
}
}
# Add new head
set snake [linsert $snake 0 [list $x $y]]
# Check food
if {[llength $food] == 2 && [lindex $food 0] == $x && [lindex $food 1] == $y} {
incr score
Snake::PlaceFood
# Do not remove tail -> grow
} else {
# Remove tail
set snake [lrange $snake 0 end-1]
}
Snake::Draw
Snake::StartLoop
}
# ----------------------------------------------------------------------
# Change direction (ignore opposite direction to avoid self-collision)
# ----------------------------------------------------------------------
proc Snake::SetDirection {newdir} {
variable direction
set opposite [dict get {up down down up left right right left} $newdir]
if {$newdir ne $opposite || [llength $::Snake::snake] == 1} {
set direction $newdir
}
}
# ----------------------------------------------------------------------
# Game over ? show message, stop loop, allow restart
# ----------------------------------------------------------------------
proc Snake::GameOver {} {
variable game_over
variable after_id
set game_over 1
if {$after_id ne ""} { after cancel $after_id; set after_id "" }
Snake::Draw ;# to show final state
# Display "Game Over" overlay
$::Snake::canvas create text [expr {[winfo width $::Snake::canvas] / 2}] \
[expr {[winfo height $::Snake::canvas] / 2}] \
-text "GAME OVER\nScore: $::Snake::score\nPress any arrow key to restart" \
-fill white -font {Courier 14 bold} -justify center
# Bind any arrow key to restart
foreach key {Up Down Left Right} {
bind $::Snake::canvas <Key-$key> [list Snake::NewGame]
}
}
# ----------------------------------------------------------------------
# Quit the game and kill its buffer
# ----------------------------------------------------------------------
proc Snake::Quit {} {
variable after_id
if {$after_id ne ""} { after cancel $after_id; set after_id "" }
Core::KillBuffer $::Snake::buffer_name
}
# ----------------------------------------------------------------------
# Cleanup hooks (always return empty to allow killing)
# ----------------------------------------------------------------------
proc Snake::OnKillBuffer {bufname} {
if {$bufname eq $::Snake::buffer_name} {
variable after_id
if {$after_id ne ""} { after cancel $after_id; set after_id "" }
set ::Snake::game_over 1
set ::Snake::container ""
}
return ""
}
Core::PluginAddHook kill-buffer-hook Snake::OnKillBuffer
proc Snake::OnSwitchBuffer {bufname} {
if {$bufname eq $::Snake::buffer_name} {
after idle Snake::SetupUI
}
}
Core::PluginAddHook switch-buffer-hook Snake::OnSwitchBuffer
# ----------------------------------------------------------------------
# Reload safety
# ----------------------------------------------------------------------
proc Snake::Init {} {
if {$::Snake::buffer_name in $::Core::buffer_list} {
Snake::SetupUI
}
}
Snake::Init