if 0 {[Richard Suchenwirth] 2003-09-13 - This simple yet interesting
game was sold under the trademarks Reversi or Othello; the blend of
the two names, "Revello", might be better suited for a free game. On an
8x8 board, players place tokens, which are black on one side and white on
the other, so that they enclose a horizontal, vertical, or diagonal
stretch of tokens of the opponent's color on both sides, and can then reverse
them to their own color. Only moves where tokens are reversed are
valid, but one may pass.

[http://mini.net/files/revello.jpg]

In this Tcl implementation I have tried to follow the [Model / View /
Controller] pattern. The '''model''' here is obviously the state of the
board, plus the information which player's turn it is (initially, always
black). The board is a square matrix, which in Tcl can be efficiently represented
as a list of lists. See ''initBoard'' for the initial setup as example,
where colors are coded as 0 (empty), 1 (black), 2 (white).
}
 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} {
    upvar #0 $boardName board  $colorName color
    set tag [lindex [$w gettags current] 1] ;# row,col
    set pos [join [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
 }
 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 [bind]ing 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''.
----
[Category Games] | [Arts and crafts of Tcl-Tk programming]