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