namespace eval revello {set version 0.1}
proc revello::initBoard {} {
return {{0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0}
{0 0 0 2 1 0 0 0}
{0 0 0 1 2 0 0 0}
{0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0}
{0 0 0 0 0 0 0 0}}
}if 0 {The model is implemented in pure Tcl, no Tk (yet). The central function takes a board state, a position (e.g. {0 7} for the top right corner) and the current player's color, tests in all eight directions which opponent tokens can be reversed, and returns the list of their positions. An empty list marks an illegal move. } proc revello::testMove {board position color} {
if [lindex $board $position] return ;# must be a 0 field
foreach {row col} $position break
set opponent [expr {3-$color}]
set res {}
foreach direction {{-1 -1} {-1 0} {-1 1}
{0 -1} {0 1}
{1 -1} {1 0} {1 1}} {
foreach {dy dx} $direction break
set stack {}
for {set y [expr {$row+$dy}]; set x [expr {$col+$dx}]} \
{$x>=0 && $x<8 && $y>=0 && $y<8} {incr x $dx; incr y $dy} {
switch -- [lindex $board $y $x] \
$opponent {lappend stack [list $y $x]} \
$color {lappend res $stack; break} \
0 {break}
}
}
join $res
}if 0 {A move is done by just "flipping" the applicable tokens, and placing the new token in the specified position. The new state of the board is returned, or an error thrown if the move was invalid. } proc revello::doMove {board position color} {
set flips [testMove $board $position $color]
if {![llength $flips]} {error "invalid move"}
foreach flip [lappend flips $position] {
lset board $flip $color
}
set board
}if 0 {This utility reports all possible moves for a given board and player:} proc revello::hint {board color} {
set res {}
foreach row {0 1 2 3 4 5 6 7} {
foreach col {0 1 2 3 4 5 6 7} {
set pos [list $row $col]
if {[llength [testMove $board $pos $color]]} {
lappend res $pos
}
}
}
set res
}if 0 {So far for the model - it is actually playable, if you render board states with join $board \n, or could be regression-tested. But of course we want a pretty view in Tk, namely on a canvas. First, draw the board, and ovals at all positions (they will be invisible, if filled in background color, or white or black depending on board state). } proc revello::view {w {size 32} {bg green4}} {
set side [expr {$size * 9}]
set size2 [expr {$size / 2}]
set size3 [expr {$side - $size2}]
canvas $w -background $bg -height $side -width $side
set y $size2
foreach row {0 1 2 3 4 5 6 7} {
set x $size2
foreach col {0 1 2 3 4 5 6 7} {
$w create oval $x $y [expr $x+$size] [expr $y+$size] \
-width 2 -outline $bg -tag "pos $row,$col"
incr x $size
}
incr y $size
}
for {set x $size2} {$x<$side} {incr x $size} {
$w create line $x $size2 $x $size3 -fill yellow -width 2
$w create line $size2 $x $size3 $x -fill yellow -width 2
}
set w
}if 0 {Displaying the board state is very straightforward, as we can address tokens by their row,column coordinates, that were assigned as tags on creation. For use in a trace, the board is passed by name, and additional arguments added by the trace are ignored.} proc revello::display {w score1 score2 boardName args} {
upvar 1 $boardName board $score1 1 $score2 2
set colors [list [$w cget -bg] black white]
foreach i {0 1 2} {set $i 0} ;# fancy variable names? ...
foreach row $board r {0 1 2 3 4 5 6 7} {
foreach col $row c {0 1 2 3 4 5 6 7} {
$w itemconfig $r,$c -fill [lindex $colors $col]
incr $col ;# ... that's why!
}
}
}
proc revello::displayHint {w board color} {
foreach pos [hint $board $color] {
$w itemconfig [join $pos ,] -fill green
}
}if 0 {Finally, as controller we use the mouse, which the player left-clicks at the desired position. } proc revello::click {w boardName colorName} {
if [info exists ::lock] return
set ::lock ""
after 500 [list unset ::lock]
upvar #0 $boardName board $colorName color
set tag [lindex [$w gettags current] 1] ;# row,col
set pos [split $tag ,]
if [catch {set board [doMove $board $pos $color]}] {
set fill [$w itemcget $tag -fill]
$w itemconfig $tag -fill red ;# briefly flash bad moves
after 500 [list $w itemconfig $tag -fill $fill]
return ;# nothing, to prevent pushing
}
set color [expr {3-$color}]
set board
}if 0 {Now to put the pieces together: create the view and model, and "wire" the connections between them: a trace updates the view when the model has changed, and a binding lets the controller change the model. Also, an undo stack is introduced.} proc main {} {
global Board Color ;# Model M
frame .f
label .f.p1 -text "Player 1:"
label .f.1 -textvar 1 -width 3 -bg white
label .f.p2 -text "Player 2:"
label .f.2 -textvar 2 -width 3 -bg white
label .f.3 -text "To play:"
label .f.4 -width 2
trace var Color w {showColor .f.4 $::Color}
button .f.hint -text Hint -command {revello::displayHint .c $Board $Color}
button .f.pass -text Pass -command pass
button .f.undo -text Undo -command undo
button .f.reset -text New -command reset
eval pack [winfo children .f] -side left
pack .f [revello::view .c] -fill x ;# View V
trace var Board w {revello::display .c ::1 ::2} ;# M->V
bind .c <1> {push Stack [revello::click .c Board Color]};# C->M
reset
}
proc pass {} {set ::Color [expr {3-$::Color}]}
proc pop stackName {
upvar 1 $stackName stack
if {[llength $stack] < 2} {error "empty stack"}
set stack [lrange $stack 0 end-1]
lindex $stack end
}
proc push {stackName value} {
upvar 1 $stackName stack
if [llength $value] {lappend stack $value}
}
proc reset {} {
set ::Board [revello::initBoard]
set ::Color 1
set ::Stack [list $::Board]
}
proc showColor {w colnum args} {
$w config -bg [lindex {- black white} $colnum]
}
proc undo {} {set ::Board [pop ::Stack]; pass}#-----------------------main
[SSA] 16 Sept 2003: I got interested in playing the game...but found that if a user double-clicks a square then a persistent red circle (or oval) is drawn. A bug (or a feature)? - RS: Non-robustness bug on my side - marking a bad move is done by coloring it first red, then after 500 the original color. The second click takes red to be the original color... Fixed by introducing a lock in revello::click.
MPJ: Also see Revello2 for a version with computer AI opponents.
Category Games | Arts and crafts of Tcl-Tk programming
