Updated 2011-04-17 04:10:23 by RLE

I was going to do a sophisticated implementation in Lisp, but Tcl let me hack this together in two nights...

Mancala (or Mankala) is an ancient African board game with many variations like http://mancalatime.com. Below 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 30 May 2005 -- 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)

4 June 2005 -- 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.

Sarnold 8 June 2005 -- I added an 'Awele mode' : see the HELPMSG for more explanations.

18 June 2005 -- fixed a bug that happened when it is the opponent's turn, and the player is able to give to eat

Sarnold 5 Sept 2005 -- I created a home page for Mancala in Tcl/Tk at [broken link]

Sarnold 22 Sept 2006 -- I dropped Mancala from my home page.

01 July 2007 -- I rewrote it and put it on my home page back (see Sarnold), with Awélé rules only, and with a small Lua script for computer intelligence.
    set HELPMSG {
        Mancala - an ancient African board game. Version 0.99a
        By Todd Coram (todd at maplefish 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.

        Rules (following the Awele game) :

        Stones are distributed counter-clock wise, pit by pit, but without putting
        a stone in the stores. When the last pit contains 2 or 3 stones, these are
        stored by the player, but only when this pit is the opponent's.
        Then, the previous pits are recursively inspected until the observed pit
        is not in the opponent side, or it contains either less than 2 stones,
        either more than 3 stones. When a player has no more stones in his pits,
        his opponent has to 'give to eat' to him by putting stones at his line.

        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 {}}} {
        #puts $board,$player,$pit
        if {[awele-mode?]} {
            return [awele-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
        incr pit
        while {$stones > 0} {
            # decrement the origin from one stone
            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} {
                    update-gui $update_stones $board
                    set board [capture_opposite $board $side [opponent $side] $pit]
                    update-gui $update_stones $board
                }
                incr pit
            }
            update-gui $update_stones $board
        }
        return [list $go_again $board]
    }

    proc awele-can-move {board player pit} {
        if {[lindex [sum-sides $board] [opponent $player]]==0} {
            # the opponent has no more stones in his pits
            if {[get $board $player $pit]>=(6-$pit)} {
                # the player can move, but must give to eat
                return 1
            }
            return 0
        }
        return 1
    }

    # go to the previous pit in awele mode
    proc previous-pit {pitvar sidevar} {
        upvar $pitvar pit
        upvar $sidevar side
        incr pit -1
        if {$pit<0} {
            set pit 5
            set side [opponent $side]
        }
    }

    # go to the next pit in awele mode
    proc next-pit {pitvar sidevar} {
        upvar $pitvar pit
        upvar $sidevar side
        incr pit
        if {$pit>=6} {
            set pit 0
            set side [opponent $side]
        }
    }

    # this is the awele-mode version of 'move'
    # see the help string for more info about the rules
    proc awele-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"
        }
        # we check a particular case :
        # when the opponent has no more stones, but the game is not over
        # it means the player has to 'give to eat' (put at least one stone
        # in the other side, if he can)
        if {![awele-can-move $board $side $pit]&& ![game-over? $board $player]} {
            error "you have to give to eat to your opponent!"
        }
        set orig_pit $pit
        set orig_side $side
        # we use this short proc to move to the next pit, checking if
        # we go the other side
        next-pit pit side
        while {$stones > 0} {
            incr stones -1
            # stone distribution
            lset board [pos $orig_side $orig_pit] [expr {[get $board $orig_side $orig_pit]-1}]
            # when a whole turn has been made, we pass the original pit by !
            if {$pit==$orig_pit && $side==$orig_side} {
                next-pit pit side
            }
            # increment the number of stones in the pit
            lset board [pos $side $pit] [expr {[get $board $side $pit]+1}]
            if {$stones==0 && $player!=$side} {
                # we check that the number of stones is two or three,
                # because it means the player stores these stones
                while {$side!=$player&& \
                            ([get $board $side $pit] == 2 || [get $board $side $pit]==3)} {
                    update-gui $update_stones $board
                    lset board end-$player \
                            [expr {[lindex $board end-$player]+[get $board $side $pit]}]
                    lset board [pos $side $pit] 0
                    previous-pit pit side
                }
                update-gui $update_stones $board
                return [list $go_again $board]
            }
            next-pit pit side
            update-gui $update_stones $board
        }
        return [list $go_again $board]
    }

    proc update-gui {update_stones board} {
        if {$update_stones != {}} {
            eval $update_stones [list $board]
            update idletasks
            after 500
        }
    }

    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}} {
        # either $worse=-100 and we search for the best move for the player,
        # either $worse=100 and we are searching for the worst move for the player
        if {$player!=$side} {
            # the opponent's hit is being guessed
            # finds the best move for the opponent
            # the worst profit for the player
            set worst 100
        } else  {
            set worst -100
        }
        set best {-1 $worst};                        # {pit profit}
        foreach pit {0 1 2 3 4 5} {
            update;                         # give up CPU once in a while
            # test illegal moves
            if {![catch {move $board $side $pit}]} {
                #puts $nest,$side,$pit
                # move authorized
                if {[lindex $best 0] == -1} {
                    set best [list $pit $worst];# 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 $side $go_again]
                    # save the best (or worse) profit of all
                    set best [best-or-worse $best $pit $profit $worst]
                }
                if {$nest > 0} {
                    # try next move as opponent (or self if you can go again).
                    foreach {c profit} \
                            [gen-best-move $mod_board $player [player $go_again $side] \
                            [expr {$nest-1}]] \
                            break
                    # best profit for pit
                    set best [best-or-worse $best $pit $profit $worst]
                }
            }
        }
        return $best
    }

    # given a best move, and a candidate ($pit and $candidate profit)
    # find the best or the worse profit (given a $worse reference)
    proc best-or-worse {best pit candidate worst} {
        set profit [lindex $best 1]
        # when the worst case is to win : find the lower profit
        if {$worst>0 && $candidate<$profit} {
            return [list $pit $candidate]
        }
        # the worst case is to lose : find the higher profit
        if {$worst<0 && $candidate>$profit} {
            return [list $pit $candidate]
        }
        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 side go_again} {
        if {[game-over? $board [player $go_again $side]]} {
            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 awele-can-give-to-eat? {board side} {
        foreach pit {0 1 2 3 4 5} {
            set opp [opponent $side]
            # when a legal move is possible to give to eat
            if {[awele-can-move $board $opp $pit]} {
                return 1
            }
        }
        return 0
    }

    proc game-over? {board player} {
        foreach side {0 1} sum [sum-sides $board] {
            if {$sum==0} {
                # no stones in side $side
                # in Egyptan mode this means : game over!
                if {![awele-mode?]} {return 1}
                # awele-mode : the opponent has to 'give to eat'
                if {$side!=$player && [awele-can-give-to-eat? $board $side]} {
                    set opp [opponent $side]
                    # when there is a circular situation
                    # (no one can ever end the game)
                    # the row config. is :
                    # 0-0-0-0-0-0 (top)
                    # 1-0-0-0-0-1 (bottom)
                    return [expr {[lindex [sum-sides $board] $opp]==2
                                && [get $board $opp 0]==1}]
                }
                # the opponent can't give to eat : game over
                return 1
            }
        }
        # the game continues
        return 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 <ButtonPress> \
                            [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
        }
    }

    # returns the side playing next
    proc player {go_again player} {
        return [expr {$go_again?($player):[opponent $player]}]
    }

    proc tk-move {c player side pit} {
        global MAIN_BOARD LEVEL
        puts tk-move,$MAIN_BOARD
        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
        set player [player $go_again $player]
        if {[tk-game-over $c $MAIN_BOARD $player]} {
            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 $player $LEVEL \
                    [list tk-draw-stones $c]] \
                    break
            update idletasks
            #puts $go_again,$player,$MAIN_BOARD
            set player [player $go_again $player]
            if {[tk-game-over $c $MAIN_BOARD $player]} {
                return
            }
            if {$go_again} {
                .f.status configure -text "My move (again). Thinking..."
                update idletasks
                after 1000
            }
        }
        .f.status configure -text "Your move."
    }

    # added a $player argument (12/06/05) for awele-mode
    proc tk-game-over {c board player} {
        if {[game-over? $board $player]} {
            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.mode_l -text " Game mode : "
        tk_optionMenu .f.mode MODE Mancala Awele
        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
        }

        grid .f.new -row 0 -column 0
        grid .f.level_l -row 0 -column 1 -sticky w
        grid .f.level -row 0 -column 2 -sticky e
        grid .f.mode_l -row 1 -column 1 -sticky w
        grid .f.mode -row 1 -column 2 -sticky e

        grid .f.status -row 0 -column 3 -columnspan 2
        grid columnconfigure .f 3 -weight 1
        grid .f.quit -row 1 -column 4 -sticky e
        grid .f.help -row 1 -column 3 -sticky e
        pack .c -fill both -expand yes
        pack .f -fill x -expand yes
        .f.new invoke

    }

    proc awele-mode? {} {
        global MODE
        return [string equal $MODE Awele]
    }

    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 <Return> [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
    set MODE Mancala
    tk-game

escargo 28 Nov 2003 - This page is reapable with wish-reaper.