Here's an version of Conway's Game of Life I recently updated to use Snit's Not Incr Tcl; I'm posting it now as an example of application development using Snit. -- WHD
10/21/2002: To update this for Snit V0.7, I replaced "argv" with "args" throughout. -- WHD
2/8/2003: I've updated this for Snit V0.8. -- WHD
#-----------------------------------------------------------------------
# TITLE:
# life.tcl
#
# AUTHOR:
# Will Duquette
#
# DESCRIPTION:
# life.tcl implements John Conway's classic Game of Life, one of
# the first experiments with what's now called artificial life.
#
# Think of a plane divided up into squares like a checker board.
# Each square can hold a one-celled animal. You start the game
# by placing cells in squares. Then you watch the cells breed
# and die through successive generations. The game is to find
# starting patterns that do interesting things.
#
# Each square on the board has 8 neighbor squares; cells breed
# and die based on how crowded they are, i.e., the number of
# neighbors they have. Each new generation is computed as
# follows:
#
# For each square, count the number of neighbor cells.
# If the square is empty, and it has exactly 3 neighbor cells, a
# new cell will be born there. If the square has a cell in it,
# and the cell has less than 2 or more than 3 neighbor cells,
# the cell will die. All of the counting is done first, and
# then the new cells are added and the dead cell are removed all
# at once.
#
# This GUI implementation allows cells to be added and removed
# by clicking on the board. A generation passes when the
# "Generate" button is clicked, or when the player presses the
# Return key.
#
# The implementation has two pieces:
#
# 1. The board, which contains cells that can be turned on
# and off and knows how to compute a new generation. The board
# includes its own GUI display code.
#
# 2. The rest of the GUI.
#
# If the code were written for reuse, the board would be split into
# two pieces: a generic gameboard suitable for Life, Othello, and
# similar games, and Life code that uses the board.
package require snit 0.8
#-----------------------------------------------------------------------
# The Board
#
# The Board is implemented as a Tk canvas widget, broken up into
# squares on an NxN grid. The background is white and the grid
# lines are cyan. Each square holds a circle object which
# can be set to any desired color, normally white (for dead cells) and
# forestgreen (for living cells). Each circle has a tag "i,j" so that
# it can be manipulated individually.
snit::widgetadaptor board {
# This is still a canvas; delegate other methods and options to it:
delegate method * to hull
delegate option * to hull
# By default, 20x20 cells
option -cells 20
# By default, each cell is 20x20 pixels
option -pixels 20
# Milliseconds between generations
option -delay 200
# For each cell on the board, this array remembers
# whether the cell is alive or dead, and the coordinates of its
# neighbors; this allows the neighbors to be counted more quickly.
variable data
# Remembers the list of i,j indices, to save time while generating.
variable indices {}
# True if we're completely constructed, false otherwise.
variable constructed 0
constructor {args} {
# FIRST, create the canvas. Then configure the options.
installhull [canvas $self -background white]
$self configurelist $args
# NEXT, set up the board.
$self SetupBoard
# No longer constructing.
set constructed 1
}
onconfigure -cells {value} {
set options(-cells) $value
if {$constructed} {
$self SetupBoard
}
}
onconfigure -pixels {value} {
set options(-pixels) $value
if {$constructed} {
$self SetupBoard
}
}
method SetupBoard {} {
# Destroy any previous definition
$self delete all
array unset data
set cells $options(-cells)
set pixels $options(-pixels)
set size [expr {$cells * $pixels}]
# FIRST, set the size of the canvas
$hull configure -width $size -height $size
# NEXT, draw the grid lines.
for {set i 1} {$i < $cells} {incr i 1} {
set pos [expr {$i * $pixels}]
# Draw a vertical line $i cells over
$hull create line 0 $pos $size $pos -fill cyan
# Draw a horizontal line $i cells down
$hull create line $pos 0 $pos $size -fill cyan
}
# NEXT, compute the list of indices
set indices {}
for {set i 0} {$i < $cells} {incr i 1} {
for {set j 0} {$j < $cells} {incr j 1} {
lappend indices $i,$j
}
}
# NEXT, add a circle object to each cell
for {set i 0} {$i < $cells} {incr i 1} {
for {set j 0} {$j < $cells} {incr j 1} {
# Compute the upper left corner of the circle
set p0 [expr {$i*$pixels + 1}]
set q0 [expr {$j*$pixels + 1}]
# Compute the lower left corner of the circle
set p1 [expr {$p0 + $pixels - 2}]
set q1 [expr {$q0 + $pixels - 2}]
# Create the circle, tagging it $i,$j
$hull create oval $p0 $q0 $p1 $q1 \
-tag $i,$j -fill white -outline white
# When the user clicks on it, it should toggle.
$hull bind $i,$j <Button> [list $win toggle $i,$j]
# Initialize the corresponding data structure
set data($i,$j) 0
# Cache the coordinates of each neighbor.
set data($i,$j-neighbors) ""
foreach {iof jof} {-1 -1 -1 0 -1 1 0 -1
0 1 1 -1 1 0 1 1} {
set r [expr {($i + $iof) % $cells}]
set c [expr {($j + $jof) % $cells}]
lappend data($i,$j-neighbors) "$r,$c"
}
}
}
}
# toggle ij
#
# Toggles cell i,j on the board.
method toggle {ij} {
# FIRST, toggle the cell in the array.
if {$data($ij) == 0} {
$self setcell $ij
} else {
$self clearcell $ij
}
}
# setcell ij
#
# Sets cell ij to alive
method setcell {ij} {
$hull itemconfigure $ij -fill forestgreen
set data($ij) 1
}
# clearcell ij
#
# Clears (kills) cell i,j
method clearcell {ij} {
$hull itemconfigure $ij -fill white
set data($ij) 0
}
# clear
#
# Sets the board cells to all dead
method clear {} {
foreach ij $indices {
if {$data($ij)} {
$self clearcell $ij
}
}
}
# generate
#
# The generate function takes the cells on the board through one
# generation.
method generate {} {
# Count the neighbors of each cell. During start up we cached the
# coordinates of the neighbors of each cell, so now we can just
# iterate over them quickly.
foreach ij $indices {
set nCount 0
foreach neighbor $data($ij-neighbors) {
incr nCount $data($neighbor)
}
set count($ij) $nCount
}
# Set the new contents of each cell based on the count.
set changes 0
foreach ij $indices {
if {$count($ij) < 2 || $count($ij) > 3} {
if {$data($ij)} {
# Cell is dead
$self clearcell $ij
incr changes
}
} elseif {$count($ij) == 3} {
# Cell is born, if there wasn't one
if {!$data($ij)} {
$self setcell $ij
incr changes
}
}
}
return $changes
}
# run
#
# Generate indefinitely.
method run {} {
if {[$self generate] > 0} {
after $options(-delay) [list $self run]
}
}
# stop
#
# Stop running
method stop {} {
after cancel [list $self run]
}
}
#-----------------------------------------------------------------------
# The Main GUI
#
# This GUI really just adds a toolbar to the basic board; in a sense,
# it's inheriting and extending the board.
snit::widget lifegame {
# Delegate -cells and -pixels to the board, so that clients can
# specify the board size; delegate other options to the hull.
delegate option -cells to board
delegate option -pixels to board
delegate option * to hull
# Frames don't have any methods but configure and cget, which are
# already taken care of; so delegate everything else straight to the
# board.
delegate method * to board
constructor {args} {
frame $win.boardframe -borderwidth 5 -relief ridge
set board [board $win.boardframe.board]
pack $win.boardframe.board
pack $win.boardframe -side bottom -padx 2 -pady 2
bind . <Return> [mymethod generate]
frame $win.bar
$self addbtn "Generate" generate
$self addbtn "Run" run
$self addbtn "Stop" stop
$self addbtn "Clear" clear
button $win.bar.exit -text "Exit" -command exit
pack $win.bar.exit -side right -padx 2 -pady 2
pack $win.bar -side top -fill x
# Configure the options
$self configurelist $args
}
# Private method: add a button to the toolbar
method addbtn {text method} {
button $win.bar.$method -text $text -command [mymethod $method]
pack $win.bar.$method -side left -padx 2 -pady 2
}
}
#-----------------------------------------------------------------------
# The Main program
lifegame .lifegame -cells 40 -pixels 15
pack .lifegame -side bottom -fill both -padx 2 -pady 2