1 module Board where 2 3 import Wins 4 5 type Board = [Row] 6 type Row = [Piece] 7 data Piece = X | O | Empty deriving Eq 8 9 showBoard :: Board -> String 10 showBoard [r1,r2,r3] = showRow r1 ++ "\n------\n" ++ 11 showRow r2 ++ "\n------\n" ++ 12 showRow r3 ++ "\n\n" 13 14 showRow [p1,p2,p3] = showPiece p1 ++ "|" ++ showPiece p2 ++ "|" ++ showPiece p3 15 16 17 showPiece :: Piece -> String 18 showPiece X = "X" 19 showPiece O = "O" 20 showPiece Empty = " " 21 22 placePiece :: Piece -> Board -> (Int,Int) -> [Board] 23 placePiece p board pos | not (empty pos board) = [] 24 placePiece p [r1,r2,r3] (1,x) = [[insert p r1 x,r2,r3]] 25 placePiece p [r1,r2,r3] (2,x) = [[r1,insert p r2 x,r3]] 26 placePiece p [r1,r2,r3] (3,x) = [[r1,r2,insert p r3 x]] 27 28 insert :: Piece -> Row -> Int -> Row 29 insert p [p1,p2,p3] 1 = [p,p2,p3] 30 insert p [p1,p2,p3] 2 = [p1,p,p3] 31 insert p [p1,p2,p3] 3 = [p1,p2,p] 32 33 empty :: (Int,Int) -> Board -> Bool 34 empty (1,x) [r1,r2,r3] = empty' x r1 35 empty (2,x) [r1,r2,r3] = empty' x r2 36 empty (3,x) [r1,r2,r3] = empty' x r3 37 38 empty' :: Int -> Row -> Bool 39 empty' 1 [Empty,_,_] = True 40 empty' 2 [_,Empty,_] = True 41 empty' 3 [_,_,Empty] = True 42 empty' _ _ = False 43 44 fullBoard b = and (map notEmpty (concat b)) 45 where 46 notEmpty x = not (x==Empty) 47 48 --newPositions :: Piece -> Board -> [Board] 49 newPositions piece board = concat (map (placePiece piece board) 50 [(x,y) | x<-[1..3],y <-[1..3]]) 51 52 initialBoard :: Board 53 initialBoard = [[Empty,Empty,Empty], 54 [Empty,Empty,Empty], 55 [Empty,Empty,Empty]] 56 57 data Evaluation = XWin | OWin | Score Int deriving (Show{-was:Text-},Eq) 58 59 eval 3 = XWin 60 eval (-3) = OWin 61 eval x = Score x 62 63 static :: Board -> Evaluation 64 static board = interpret 0 (map (score board) wins) 65 66 interpret :: Int -> [Evaluation] -> Evaluation 67 interpret x [] = (Score x) 68 interpret x (Score y:l) = interpret (x+y) l 69 interpret x (XWin:l) = XWin 70 interpret x (OWin:l) = OWin 71 72 score :: Board -> Win -> Evaluation 73 score board win = eval (sum (map sum (map2 (map2 scorePiece) board win))) 74 75 scorePiece :: Piece -> Int -> Int 76 scorePiece X score = score 77 scorePiece Empty _ = 0 78 scorePiece O score = -score 79 80 map2 :: (a -> b -> c) -> [a] -> [b] -> [c] 81 map2 f [] x = [] 82 map2 f x [] = [] 83 map2 f (x:xs) (y:ys) = f x y:map2 f xs ys