Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Lib
- (
- ) where
- import Prelude
- import Control.Monad.Reader
- import Data.Matrix
- data Color = White | Black deriving (Eq, Show)
- other :: Color -> Color
- other White = Black
- other Black = White
- type Field = (Int, Int)
- data GameState = GameState {
- whosTurn :: Color,
- board :: Board
- }
- type Board = Matrix (Maybe Piece)
- -- class Piece p where
- -- possibleMoves :: p -> GameState -> [Field]
- -- ident :: p -> Int
- -- color :: p -> Color
- data Piece = Piece {
- indent :: Int,
- color :: Color,
- isKing :: Bool
- }
- -- | TODO Reader monad looks great, but I seem to lack the abstractions
- successors :: GameState -> [GameState]
- successors = undefined
- -- successors = do
- -- color <- whosTurn
- -- pieces <- allPiecesOfColor color
- -- gs <- ask
- -- return $ concatMap
- successorsFromPiece :: Piece -> GameState -> [GameState]
- successorsFromPiece piece = do
- pots <- potentialMoves piece
- gs <- ask
- let potentialSuccessors = map (\field -> movePieceToField piece field gs) pots -- TODO how to make it prettier?
- myColor <- reader whosTurn
- return $ filter (not . isCheck myColor) potentialSuccessors
- -- | UNDEF
- movePieceToField :: Piece -> Field -> GameState -> GameState
- movePieceToField = undefined
- -- | UNDEF
- potentialMoves :: Piece -> GameState -> [Field]
- potentialMoves = undefined
- isCheck :: Color -> GameState -> Bool
- isCheck myColor = do
- let yourColor = other myColor
- myKing <- kingOfColor myColor
- yourPieces <- allPiecesOfColor yourColor
- gs <- ask
- return $ any (\yourPiece -> threatens yourPiece myKing gs) yourPieces
- isMate :: GameState -> Bool
- isMate = do
- color <- whosTurn
- check <- isCheck color
- suc <- successors
- return $ check && null suc
- -- | UNDEF
- allPiecesOfColor :: Color -> GameState -> [Piece]
- allPiecesOfColor = undefined
- -- | UNDEF
- position :: Piece -> GameState -> Field
- position = undefined
- -- | UNDEF
- kingOfColor :: Color -> GameState -> Piece
- kingOfColor = undefined
- threatens :: Piece -> Piece -> GameState -> Bool
- threatens p1 p2 = do
- pos <- position p2
- pots <- potentialMoves p1
- return $ pos `elem` pots
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement