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