Advertisement
Guest User

Untitled

a guest
Mar 29th, 2017
61
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.11 KB | None | 0 0
  1. module Lib
  2. (
  3. ) where
  4.  
  5.  
  6. import Prelude
  7. import Control.Monad.Reader
  8. import Data.Matrix
  9.  
  10.  
  11. data Color = White | Black deriving (Eq, Show)
  12.  
  13. other :: Color -> Color
  14. other White = Black
  15. other Black = White
  16.  
  17.  
  18. type Field = (Int, Int)
  19.  
  20. data GameState = GameState {
  21. whosTurn :: Color,
  22. board :: Board
  23. }
  24.  
  25.  
  26. type Board = Matrix (Maybe Piece)
  27.  
  28.  
  29. -- class Piece p where
  30. -- possibleMoves :: p -> GameState -> [Field]
  31. -- ident :: p -> Int
  32. -- color :: p -> Color
  33.  
  34.  
  35. data Piece = Piece {
  36. indent :: Int,
  37. color :: Color,
  38. isKing :: Bool
  39. }
  40.  
  41.  
  42. -- | TODO Reader monad looks great, but I seem to lack the abstractions
  43. successors :: GameState -> [GameState]
  44. successors = undefined
  45. -- successors = do
  46. -- color <- whosTurn
  47. -- pieces <- allPiecesOfColor color
  48. -- gs <- ask
  49. -- return $ concatMap
  50.  
  51.  
  52. successorsFromPiece :: Piece -> GameState -> [GameState]
  53. successorsFromPiece piece = do
  54. pots <- potentialMoves piece
  55. gs <- ask
  56. let potentialSuccessors = map (\field -> movePieceToField piece field gs) pots -- TODO how to make it prettier?
  57. myColor <- reader whosTurn
  58. return $ filter (not . isCheck myColor) potentialSuccessors
  59.  
  60.  
  61. -- | UNDEF
  62. movePieceToField :: Piece -> Field -> GameState -> GameState
  63. movePieceToField = undefined
  64.  
  65.  
  66. -- | UNDEF
  67. potentialMoves :: Piece -> GameState -> [Field]
  68. potentialMoves = undefined
  69.  
  70.  
  71. isCheck :: Color -> GameState -> Bool
  72. isCheck myColor = do
  73. let yourColor = other myColor
  74. myKing <- kingOfColor myColor
  75. yourPieces <- allPiecesOfColor yourColor
  76. gs <- ask
  77. return $ any (\yourPiece -> threatens yourPiece myKing gs) yourPieces
  78.  
  79.  
  80. isMate :: GameState -> Bool
  81. isMate = do
  82. color <- whosTurn
  83. check <- isCheck color
  84. suc <- successors
  85. return $ check && null suc
  86.  
  87.  
  88. -- | UNDEF
  89. allPiecesOfColor :: Color -> GameState -> [Piece]
  90. allPiecesOfColor = undefined
  91.  
  92.  
  93. -- | UNDEF
  94. position :: Piece -> GameState -> Field
  95. position = undefined
  96.  
  97.  
  98. -- | UNDEF
  99. kingOfColor :: Color -> GameState -> Piece
  100. kingOfColor = undefined
  101.  
  102.  
  103. threatens :: Piece -> Piece -> GameState -> Bool
  104. threatens p1 p2 = do
  105. pos <- position p2
  106. pots <- potentialMoves p1
  107. return $ pos `elem` pots
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement