if 0 {Richard Suchenwirth 2003-09-13 - Updates by [Michael Jacobson] and [Jason Tang] 2003-11-24 
 (update in version 2.0 for computer AI opponents and PocketPC size)

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://mywebpages.comcast.net/jakeforce/Revello2.jpg] [http://mywebpages.comcast.net/jakeforce/Revello2-ce.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 2.1}
 set info "Revello v$::revello::version
    by Richard Suchenwirth
 AI Game Architect 
    by Jason Tang
 Computer Play updates
    by Michael Jacobson"
 
 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 1 -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 1
        $w create line $size2 $x $size3 $x -fill yellow -width 1
    }
    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
 }
 ### AI Stuff
 # Given the board matrix and who I am, return an integer indicating
 # how strong my position is.  Higher scores are better.
 proc revello::evalBoard {board me heurist_base heurist_edge heurist_edgepen \
                             heurist_inedge heurist_inedgepen \
                             heurist_outcen heurist_corner} {

    # Split the board into individual rows.
    foreach {row0 row1 row2 row3 row4 row5 row6 row7} $board {}
    
    # Next build a transverse of the board for efficiency.  As a side
    # effect of working entirely row-based, spaces along the edges are
    # counted twice -- once by the row calculation, again by the row_t
    # (i.e., column).  This is intentional.
    set board_t {}
    foreach a $row0 b $row1 c $row2 f $row5 g $row6 h $row7 {
        set l [list $a $b $c $f $g $h]
        lappend board_t $l
    }
    foreach {row0_t row1_t row2_t row3_t row4_t row5_t row6_t row7_t} \
        $board_t {}
    
    set score 0
    
    # Heuristic 0: sum the total of pieces I have on the board.
    foreach p [concat $row0 $row1 $row2 $row3 $row4 $row5 $row6 $row7] {
        if {$p == $me} {
            incr score $heurist_base
        }
    }
    
    set edges [concat $row0 $row7 $row0_t $row7_t]
    # Heuristic 1: board edges (row0, row7, row0_t, and row7_t).
    if {$heurist_edge > 0} {
        foreach p $edges {
            if {$p == $me} {
                incr score $heurist_edge
            }
        }
        # PENALTY points if I am on column (1|6) without also owning the
        # adjacent corner
        set penalty [expr {$heurist_edgepen - $heurist_edge}]
        foreach p {1 6 9 14 17 22 25 30} q {0 7 8 15 16 23 24 31} {
            if {[lindex $edges $p] == $me && [lindex $edges $q] != $me} {
                incr score $penalty
            }
        }
    }

    # Heuristic 2: inside edge (row1, row6, row1_t, row6_t).
    if {$heurist_inedge > 0} {
        set inedges [concat [lrange $row1 1 6] \
                       [lrange $row6 1 6] \
                       [lrange $row1_t 1 6] \
                       [lrange $row6_t 1 6]]
        foreach p $inedges \
        q {1 2 3 4 5 6 9 10 11 12 13 14 17 18 19 20 21 22 25 26 27 28 29 30} {
            if {$p == $me} {
                set outp [lindex $edges $q]
                # no points if I have an inside edge while opponent
                # has outside edge; PENALTY points if I have an inside
                # edge without also owning the outside edge
                if {$outp == $me} {
                    incr score $heurist_inedge
                } elseif {$outp == 0} {
                    incr score $heurist_inedgepen
                }
            }
        }
    }

    # Heuristic 3: outside center (row2, row5, row2_t, row5_t)
    if {$heurist_outcen > 0} {
        set outcen [concat [lrange $row2 2 5] \
                        [lrange $row5 2 5] \
                        [lrange $row2_t 2 5] \
                        [lrange $row5_t 2 5]]
        foreach p $outcen {
            if {$p == $me} {
                incr score $heurist_outcen
            }
        }
    }

    # Heuristic 4: get a bonus if I control the corner
    foreach p {0 7 8 15} {
        if {[lindex $edges $p] == $me} {
            incr score $heurist_corner
        }
    }
    return $score
 }

 # Performs an Alpha-Beta search to calculate the best move.  Returns a
 # 2ple of the format {bestMove bestScore} where bestMove is a 2ple
 # giving the {row,col} to which move.

 proc revello::getMoveAlpha {board who depth heurist_depth alpha beta \
                                heurist_base heurist_edge heurist_edgepen \
                                heurist_inedge heurist_inedgepen \
                                heurist_outcen heurist_corner} {
    if {$depth >= $heurist_depth} {
        return [revello::evalBoard $board $who \
                    $heurist_base $heurist_edge $heurist_edgepen \
                    $heurist_inedge $heurist_inedgepen \
                    $heurist_outcen $heurist_corner]
    }
    set possibleMoves [revello::hint $board $who]
    incr depth
    set opp [expr {3 - $who}]
    if {$possibleMoves == {}} {
        # opponent has no move, so no change to board
        set score [getMoveBeta $board $opp $depth $heurist_depth $alpha $beta \
                       $heurist_base $heurist_edge $heurist_edgepen \
                       $heurist_inedge $heurist_inedgepen \
                       $heurist_outcen $heurist_corner]
        if {$score > $alpha} {
            if {$score >= $beta} {
                return $score
            }
            set alpha $score
        }
    }
    update
    foreach move $possibleMoves {
    	#update
        set newBoard [revello::doMove $board $move $who]
        set score [getMoveBeta $newBoard $opp $depth $heurist_depth \
                       $alpha $beta \
                       $heurist_base $heurist_edge $heurist_edgepen \
                       $heurist_inedge $heurist_inedgepen \
                       $heurist_outcen $heurist_corner]
        if {$score > $alpha} {
            if {$score >= $beta} {
                return $score
            }
            set alpha $score
        }
    }
    return $alpha
 }

 proc revello::getMoveBeta {board who depth heurist_depth alpha beta \
                                heurist_base heurist_edge heurist_edgepen \
                                heurist_inedge heurist_inedgepen \
                                heurist_outcen heurist_corner} {
    if {$depth >= $heurist_depth} {
        return [revello::evalBoard $board $who \
                    $heurist_base $heurist_edge $heurist_edgepen \
                    $heurist_inedge $heurist_inedgepen \
                    $heurist_outcen $heurist_corner]
    }
    set possibleMoves [revello::hint $board $who]
    incr depth
    set opp [expr {3 - $who}]
    if {$possibleMoves == {}} {
        # opponent has no move, so no change to board
        set score [getMoveAlpha $board $opp $depth $heurist_depth $alpha $beta \
                       $heurist_base $heurist_edge $heurist_edgepen \
                       $heurist_inedge $heurist_inedgepen \
                       $heurist_outcen $heurist_corner]
        if {$score < $beta}  {
            if {$score <= $alpha} {
                return $score
            }
            set beta $score
        }        
    }
    update
    foreach move $possibleMoves {
    	#update
    	set newBoard [revello::doMove $board $move $who]
        set score [getMoveAlpha $newBoard $opp $depth $heurist_depth \
                       $alpha $beta \
                       $heurist_base $heurist_edge $heurist_edgepen \
                       $heurist_inedge $heurist_inedgepen \
                       $heurist_outcen $heurist_corner]
        if {$score < $beta}  {
            if {$score <= $alpha} {
                return $score
            }
            set beta $score
        }        
    }
    return $beta
 }

 # Given the particular AI and whose turn it is, returns a 2ple giving
 # the move selected.  If no move is possible returns an empty list.
 proc revello::getMove {board who ai} {
    set possibleMoves [revello::hint $board $who]
    if {$possibleMoves == {}} {
        return {}
    }
    
    # prepare the evaluation function
    foreach {name depth base edge edgepen inedge inedgepen outcen corner} $ai \
        break
    set results {}
    set alpha -10000
    set beta 10000
    foreach move $possibleMoves {
        set newBoard [revello::doMove $board $move $who]
        #puts -nonewline "trying $move..."
        set score [revello::getMoveAlpha $newBoard $who 0 $depth $alpha $beta\
                       $base $edge $edgepen $inedge $inedgepen $outcen $corner]
        #puts "  (done):  score $score"
        lappend results [list $move $score]
    }

    # find the best score and move; if there is a tie then randomly
    # pick one of the best
    set bestMoves [list [lindex [lindex $results 0] 0]]
    set bestScore [lindex [lindex $results 0] 1]
    foreach move [lrange $results 1 end] {
        set possibleMove [lindex $move 1]
        if {$possibleMove > $bestScore} {
            set bestScore $possibleMove
            set bestMoves [list [lindex $move 0]]
        } elseif {$possibleMove == $bestScore} {
            lappend bestMoves [lindex $move 0]
        }
    }
    #puts "best moves are:  $bestMoves"
    set bestMove [lindex $bestMoves \
                      [expr {int (rand () * [llength $bestMoves])}]]
    #puts "chosen move:  $bestMove"
    return $bestMove
 }

 # Actually executes a move for the AI.  If no move possible then
 # passes.
 proc revello::makeMove {who ai} {
    global Board Color  
    set move [revello::getMove $Board $who $ai]
    if {$move == {}} {
        ::pass
         set ::working 0
    } else {
        set Board [revello::doMove $Board $move $who]
        ::push ::Stack $Board
        set ::working 0
        set Color [expr {3 - $Color}]
    }
 }

 # format of AI players.  More positive scores are better for me.
 #        Name     Depth Base Edge EdgePenal InEdge InEdgePenal OutCen Corner
 set ai(0) {"Lennie"   0     1    0      0        0        0         0      8    }
 set ai(1) {"Mike"     1    -1   -2      1        0        0         0     -8    }
 set ai(2) {"Anita"    2     1    2     -3        1       -2         0      16   }
 set ai(3) {"Claire"   3    -2   -3      4       -2        3        -1     -20   }
 set ai(4) {"Jack"     4     1    8     -3        4       -2         2      24   }
 set ai(5) {"Adam"     4     1    6     -4        4       -3         4      16   }
 set ai(6) {"Donald"   5    -1    0      0        0        0         0     -12   }
 set ai(7) {"Arthur"   6     1    4     -4        2       -3         3      16   }

 # Usage:
 #   revello::makeMove who ai
 #
 # where:
 #   who - an integer, either 1 or black or 2 for white
 #   ai  - one of the predefined AI types from above
 #
 # Description of AIs:
 #
 #   Lennie:  fairly stupid AI, minimal strategy
 #   Mike:    conservative but short-sighted
 #   Anita:   balanced short-term game
 #   Claire:  defensive player
 #   Jack:    very aggresive
 #   Adam:    balanced long-term game
 #   Donald:  sacrifices positioning for points
 #   Arthur:  sacrifices points for positioning 

 #revello::makeMove 1 $ai1 ;# black
 #revello::makeMove 2 $ai4 ;# white
 set working  0
 set gameover 0
 proc ChangePlayer {args} {
 	global g ai
 	if {$::working} {#puts "still working";return}
 	if {$::gameover} {#puts "game is over";return}
	showColor .f.4 $::Color
	#puts "Color $::Color $args"
 	set c [lindex $g(color) $::Color]
 	set i [expr [lsearch $g(players) $g($c)] -1]
 	if {[revello::hint $::Board 1] == "" && [revello::hint $::Board 2] == ""} {
		#puts "end game detected"
		set ::gameover 1
		if {$::1 > $::2} {
			tk_messageBox -message "$g(black) (black) Wins!!!"
		} elseif {$::1 < $::2} {
			tk_messageBox -message "$g(white) (white) Wins!!!"
		} else {
			tk_messageBox -message "Tie Game - Try Again"		
		}
		return
	}	 
 	#puts "$c is $i"
 	if {$i != -1} {
 		set ::working 1
 		after 1000 [list revello::makeMove $::Color $ai($i)]
 	}
 }
 ### End AI Stuff

 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.}
 set g(color) [list none black white]
 set g(players) [list Human Lennie Mike Anita Claire Jack Adam Donald Arthur]
 proc main {} {
    global Board Color g                                    ;# Model M
    frame .t
    button .t.hint -text Hint -command {revello::displayHint .c $Board $Color}
    button .t.pass  -text Pass -command pass
    button .t.undo  -text Undo -command undo
    button .t.reset -text New  -command reset
    button .t.help  -text About -command {tk_messageBox -message $info}
    button .t.exit  -text X    -command exit
    eval pack [winfo children .t] -side left
        
    frame .f
    label .f.3 -text "Turn:"
    label .f.4 -width 2
    eval tk_optionMenu .f.pl g(black) [split $g(players)]
    .f.pl config -highlightthickness 0 -bd 0 -width 6
    label .f.1 -textvar 1 -width 3 -bg black -fg white
    eval tk_optionMenu .f.p2 g(white) [split $g(players)]
    .f.p2 config -highlightthickness 0 -bd 0 -width 6
    label .f.2 -textvar 2 -width 3 -bg white -fg black
    
    trace var Color w {ChangePlayer}
    trace var g(white) w {ChangePlayer}
    trace var g(black) w {ChangePlayer}
    eval pack [winfo children .f] -side left
    pack .t [revello::view .c] .f -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 ::gameover 0
    set ::Stack [list $::Board]
    ChangePlayer
 }
 proc showColor {w colnum args} {
    $w config -bg [lindex {- black white} $colnum]
 }
 proc undo {} {set ::Board [pop ::Stack]; pass}
 #-----------------------
 if {$tcl_platform(os)=="Windows CE"} {
	 wm geometry . "[join [wm maxsize .] x]+0+0"
 } else {
 	wm geometry . 240x285
 }
 main
 bind . <F2> {console show}
 wm title . "Revello v$::revello::version"
 wm resizable . 0 0

----
[male] - 2003-11-25:

Due to the PocketPC changes, Revello2 isn't sized right on Windows, so the board is bigger than the now not resizable window and the bottom UI elements are hidden.
----
[Category Games] | [Artificial Intelligence with Tcl]