Board.hs 3.12 KB
Newer Older
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 103 104 105 106 107 108 109 110 111 112 113 114 115 116
-- Time-stamp: <Sun Mar 10 1996 22:24:04 Stardate: [-31]7179.66 hwloidl>
-----------------------------------------------------------------------------

module Board where

import Wins

import ParForce

type Board = [Row] 
type Row = [Piece]
data Piece = X | O | Empty deriving Eq

showBoard :: Board -> String
showBoard [r1,r2,r3] =  showRow r1 ++ "\n------\n" ++
			showRow r2 ++ "\n------\n" ++
			showRow r3 ++ "\n\n" 

showRow [p1,p2,p3] = showPiece p1 ++ "|" ++ showPiece p2 ++ "|" ++ showPiece p3


showPiece :: Piece -> String
showPiece X = "X"
showPiece O = "O"
showPiece Empty = " "

placePiece :: Piece -> Board -> (Int,Int) -> [Board]
placePiece p board pos | not (empty pos board) = []
placePiece p [r1,r2,r3] (1,x) = [[insert p r1 x,r2,r3]]
placePiece p [r1,r2,r3] (2,x) = [[r1,insert p r2 x,r3]]
placePiece p [r1,r2,r3] (3,x) = [[r1,r2,insert p r3 x]]

insert :: Piece -> Row -> Int -> Row
insert p [p1,p2,p3] 1 = [p,p2,p3]
insert p [p1,p2,p3] 2 = [p1,p,p3]
insert p [p1,p2,p3] 3 = [p1,p2,p]

empty :: (Int,Int) -> Board -> Bool
empty (1,x) [r1,r2,r3] = empty' x r1
empty (2,x) [r1,r2,r3] = empty' x r2
empty (3,x) [r1,r2,r3] = empty' x r3

empty' :: Int -> Row -> Bool
empty' 1 [Empty,_,_] = True
empty' 2 [_,Empty,_] = True
empty' 3 [_,_,Empty] = True
empty' _ _ = False

fullBoard b = and (par_map 3 notEmpty (concat b))
	where 
	notEmpty x = not (x==Empty)

--newPositions :: Piece -> Board -> [Board]
newPositions piece board = concat (par_map 6 (placePiece piece board) 
					     [(x,y) | x<-[1..3],y <-[1..3]])

initialBoard :: Board
initialBoard = [[Empty,Empty,Empty], 
		[Empty,Empty,Empty],
		[Empty,Empty,Empty]]

data Evaluation = XWin | OWin | Score Int deriving (Text,Eq)
{- OLD: partain
instance Eq Evaluation where
    XWin       == XWin	     = True
    OWin       == OWin	     = True
    (Score i1) == (Score i2) = i1 == i2
    _	       == _          = False
    a	  /= b	   = not (a == b)

instance Text Evaluation where
    showsPrec d XWin = showString "XWin"
    showsPrec d OWin = showString "OWin"
    showsPrec d (Score i) = showParen (d >= 10) showStr
	where
	  showStr = showString "Score" . showChar ' ' . showsPrec 10 i

    readsPrec p = error "no readsPrec for Evaluations"
    readList = error "no readList for Evaluations"
    showList []	= showString "[]"
    showList (x:xs)
		= showChar '[' . shows x . showl xs
		  where showl []     = showChar ']'
			showl (x:xs) = showChar ',' . shows x . showl xs
-}

eval 3 = XWin
eval (-3) = OWin
eval x = Score x

static :: Board -> Evaluation
static board = interpret 0 (par_map 8 (score board) wins)

interpret :: Int -> [Evaluation] -> Evaluation
interpret x [] = (Score x)
interpret x (Score y:l) = interpret (x+y) l
interpret x (XWin:l) = XWin
interpret x (OWin:l) = OWin

score :: Board -> Win -> Evaluation
score board win  = eval (sum (par_map 7 sum (zipWith (zipWith scorePiece) board win)))

scorePiece :: Piece -> Int -> Int
scorePiece X score = score
scorePiece Empty _ = 0
scorePiece O score = -score

{-
#if 0
-- This looks very much like a zipWith f to me
map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
map2 f [] x = []
map2 f x [] = []
map2 f (x:xs) (y:ys) = f x y:map2 f xs ys
#endif
-}