Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Initial commit.

  • Loading branch information...
commit 722a457abd93e594316fcebc727bb03f9952f920 0 parents
@julianalucena authored
1  .gitignore
@@ -0,0 +1 @@
+*.swp
96 Board.hs
@@ -0,0 +1,96 @@
+-- Board.hs
+-- Mancala's board.
+
+module Board(initBoard,
+ getPlayerHoles,
+ getOtherPlayerHoles,
+ removeMancalaHole,
+ hasMove,
+ board2holes,
+ holes2board,
+ updateHole,
+ sow,
+ move,
+ canCapture,
+ capture) where
+
+import Types
+import Data.List(splitAt)
+
+-- Inits Board with X holes (including mancala hole) with Y seeds
+initBoard :: Int -> Seed -> Board
+initBoard nHoles seeds = (holes, holes)
+ where holes = replicate nHoles seeds
+
+-- Returns player's holes
+getPlayerHoles :: Player -> Board -> [Seed]
+getPlayerHoles A board = fst board
+getPlayerHoles B board = snd board
+
+getOtherPlayerHoles :: Player -> Board -> [Seed]
+getOtherPlayerHoles player b = getPlayerHoles (getOtherPlayer player) b
+
+getOtherPlayer :: Player -> Player
+getOtherPlayer player = if player == A
+ then B
+ else A
+
+-- Return just normal holes
+removeMancalaHole :: [Seed] -> [Seed]
+removeMancalaHole seeds = reverse (tail (reverse seeds))
+
+-- Verify if specified player has moves to do
+hasMove :: Player -> Board -> Bool
+hasMove p b = any (/=0) holes
+ where holes = removeMancalaHole (getPlayerHoles p b)
+
+board2holes :: Player -> Board -> [Seed]
+board2holes player b = if player == A
+ then fst b ++ snd b
+ else snd b ++ fst b
+
+holes2board :: Player -> [Seed] -> Board
+holes2board p holes = if p == A
+ then splitAt (length holes `div` 2) holes
+ else (snd (holes2board A holes), fst (holes2board A holes))
+
+-- Updates seeds quantity on a hole
+updateHole :: Position -> Seed -> [Seed] -> [Seed]
+updateHole pos seed holes = take pos holes ++ (seed : drop (pos + 1) holes)
+
+-- Sows X seeds on holes
+sow :: Int -> Position -> [Seed] -> [Seed]
+sow n pos holes =
+ if n <= length toBeSown
+ then take pos holes ++ sown ++ drop (pos + n) holes
+ else sow (n - length toBeSown) 0
+ (take pos holes ++ sown ++ drop (pos + length toBeSown) holes)
+ where sown = map (+1) toBeSown
+ toBeSown = take n (drop pos (removeMancalaHole holes))
+
+-- Makes the move
+move :: Hole -> Board -> Board
+move (player, pos) b = holes2board player sownBoard
+ where sownBoard = sow seeds (pos + 1) holesSeedsRemoved
+ holesSeedsRemoved = updateHole pos 0 allHoles
+ allHoles = board2holes player b
+ seeds = (getPlayerHoles player b) !! pos
+
+-- Verifies if a capture can be done
+canCapture :: Hole -> Board -> Bool
+canCapture (player, pos) b
+ | seeds == 1 && opositeSeeds /= 0 = True
+ | otherwise = False
+ where seeds = (getPlayerHoles player b) !! pos
+ opositeSeeds = (getOtherPlayerHoles player b) !! pos
+
+-- Captures other player's seeds
+capture :: Hole -> Board -> Board
+capture (player, pos) b = holes2board (getOtherPlayer player) holesCapturedSeeds
+ where holesCapturedSeeds = updateHole mancalaPos newMancalaSeeds holesRemovedSeeds
+ newMancalaSeeds = (holesRemovedSeeds !! mancalaPos) + opositeSeeds
+ mancalaPos = length holesRemovedSeeds - 1
+ holesRemovedSeeds = updateHole pos 0 (board2holes (getOtherPlayer player) b)
+ opositeSeeds = (getOtherPlayerHoles player b) !! pos
+
+
80 Board_Test.hs
@@ -0,0 +1,80 @@
+-- Board_Test.hs
+-- Tests of Board.hs
+
+import Types
+import Board
+import Test.HUnit
+
+sampleBoard = ([3, 5, 0, 1, 3], [7, 0, 1, 1, 2])
+sampleHoles = [3, 5, 0, 1, 3, 7, 0, 1, 1, 2]
+
+initBoardTest = TestList [
+ TestCase $ assertEqual "Inits a board with 5 holes (including mancala hole) with 4 seeds"
+ (initBoard 5 4) ([4, 4, 4, 4, 4], [4, 4, 4, 4, 4])
+ ]
+
+getPlayerHolesTest = TestList [
+ TestCase $ assertEqual "Returns player A holes"
+ [3, 5, 0, 1, 3] (getPlayerHoles A sampleBoard),
+ TestCase $ assertEqual "Returns player B holes"
+ [7, 0, 1, 1, 2] (getPlayerHoles B sampleBoard)
+ ]
+
+removeMancalaHoleTest = TestList [
+ TestCase $ assertEqual "Removes mancala hole"
+ [3, 4, 0, 1] (removeMancalaHole [3, 4, 0, 1, 7])
+ ]
+
+hasMoveTest = TestList [
+ TestCase $ assertEqual "Player A has moves to do"
+ True (hasMove A ([0, 0, 2, 0, 8], [0, 0, 0, 0, 11])),
+ TestCase $ assertEqual "Player B does NOT have moves to do"
+ False (hasMove B ([0, 0, 2, 0, 8], [0, 0, 0, 0, 11]))
+ ]
+
+updateHoleTest = TestList [
+ TestCase $ assertEqual "Updates player A hole 1 to 0"
+ ([3, 0, 0, 1, 3] ++ snd sampleBoard) (updateHole 1 0 (board2holes A sampleBoard)),
+ TestCase $ assertEqual "Updates player B hole 3 to 0"
+ ([7, 0, 1, 0, 2] ++ fst sampleBoard) (updateHole 3 0 (board2holes B sampleBoard))
+ ]
+
+sowTest = TestList [
+ TestCase $ assertEqual "Sows holes with 3 seeds initiating by hole 0"
+ ([4, 1, 5, 7, 2, 6]) (sow 3 0 [3, 0, 4, 7, 2, 6]),
+ TestCase $ assertEqual "Sows holes with 7 seeds initiating by hole 2"
+ ([4, 1, 6, 9, 3, 6]) (sow 7 2 [3, 0, 4, 7, 2, 6]),
+ TestCase $ assertEqual "Sows holes with 10 seeds initiating by hole 2"
+ ([5, 2, 6, 9, 4, 6]) (sow 10 2 [3, 0, 4, 7, 2, 6])
+ ]
+
+moveTest = TestList [
+ TestCase $ assertEqual "Player A moves from hole 3"
+ ([3, 5, 0, 0, 4], snd sampleBoard) (move (A, 3) sampleBoard),
+ TestCase $ assertEqual "Player A moves from hole 1"
+ ([3, 0, 1, 2, 4], [8, 1, 1, 1, 2]) (move (A, 1) sampleBoard),
+ TestCase $ assertEqual "Player B moves from hole 0"
+ ([4, 6, 1, 1, 3], [0, 1, 2, 2, 3]) (move (B, 0) sampleBoard)
+ ]
+
+canCaptureTest = TestList [
+ TestCase $ assertEqual "Player A can capture from hole 3"
+ True (canCapture (A, 3) sampleBoard),
+ TestCase $ assertEqual "Player A can NOT capture from hole 2"
+ False (canCapture (A, 2) sampleBoard),
+ TestCase $ assertEqual "Player B can capture from hole 3"
+ True (canCapture (B, 3) sampleBoard),
+ TestCase $ assertEqual "Player B can NOT capture from hole 0"
+ False (canCapture (B, 0) sampleBoard)
+ ]
+
+captureTest = TestList [
+ TestCase $ assertEqual "Player A captures from hole 3"
+ ([3, 5, 0, 1, 4], [7, 0, 1, 0, 2]) (capture (A, 3) sampleBoard),
+ TestCase $ assertEqual "Player B captures from hole 0"
+ ([0, 5, 0, 1, 3], [7, 0, 1, 1, 5]) (capture (B, 0) sampleBoard)
+ ]
+
+main = runTestTT $ TestList [initBoardTest, removeMancalaHoleTest,
+ getPlayerHolesTest, hasMoveTest, updateHoleTest, sowTest, moveTest,
+ canCaptureTest, captureTest]
26 Main.hs
@@ -0,0 +1,26 @@
+-- Main.hs
+-- Initiates Mancala game
+
+import Types
+import Board
+
+loop :: Board -> IO()
+loop b = do
+ putStrLn (show b)
+ holeToMoveStr <- getLine
+ let holeToMove = read holeToMoveStr :: Hole
+ let newB = move holeToMove b
+ let re = canCapture holeToMove newB
+ let seeds = (getPlayerHoles (fst holeToMove) newB) !! snd holeToMove
+ let opositeSeeds = (getOtherPlayerHoles (fst holeToMove) newB) !! snd holeToMove
+ putStrLn (show newB)
+ putStrLn (show seeds)
+ putStrLn (show opositeSeeds)
+ putStrLn (show re)
+ if re
+ then
+ loop (capture holeToMove newB)
+ else
+ loop newB
+
+main = loop (initBoard 4 2)
19 Rules.hs
@@ -0,0 +1,19 @@
+-- Rules.hs
+-- Mancala's rules
+
+module Rules where
+
+import Types
+import Board
+import Data.List(splitAt)
+
+makeMove :: Hole -> Board -> Board
+makeMove hole b
+ | canCapture hole b == True = capture hole boardAfterMove
+ | otherwise = boardAfterMove
+ where boardAfterMove = move hole b
+
+--canMoveAgain :: Hole -> Board -> Board
+--canMoveAgain (player, pos) b = holes !!
+-- where holes = board2holes player b
+-- seeds = (getPlayerHoles player b) !! pos
15 Types.hs
@@ -0,0 +1,15 @@
+-- Types.hs
+-- Types used in Mancala game
+
+module Types where
+
+data Player = A | B deriving (Eq, Show, Read)
+
+type Board = ([Seed], [Seed])
+type Hole = (Player, Position)
+type Position = Int
+type Seed = Int
+
+isMancala :: Hole -> Board -> Bool
+isMancala (_, p) b = length holes == p
+ where holes = fst b
16 Types_Test.hs
@@ -0,0 +1,16 @@
+-- Types_Test.hs
+-- Tests of Types.hs
+
+module Types_Test(isMancalaTest) where
+
+import Types
+import Test.HUnit
+
+isMancalaTest = TestList [
+ TestCase $ assertEqual "The last hole is mancala"
+ (isMancala (A, 3) ([2, 5, 0], [7, 9, 1])) True,
+ TestCase $ assertEqual "The other holes are not mancala"
+ (isMancala (A, 2) ([2, 5, 0], [7, 9, 1])) False
+ ]
+
+main = runTestTT $ TestList [isMancalaTest]
Please sign in to comment.
Something went wrong with that request. Please try again.