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}}
}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
}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
}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
}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 26} {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
}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
}
}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 StuffNow 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 0male - 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. (MPJ): Fixed.
