Updated 2007-05-14 09:16:57 by suchenwi

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.

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} {
     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