-
Notifications
You must be signed in to change notification settings - Fork 1
/
Zertz.hs
102 lines (83 loc) · 3.3 KB
/
Zertz.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
module Zertz where
-- Zertz Module
-- This module defines the basic data types used for representing a game of
-- Zertz. This includes representing the board, player scores, hexes, etc.
-- Also includes are functions for manipulating the game state.
--------------------------------------------------------------------------------
-- Data definitions
--------------------------------------------------------------------------------
import qualified Data.Map as Map
data HexState = Empty | Open | White | Gray | Black
deriving (Eq, Show, Read)
type Coord = (Int, Int)
type ZertzBoard = Map.Map Coord HexState
type Score = (Int, Int, Int)
data ZertzState = ZertzState Score Score ZertzBoard Int
deriving (Eq, Show, Read)
--------------------------------------------------------------------------------
-- Data accessors
--------------------------------------------------------------------------------
-- getHex - Fetch the state of a given coordinate
getHex :: Coord -> ZertzBoard -> HexState
getHex = Map.findWithDefault Empty
-- blankBoard - The default board with no marbles
blankBoard :: ZertzBoard
blankBoard = Map.fromList $ map (\x -> (x, Open))
[(2, (-2)), (2, (-1)), (2, 0),
(1, (-2)), (1, (-1)), (1, 0), (1, 1),
(0, (-2)), (0, (-1)), (0, 0), (0, 1), (0, 2),
((-1), (-1)), ((-1), 0), ((-1), 1), ((-1), 2),
((-2), 0), ((-2), 1), ((-2), 2) ]
startState :: ZertzState
startState = ZertzState (0,0,0) (0,0,0) blankBoard (-1)
-- *Hex - Generate to the coordinate pair in the given direction from the
-- given coordinate pair.
nwHex :: Coord -> Coord
nwHex (x, y) = (x-1, y+1)
neHex :: Coord -> Coord
neHex (x, y) = (x, y+1)
eHex :: Coord -> Coord
eHex (x, y) = (x+1, y)
seHex :: Coord -> Coord
seHex (x, y) = (x+1, y-1)
swHex :: Coord -> Coord
swHex (x, y) = (x, y-1)
wHex :: Coord -> Coord
wHex (x, y) = (x-1, y)
hexOccupied :: ZertzBoard -> Coord -> Bool
hexOccupied board coords =
case getHex coords board of
Empty -> False
Open -> False
_ -> True
hexOpen :: ZertzBoard -> Coord -> Bool
hexOpen board coords =
case getHex coords board of
Open -> True
_ -> False
moveMarble :: Coord -> Coord -> ZertzBoard -> ZertzBoard
moveMarble oldCoords newCoords board =
placeMarble newCoords color newBoard
where
color = getHex oldCoords board
newBoard = placeMarble oldCoords Open board
marblesAvailable :: ZertzState -> HexState -> Int
marblesAvailable (ZertzState (w1,_,_) (w2,_,_) b _) White =
let numOnBoard = Map.size $ Map.filter (== White) b in
5 - numOnBoard - w1 - w2
marblesAvailable (ZertzState (_,g1,_) (_,g2,_) b _) Gray =
let numOnBoard = Map.size $ Map.filter (== Gray) b in
7 - numOnBoard - g1 - g2
marblesAvailable (ZertzState (_,_,b1) (_,_,b2) b _) Black =
let numOnBoard = Map.size $ Map.filter (== Black) b in
7 - numOnBoard - b1 - b2
placeMarble :: Coord -> HexState -> ZertzBoard -> ZertzBoard
placeMarble = Map.insert
removeMarble :: Coord -> ZertzBoard -> ZertzBoard
removeMarble = Map.delete
jumpMarble :: Coord -> Coord -> Coord -> ZertzBoard -> ZertzBoard
jumpMarble s m e = moveMarble s e . placeMarble m Open
scoreMarble :: Score -> HexState -> Score
scoreMarble (x, y, z) White = (x+1, y, z)
scoreMarble (x, y, z) Gray = (x, y+1, z)
scoreMarble (x, y, z) Black = (x, y, z+1)