''I was going to do a sophisticated implementation in Lisp, but Tcl let me hack this together in two nights...'' [http://mini.net/files/mancala.jpg] Mancala (or Mankala) is an ancient african board game with many variations. Here is an implementation based on an Egyptian version. It doesn't have a sophisticated computer play algorithm (''proc gen-best-move'' is my excuse for recursive look ahead intelligence), but is yet another example of [Street Programming] in Tcl. -- [Todd Coram] [Sarnold] 30May2005 -- I had fun with that game and wanted to improve : * the global speed (array replaced by flat list to represent the board) * the GUI : it was possible to play with any pit, now it is only possible with the bottom line * the algorithm : see proc ''gen-best-move'' and ''gen-worst-move'' (sorry for the cut'n'paste) 4June2005 -- I fixed some bugs : * when the opponent put his last stone into your store, he would be allowed to move again. Now he isn't. * the status bar wasn't actualized when the game was over, or when a new game began. * when you put a stone into the opponent's store, the next stone went back to the first pit of the opponent. ---- set HELPMSG { Mancala - an ancient african board game. Version 0.99a By Todd Coram (tcoram@pobox.com) I couldn't find anyone to play Mancala with me, so I thought that I would teach a computer how to. Sad, isn't it? Mancala is played on a board with 12 pits (cups, bowls, whatever) and 2 stores (which hold captured stones). There are 2 players and each is presented with 6 pits and 1 store (positioned to the right of the pits). In each pit there are initially 3 stones. Rules (This implementation follows the Egyptian rules): The goal is to get as many of these stones into your store as possible. The player with the most stones at the end of the game wins. The game is over when one player's 6 pits are empty. A player moves by taking all of the stones from a pit and dropping them (one by one) into the pits to the right. If the player runs out of pits, a stone is dropped into the store. If there are still more stones, the player continues distributing the stones in a counter-clockwise fashion into the opponents pits (or store). During a play, if the last stone you drop is placed into an empty pit on your side, you capture your opponents stones in the pit opposite your empty pit. If you do capture some opponent stones, you take them and your last stone and place them all into your store. If your last stone is dropped in your store, you get to move again. At the end of the game, just to make things more interesting, the player with stones remaining in their pits may take all of those stones and add them to their own store! You just can't try to clear out your side of the board. You may lose by doing so. How to play this simulation: Choose a Level (the higher the number, the longer it takes the computer to make a move) and press "New Game". You move first. You make a move by clicking on any of the stones in the bottom row. } # small utility procs # finds a pit's stones with its side (0=human,1=computer) # and its position (0..5) proc get {board side pos} { return [lindex $board [expr {6*$side+$pos}]] } # just give an index, given a side and a pit's position proc pos {side pos} { return [expr {6*$side+$pos}] } # Create a board as a list with sides (players) '0' and '1'. Each pit # is indexed as 'side*6+pit' (pit is between 0 and 5). The stores are # end-$side : end for human and end-1 for computer . # proc make-board {} { foreach side {0 1} { foreach pit {0 1 2 3 4 5} { lappend board 3 } } lappend board 0 0 return $board } # The basic mechanism behind making a legal move. # Given board as a list and a target pit to move # (e.g. 0 2) and an optional update command, make a move. # -1 is returned if the player tries and move an empty pit. # Otherwise a modified board is returned as a flattened array along with # a flag indicating whether or not the player can play again. # proc move {board player pit {update_stones {}}} { set go_again 0 set side $player set stones [get $board $side $pit] if {$stones == 0} { error "no stones! $player,$pit" } set orig_pit $pit set orig_side $side set opp [opponent $side] incr pit while {$stones > 0} { incr stones -1 lset board [pos $orig_side $orig_pit] [expr {[get $board $orig_side $orig_pit]-1}] if {$pit >= 6} { # in that case we put a stone into one of the 2 stores. lset board end-$side [expr {[lindex $board end-$side]+1}] # when we put the last stone into the store of the opponent, # it should be the turn of the opponent set go_again [expr {$side==$player || $stones}] set side [opponent $side] set pit 0 } else { set go_again 0 lset board [pos $side $pit] [expr {1+[get $board $side $pit]}] # See if we captured any opponent stones # if {$stones==0 && $player==$side && [get $board $side $pit] == 1} { if {$update_stones != {}} { eval $update_stones [list $board] update idletasks after 500 } set board [capture_opposite $board $side $opp $pit] } incr pit } if {$update_stones != {}} { eval $update_stones [list $board] update idletasks after 500 } } return [list $go_again $board] } proc capture_opposite {board side opp my_pit} { set their_pit [expr {5-$my_pit}] if {[get $board $opp $their_pit] != 0} { lset board end-$side \ [expr {[lindex $board end-$side]+ [get $board $opp $their_pit]\ +[get $board $side $my_pit]}] lset board [pos $side $my_pit] 0 lset board [pos $opp $their_pit] 0 } return $board } # The computer's algorithm for making a move. If you have a better algorithm # this is where you would plug it in. # Given a board, the player you are generating the move for, an initial side # (usually the player) and a a nesting level (the number of moves to # look ahead), return a list consisting of the 'pit' and 'profit' chosen # as the best move. # proc gen-best-move {board player side {nest 2}} { if {$player!=$side} { # the opponent's hit is being guessed # finds the best move for the opponent so that # he can't hurt, because the profit is finally taken into account return [gen-worst-move $board $player $side $nest] } set best {-1 -100}; # {pit profit} foreach pit {0 1 2 3 4 5} { update; # give up CPU once in a while if {[get $board $side $pit] != 0} { if {[lindex $best 0] == -1} { set best [list $pit -100];# worst case: we have a valid pit } foreach {go_again mod_board} [move $board $side $pit] break if {$nest == 0} { # We have exhausted all moves starting at this pit... set profit [profit $mod_board $player] if {[lindex $best 1] < $profit} { set best [list $pit $profit];# save the best profit of all } } if {$nest > 0} { # try next move as opponent (or self if you can go again). set opp [expr {$go_again ? $side : [opponent $side]}] foreach {c profit} \ [gen-best-move $mod_board $player $opp [expr {$nest-1}]] \ break if {[lindex $best 1] < $profit} { set best [list $pit $profit];# best profit for pit } } } } return $best } # gen-worst-move : # generates a bad move for the player, but indeed a good one for the opponent # The player tries to guess what best hits are for each opponent, # meaning the opponent would surely do the worse to the player # args & return : same as gen-best-move proc gen-worst-move {board player side {nest 2}} { set best {-1 100}; # {pit profit} foreach pit {0 1 2 3 4 5} { update; # give up CPU once in a while if {[get $board $side $pit] != 0} { if {[lindex $best 0] == -1} { set best [list $pit 100];# worst case: we have a valid pit } foreach {go_again mod_board} [move $board $side $pit] break if {$nest == 0} { # We have exhausted all moves starting at this pit... set profit [profit $mod_board $player] if {[lindex $best 1] > $profit} { set best [list $pit $profit];# save the worse profit of all } } if {$nest > 0} { # try next move as opponent (or self if you can go again). set opp [expr {$go_again ? $side : [opponent $side]}] foreach {c profit} \ [gen-best-move $mod_board $player $opp [expr {$nest-1}]] \ break if {[lindex $best 1] > $profit} { set best [list $pit $profit];# save the worse profit of all } } } } return $best } # Every move has a 'profit'. A profit is the number of player's stones in their # store minus the number of opponent's stones in their store. # proc profit {board player} { if {[game-over? $board]} { set board [sweep $board] } foreach {a b} [tally-score $board] break return [expr {$player == 0 ? ($a - $b) : ($b - $a)}] } proc make-best-move {board player {nest 2} {update {}}} { foreach {pit profit} [gen-best-move $board $player $player $nest] break puts "best move pit=$pit, profit=$profit" if {$pit < 0} { return $board } else { return [move $board $player $pit $update] } } proc game-over? {board} { foreach {side_a side_b} [sum-sides $board] { return [expr {$side_a == 0 || $side_b == 0}] } } proc tally-score {board} { return [list [lindex $board end] [lindex $board end-1]] } proc sum-sides {board} { foreach side {0 1} { set s$side 0 foreach pit {0 1 2 3 4 5} { incr s$side [get $board $side $pit] } } return [list $s0 $s1] } # Sweep remaining stones into their owner's store. # proc sweep {board} { foreach side {0 1} { set s$side [lindex $board end-$side] foreach pit {0 1 2 3 4 5} { incr s$side [get $board $side $pit] lset board [pos $side $pit] 0 } lset board end-$side [set s$side] } return $board } # Who is my opponent? # proc opponent {player} { return [expr {!$player}] } ################################################################ # Start of the Tk GUI stuff.. # package require Tk proc tk-make-board {c board} { global coords set padx 4 set padx2 [expr {$padx * 2}] set pady 4 set pit_width [expr {([$c cget -width] / 8) - ($padx/2)}] set pit_height [expr {([$c cget -height] / 2) - ($pady/2)}] set coords(width) $pit_width set coords(height) $pit_height set S_offset_y [expr {$pady+($pit_height/4)}] set coords(height,S) [expr {$pit_height*2}] $c create rectangle $padx2 $S_offset_y \ $pit_width [expr {$coords(height,S)-$S_offset_y}] \ -fill white \ -tags side1,S set coords(side1,S) [list $padx2 $S_offset_y] foreach {row side direction} {0 1 reverse 1 0 forward} { foreach pit {0 1 2 3 4 5} { if {$direction == "reverse"} { set tag side$side,[expr {5-$pit}] } else { set tag side$side,$pit } incr pit set x [expr {($pit_width*$pit)+$padx2}] set y [expr {$pady+($row*$pit_height)}] $c create rectangle $x $y \ [expr {$x + $pit_width-$padx2}] \ [expr {$y + $pit_height-$pady}] \ -fill white \ -tags [list $tag pit] set coords($tag) [list $x $y] # only 'downside' should a human play if {$side==0} { # find the pit drawn foreach {side2 pit} [split $tag ,] break # bind the movement to the user actions $c bind stone-$tag \ [list tk-move $c $side $side $pit] } } } set x [expr {($pit_width*7)+$padx2}] $c create rectangle $x $S_offset_y \ [expr {($pit_width*8)}] [expr {$coords(height,S)-$S_offset_y}] \ -fill white \ -tags side0,S set coords(side0,S) [list $x $S_offset_y] } proc tk-draw-stones {c board} { foreach {row side} {1 0 0 1} { foreach pit {0 1 2 3 4 5} { tk-stone .c [get $board $side $pit] side$side,$pit } } tk-stone .c [lindex $board end] side0,S tk-stone .c [lindex $board end-1] side1,S } proc tk-stone {c stone_cnt side,pit} { global coords .c delete stone-${side,pit} foreach {x y} [set coords(${side,pit})] { incr x [expr {$coords(width)/2}] incr y [expr {$coords(height)-12}] set width [expr {$coords(width)-16}] tk-stack-stones $c $stone_cnt $x $y $width stone-${side,pit} .c create text $x $y -text $stone_cnt \ -tags stone-${side,pit} } } proc tk-stack-stones {c cnt x y width tag} { for {set i 1} {$i <= $cnt} {incr i} { .c create oval [expr {$x - ($width/2)}] \ [expr {$y - ($i*10)}] \ [expr {$x + ($width/2)}] \ [expr {$y - ($i*10)-20}] \ -fill brown -tags $tag } } proc tk-move {c player side pit} { global MAIN_BOARD LEVEL if {[catch { # catch illegal moves. (empty pits) foreach {go_again MAIN_BOARD} \ [move $MAIN_BOARD $side $pit [list tk-draw-stones $c]] \ break } err] != 0} { return } tk-draw-stones $c $MAIN_BOARD if {[tk-game-over $c $MAIN_BOARD]} { return } if {$go_again} { .f.status configure -text "Your move (again)." return } set go_again 1 .f.status configure -text "My move. Thinking..." while {$go_again} { update idletasks foreach {go_again MAIN_BOARD} \ [make-best-move $MAIN_BOARD [opponent $player] $LEVEL \ [list tk-draw-stones $c]] \ break update idletasks if {[tk-game-over $c $MAIN_BOARD]} { return } if {$go_again} { .f.status configure -text "My move (again). Thinking..." update idletasks after 1000 } } .f.status configure -text "Your move." } proc tk-game-over {c board} { if {[game-over? $board]} { set board [sweep $board] tk-draw-stones $c $board foreach {a b} [tally-score $board] break set winner [expr {$a >= $b ? ($a == $b ? "nobody" : "you") : "the computer"}] set res [tk_messageBox -message "Game over! $winner won"] .f.status configure -text "Game over." return 1 } return 0 } proc tk-game {} { global MAIN_BOARD LEVEL canvas .c -width 480 -height 480 frame .f button .f.new -text "New Game" -command { set MAIN_BOARD [make-board]; tk-make-board .c $MAIN_BOARD; tk-draw-stones .c $MAIN_BOARD .f.status configure -text "Your move." } label .f.level_l -text " Play Level : " tk_optionMenu .f.level LEVEL 0 1 2 3 4 5 6 label .f.status -text "Your move." -fg brown button .f.help -text "Help" -command { print-help .f.help} button .f.quit -text "Quit" -command { exit } pack .f.new -side left pack .f.level_l -side left pack .f.level -side left pack .f.status -side left -fill x -expand yes pack .f.quit -side right pack .f.help -side right pack .c -fill both -expand yes pack .f -fill x -expand yes .f.new invoke } proc print-help {w} { global HELPMSG if {[winfo exists .h]} { wm state .h normal raise .h .f return } toplevel .h wm title .h "Mancala Help" frame .h.f frame .h.f.tb text .h.f.tb.t -width 80 -height 25 -bg white -wrap word \ -yscrollcommand {.h.f.tb.s set} .h.f.tb.t insert end $HELPMSG .h.f.tb.t configure -state disabled scrollbar .h.f.tb.s -orient vertical -command {.h.f.tb.t yview} pack .h.f.tb.s -fill y -side right pack .h.f.tb.t -fill both -expand yes button .h.f.b -text "Ok" -command {destroy .h} focus .h.f.b bind .h.f.b [list .h.f.b invoke] pack .h.f.tb -expand yes -fill both pack .h.f.b -side bottom -anchor c pack .h.f -expand yes -fill both } set LEVEL 2 tk-game ---- ''[escargo] 28 Nov 2003'' - This page is ''reapable'' with [wish-reaper]. ---- [Category Games] | [Category Application]