{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module BishBosh.Component.Piece(
NPieces,
ByPiece,
LocatedPiece,
Piece(
getLogicalColour,
getRank
),
nPiecesPerSide,
range,
attackDirectionsByPiece,
findAttackDestinations,
promote,
mkBishop,
mkKing,
mkKnight,
mkPawn,
mkPiece,
mkQueen,
mkRook,
listArrayByPiece,
canAttackAlong,
canMoveBetween,
isBlack,
isFriend,
isPawn,
isKnight,
isKing,
isPawnPromotion
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Direction as Attribute.Direction
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Abscissa as Cartesian.Abscissa
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Cartesian.Ordinate as Cartesian.Ordinate
import qualified BishBosh.Cartesian.Vector as Cartesian.Vector
import qualified BishBosh.Property.ExtendedPositionDescription as Property.ExtendedPositionDescription
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Types as T
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Char
import qualified Data.List.Extra
import qualified Data.Map
import qualified Data.Maybe
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
tag :: String
tag :: String
tag = String
"piece"
type NPieces = Int
nPiecesPerSide :: NPieces
nPiecesPerSide :: NPieces
nPiecesPerSide = NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral NPieces
Cartesian.Abscissa.xLength NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
2
data Piece = MkPiece {
Piece -> LogicalColour
getLogicalColour :: Attribute.LogicalColour.LogicalColour,
Piece -> Rank
getRank :: Attribute.Rank.Rank
} deriving (Piece
Piece -> Piece -> Bounded Piece
forall a. a -> a -> Bounded a
maxBound :: Piece
$cmaxBound :: Piece
minBound :: Piece
$cminBound :: Piece
Bounded, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: Piece -> Piece -> Bool
Eq, Eq Piece
Eq Piece
-> (Piece -> Piece -> Ordering)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Bool)
-> (Piece -> Piece -> Piece)
-> (Piece -> Piece -> Piece)
-> Ord Piece
Piece -> Piece -> Bool
Piece -> Piece -> Ordering
Piece -> Piece -> Piece
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Piece -> Piece -> Piece
$cmin :: Piece -> Piece -> Piece
max :: Piece -> Piece -> Piece
$cmax :: Piece -> Piece -> Piece
>= :: Piece -> Piece -> Bool
$c>= :: Piece -> Piece -> Bool
> :: Piece -> Piece -> Bool
$c> :: Piece -> Piece -> Bool
<= :: Piece -> Piece -> Bool
$c<= :: Piece -> Piece -> Bool
< :: Piece -> Piece -> Bool
$c< :: Piece -> Piece -> Bool
compare :: Piece -> Piece -> Ordering
$ccompare :: Piece -> Piece -> Ordering
$cp1Ord :: Eq Piece
Ord)
instance Control.DeepSeq.NFData Piece where
rnf :: Piece -> ()
rnf MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = (LogicalColour, Rank) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (LogicalColour
logicalColour, Rank
rank)
instance Data.Array.IArray.Ix Piece where
range :: (Piece, Piece) -> [Piece]
range (Piece
lower, Piece
upper) = Bool -> [Piece] -> [Piece]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) [Piece]
range
inRange :: (Piece, Piece) -> Piece -> Bool
inRange (Piece
lower, Piece
upper) Piece
piece = Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
>= Piece
lower Bool -> Bool -> Bool
&& Piece
piece Piece -> Piece -> Bool
forall a. Ord a => a -> a -> Bool
<= Piece
upper) Bool
True
index :: (Piece, Piece) -> Piece -> NPieces
index (Piece
lower, Piece
upper) MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = Bool -> NPieces -> NPieces
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Piece
lower Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Piece
upper Piece -> Piece -> Bool
forall a. Eq a => a -> a -> Bool
== Piece
forall a. Bounded a => a
maxBound) (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ LogicalColour -> NPieces
forall a. Enum a => a -> NPieces
fromEnum LogicalColour
logicalColour NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
* NPieces
Attribute.Rank.nDistinctRanks NPieces -> NPieces -> NPieces
forall a. Num a => a -> a -> a
+ Rank -> NPieces
forall a. Enum a => a -> NPieces
fromEnum Rank
rank
instance Read Piece where
readsPrec :: NPieces -> ReadS Piece
readsPrec NPieces
_ = ReadS Piece
forall a. ReadsFEN a => ReadS a
Property.ForsythEdwards.readsFEN
instance Show Piece where
showsPrec :: NPieces -> Piece -> ShowS
showsPrec NPieces
_ = Piece -> ShowS
forall a. ShowsFEN a => a -> ShowS
Property.ForsythEdwards.showsFEN
instance Property.ExtendedPositionDescription.ReadsEPD Piece where
readsEPD :: ReadS Piece
readsEPD String
s = case ShowS
Data.List.Extra.trimStart String
s of
Char
c : String
remainder -> (
LogicalColour -> Rank -> Piece
MkPiece (
if Char -> Bool
Data.Char.isUpper Char
c
then LogicalColour
Attribute.LogicalColour.White
else LogicalColour
Attribute.LogicalColour.Black
) (Rank -> Piece) -> ShowS -> (Rank, String) -> (Piece, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> ShowS
forall a b. a -> b -> a
const String
remainder
) ((Rank, String) -> (Piece, String))
-> [(Rank, String)] -> [(Piece, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS Rank
forall a. Read a => ReadS a
reads [Char
c]
String
_ -> []
instance Property.ExtendedPositionDescription.ShowsEPD Piece where
showsEPD :: Piece -> ShowS
showsEPD piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } = String -> ShowS
showString (String -> ShowS) -> ShowS -> String -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (
if Piece -> Bool
isBlack Piece
piece
then Char -> Char
Data.Char.toLower
else Char -> Char
Data.Char.toUpper
) (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Rank -> String
forall a. Show a => a -> String
show Rank
rank
instance Property.ForsythEdwards.ReadsFEN Piece
instance Property.ForsythEdwards.ShowsFEN Piece
instance HXT.XmlPickler Piece where
xpickle :: PU Piece
xpickle = (String -> Piece, Piece -> String) -> PU String -> PU Piece
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Piece
forall a. Read a => String -> a
read, Piece -> String
forall a. Show a => a -> String
show) (PU String -> PU Piece)
-> ([String] -> PU String) -> [String] -> PU Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU Piece) -> [String] -> PU Piece
forall a b. (a -> b) -> a -> b
$ (Piece -> String) -> [Piece] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Piece -> String
forall a. Show a => a -> String
show [Piece]
range
instance Property.Opposable.Opposable Piece where
getOpposite :: Piece -> Piece
getOpposite piece :: Piece
piece@MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour
} = Piece
piece {
getLogicalColour :: LogicalColour
getLogicalColour = LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
}
mkPiece :: Attribute.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> Piece
mkPiece :: LogicalColour -> Rank -> Piece
mkPiece = LogicalColour -> Rank -> Piece
MkPiece
mkPawn :: Attribute.LogicalColour.LogicalColour -> Piece
mkPawn :: LogicalColour -> Piece
mkPawn = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Pawn)
mkRook :: Attribute.LogicalColour.LogicalColour -> Piece
mkRook :: LogicalColour -> Piece
mkRook = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Rook)
mkKnight :: Attribute.LogicalColour.LogicalColour -> Piece
mkKnight :: LogicalColour -> Piece
mkKnight = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Knight)
mkBishop:: Attribute.LogicalColour.LogicalColour -> Piece
mkBishop :: LogicalColour -> Piece
mkBishop = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Bishop)
mkQueen :: Attribute.LogicalColour.LogicalColour -> Piece
mkQueen :: LogicalColour -> Piece
mkQueen = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.Queen)
mkKing :: Attribute.LogicalColour.LogicalColour -> Piece
mkKing :: LogicalColour -> Piece
mkKing = (LogicalColour -> Rank -> Piece
`MkPiece` Rank
Attribute.Rank.King)
range :: [Piece]
range :: [Piece]
range = [
MkPiece :: LogicalColour -> Rank -> Piece
MkPiece {
getLogicalColour :: LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Rank
getRank = Rank
rank
} |
LogicalColour
logicalColour <- [LogicalColour]
Attribute.LogicalColour.range,
Rank
rank <- [Rank]
Attribute.Rank.range
]
promote :: Attribute.Rank.Rank -> Piece -> Piece
promote :: Rank -> Piece -> Piece
promote Rank
newRank Piece
piece = Piece
piece { getRank :: Rank
getRank = Rank
newRank }
attackVectorsByPiece :: (Num distance, Ord distance) => Data.Map.Map Piece [Cartesian.Vector.Vector distance]
attackVectorsByPiece :: Map Piece [Vector distance]
attackVectorsByPiece = [(Piece, [Vector distance])] -> Map Piece [Vector distance]
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
(Piece
piece, [Vector distance]
vectors) |
(Piece
piece, Just [Vector distance]
vectors) <- (Piece -> (Piece, Maybe [Vector distance]))
-> [Piece] -> [(Piece, Maybe [Vector distance])]
forall a b. (a -> b) -> [a] -> [b]
map (
Piece -> Piece
forall a. a -> a
id (Piece -> Piece)
-> (Piece -> Maybe [Vector distance])
-> Piece
-> (Piece, Maybe [Vector distance])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (
\Piece
piece -> case Piece -> Rank
getRank Piece
piece of
Rank
Attribute.Rank.Pawn -> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just ([Vector distance] -> Maybe [Vector distance])
-> (LogicalColour -> [Vector distance])
-> LogicalColour
-> Maybe [Vector distance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> [Vector distance]
forall distance. Num distance => LogicalColour -> [Vector distance]
Cartesian.Vector.attackVectorsForPawn (LogicalColour -> Maybe [Vector distance])
-> LogicalColour -> Maybe [Vector distance]
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
Rank
Attribute.Rank.Knight -> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just [Vector distance]
forall distance. Num distance => [Vector distance]
Cartesian.Vector.attackVectorsForKnight
Rank
Attribute.Rank.King -> [Vector distance] -> Maybe [Vector distance]
forall a. a -> Maybe a
Just [Vector distance]
forall distance. (Eq distance, Num distance) => [Vector distance]
Cartesian.Vector.attackVectorsForKing
Rank
_ -> Maybe [Vector distance]
forall a. Maybe a
Nothing
)
) [Piece]
range
]
attackDestinationsByCoordinatesByRankByLogicalColour :: (
Enum x,
Enum y,
Ord x,
Ord y
) => Cartesian.Coordinates.ByCoordinates x y (Data.Map.Map Piece [Cartesian.Coordinates.Coordinates x y])
{-# SPECIALISE attackDestinationsByCoordinatesByRankByLogicalColour :: Cartesian.Coordinates.ByCoordinates T.X T.Y (Data.Map.Map Piece [Cartesian.Coordinates.Coordinates T.X T.Y]) #-}
attackDestinationsByCoordinatesByRankByLogicalColour :: ByCoordinates x y (Map Piece [Coordinates x y])
attackDestinationsByCoordinatesByRankByLogicalColour = [Map Piece [Coordinates x y]]
-> ByCoordinates x y (Map Piece [Coordinates x y])
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
Cartesian.Coordinates.listArrayByCoordinates ([Map Piece [Coordinates x y]]
-> ByCoordinates x y (Map Piece [Coordinates x y]))
-> [Map Piece [Coordinates x y]]
-> ByCoordinates x y (Map Piece [Coordinates x y])
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> Map Piece [Coordinates x y])
-> [Coordinates x y] -> [Map Piece [Coordinates x y]]
forall a b. (a -> b) -> [a] -> [b]
map (
\Coordinates x y
source -> [(Piece, [Coordinates x y])] -> Map Piece [Coordinates x y]
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [
(
Piece
piece,
(Vector NPieces -> Maybe (Coordinates x y))
-> [Vector NPieces] -> [Coordinates x y]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (Coordinates x y -> Vector NPieces -> Maybe (Coordinates x y)
forall x y distance.
(Enum x, Enum y, Integral distance, Ord x, Ord y) =>
Coordinates x y -> Vector distance -> Maybe (Coordinates x y)
Cartesian.Vector.maybeTranslate Coordinates x y
source) (Map Piece [Vector NPieces]
forall distance.
(Num distance, Ord distance) =>
Map Piece [Vector distance]
attackVectorsByPiece Map Piece [Vector NPieces] -> Piece -> [Vector NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece :: [Cartesian.Vector.VectorInt])
) |
LogicalColour
logicalColour <- [LogicalColour]
Attribute.LogicalColour.range,
Rank
rank <- [Rank]
Attribute.Rank.fixedAttackRange,
let piece :: Piece
piece = LogicalColour -> Rank -> Piece
mkPiece LogicalColour
logicalColour Rank
rank
]
) [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
Cartesian.Coordinates.range
findAttackDestinations :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Cartesian.Coordinates.Coordinates x y
-> Piece
-> [Cartesian.Coordinates.Coordinates x y]
{-# NOINLINE findAttackDestinations #-}
{-# RULES "findAttackDestinations/Int" findAttackDestinations = findAttackDestinationsInt #-}
findAttackDestinations :: Coordinates x y -> Piece -> [Coordinates x y]
findAttackDestinations Coordinates x y
source Piece
piece = (Vector NPieces -> Maybe (Coordinates x y))
-> [Vector NPieces] -> [Coordinates x y]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (Coordinates x y -> Vector NPieces -> Maybe (Coordinates x y)
forall x y distance.
(Enum x, Enum y, Integral distance, Ord x, Ord y) =>
Coordinates x y -> Vector distance -> Maybe (Coordinates x y)
Cartesian.Vector.maybeTranslate Coordinates x y
source) (Map Piece [Vector NPieces]
forall distance.
(Num distance, Ord distance) =>
Map Piece [Vector distance]
attackVectorsByPiece Map Piece [Vector NPieces] -> Piece -> [Vector NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece :: [Cartesian.Vector.VectorInt])
findAttackDestinationsInt :: Cartesian.Coordinates.Coordinates T.X T.Y -> Piece -> [Cartesian.Coordinates.Coordinates T.X T.Y]
findAttackDestinationsInt :: Coordinates NPieces NPieces
-> Piece -> [Coordinates NPieces NPieces]
findAttackDestinationsInt Coordinates NPieces NPieces
coordinates Piece
piece = ByCoordinates
NPieces NPieces (Map Piece [Coordinates NPieces NPieces])
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ByCoordinates x y (Map Piece [Coordinates x y])
attackDestinationsByCoordinatesByRankByLogicalColour ByCoordinates
NPieces NPieces (Map Piece [Coordinates NPieces NPieces])
-> Coordinates NPieces NPieces
-> Map Piece [Coordinates NPieces NPieces]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates NPieces NPieces
coordinates Map Piece [Coordinates NPieces NPieces]
-> Piece -> [Coordinates NPieces NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Piece
piece
attackDirectionsByPiece :: Data.Map.Map Piece [Attribute.Direction.Direction]
attackDirectionsByPiece :: Map Piece [Direction]
attackDirectionsByPiece = [(Piece, [Direction])] -> Map Piece [Direction]
forall k a. Eq k => [(k, a)] -> Map k a
Data.Map.fromAscList [
(
Piece
piece,
case Piece -> Rank
getRank Piece
piece of
Rank
Attribute.Rank.Pawn -> LogicalColour -> [Direction]
Attribute.Direction.attackDirectionsForPawn (LogicalColour -> [Direction]) -> LogicalColour -> [Direction]
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
Rank
Attribute.Rank.Rook -> [Direction]
Attribute.Direction.parallels
Rank
Attribute.Rank.Bishop -> [Direction]
Attribute.Direction.diagonals
Rank
_ -> [Direction]
Attribute.Direction.range
) |
Piece
piece <- [Piece]
range,
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> Bool
isKnight Piece
piece
]
canAttackAlong
:: (Enum x, Enum y)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Piece
-> Bool
canAttackAlong :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canAttackAlong Coordinates x y
source Coordinates x y
destination piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } = (
case Rank
rank of
Rank
Attribute.Rank.Pawn -> LogicalColour -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.isPawnAttack (LogicalColour -> Vector NPieces -> Bool)
-> LogicalColour -> Vector NPieces -> Bool
forall a b. (a -> b) -> a -> b
$ Piece -> LogicalColour
getLogicalColour Piece
piece
Rank
Attribute.Rank.Knight -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isKnightsMove
Rank
Attribute.Rank.Bishop -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isDiagonal
Rank
Attribute.Rank.Rook -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isParallel
Rank
Attribute.Rank.Queen -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isStraight
Rank
Attribute.Rank.King -> Vector NPieces -> Bool
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Bool
Cartesian.Vector.isKingsMove
) (
Coordinates x y -> Coordinates x y -> Vector NPieces
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
source Coordinates x y
destination :: Cartesian.Vector.VectorInt
)
canMoveBetween :: (
Enum x,
Enum y,
Eq y
)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Piece
-> Bool
{-# SPECIALISE canMoveBetween :: Cartesian.Coordinates.Coordinates T.X T.Y -> Cartesian.Coordinates.Coordinates T.X T.Y -> Piece -> Bool #-}
canMoveBetween :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canMoveBetween Coordinates x y
source Coordinates x y
destination piece :: Piece
piece@MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } = (
case Rank
rank of
Rank
Attribute.Rank.Pawn -> \Vector NPieces
distance -> let
logicalColour :: LogicalColour
logicalColour = Piece -> LogicalColour
getLogicalColour Piece
piece
in LogicalColour -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
LogicalColour -> Vector distance -> Bool
Cartesian.Vector.isPawnAttack LogicalColour
logicalColour Vector NPieces
distance Bool -> Bool -> Bool
|| Vector NPieces -> NPieces
forall distance. Vector distance -> distance
Cartesian.Vector.getXDistance Vector NPieces
distance NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
0 Bool -> Bool -> Bool
&& (
let
y' :: NPieces
y' = (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
then NPieces -> NPieces
forall a. Num a => a -> a
negate
else NPieces -> NPieces
forall a. a -> a
id
) (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ Vector NPieces -> NPieces
forall distance. Vector distance -> distance
Cartesian.Vector.getYDistance Vector NPieces
distance
in NPieces
y' NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
1 Bool -> Bool -> Bool
|| LogicalColour -> Coordinates x y -> Bool
forall y x.
(Enum y, Eq y) =>
LogicalColour -> Coordinates x y -> Bool
Cartesian.Coordinates.isPawnsFirstRank LogicalColour
logicalColour Coordinates x y
source Bool -> Bool -> Bool
&& NPieces
y' NPieces -> NPieces -> Bool
forall a. Eq a => a -> a -> Bool
== NPieces
2
)
Rank
Attribute.Rank.Knight -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isKnightsMove
Rank
Attribute.Rank.Bishop -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isDiagonal
Rank
Attribute.Rank.Rook -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isParallel
Rank
Attribute.Rank.Queen -> Vector NPieces -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
Cartesian.Vector.isStraight
Rank
Attribute.Rank.King -> Vector NPieces -> Bool
forall distance.
(Num distance, Ord distance) =>
Vector distance -> Bool
Cartesian.Vector.isKingsMove
) (
Coordinates x y -> Coordinates x y -> Vector NPieces
forall x y distance.
(Enum x, Enum y, Num distance, Ord distance) =>
Coordinates x y -> Coordinates x y -> Vector distance
Cartesian.Vector.measureDistance Coordinates x y
source Coordinates x y
destination :: Cartesian.Vector.VectorInt
)
isPawnPromotion
:: (Enum y, Eq y)
=> Cartesian.Coordinates.Coordinates x y
-> Piece
-> Bool
isPawnPromotion :: Coordinates x y -> Piece -> Bool
isPawnPromotion Coordinates x y
destination MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Pawn
} = LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.lastRank LogicalColour
logicalColour y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y -> y
forall x y. Coordinates x y -> y
Cartesian.Coordinates.getY Coordinates x y
destination
isPawnPromotion Coordinates x y
_ Piece
_ = Bool
False
{-# INLINE isBlack #-}
isBlack :: Piece -> Bool
isBlack :: Piece -> Bool
isBlack MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
Attribute.LogicalColour.Black } = Bool
True
isBlack Piece
_ = Bool
False
{-# INLINE isFriend #-}
isFriend :: Piece -> Piece -> Bool
isFriend :: Piece -> Piece -> Bool
isFriend MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour } MkPiece { getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour' } = LogicalColour
logicalColour LogicalColour -> LogicalColour -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour
logicalColour'
isPeer :: Piece -> Piece -> Bool
isPeer :: Piece -> Piece -> Bool
isPeer MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank } MkPiece { getRank :: Piece -> Rank
getRank = Rank
rank' } = Rank
rank Rank -> Rank -> Bool
forall a. Eq a => a -> a -> Bool
== Rank
rank'
{-# INLINE isPawn #-}
isPawn :: Piece -> Bool
isPawn :: Piece -> Bool
isPawn MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Pawn } = Bool
True
isPawn Piece
_ = Bool
False
{-# INLINE isKnight #-}
isKnight :: Piece -> Bool
isKnight :: Piece -> Bool
isKnight MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Knight } = Bool
True
isKnight Piece
_ = Bool
False
isBishop :: Piece -> Bool
isBishop :: Piece -> Bool
isBishop MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Bishop } = Bool
True
isBishop Piece
_ = Bool
False
isRook :: Piece -> Bool
isRook :: Piece -> Bool
isRook MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Rook } = Bool
True
isRook Piece
_ = Bool
False
isQueen :: Piece -> Bool
isQueen :: Piece -> Bool
isQueen MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.Queen } = Bool
True
isQueen Piece
_ = Bool
False
{-# INLINE isKing #-}
isKing :: Piece -> Bool
isKing :: Piece -> Bool
isKing MkPiece { getRank :: Piece -> Rank
getRank = Rank
Attribute.Rank.King } = Bool
True
isKing Piece
_ = Bool
False
type ByPiece = Data.Array.IArray.Array Piece
listArrayByPiece :: Data.Array.IArray.IArray a e => [e] -> a Piece e
listArrayByPiece :: [e] -> a Piece e
listArrayByPiece = (Piece, Piece) -> [e] -> a Piece e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Piece
forall a. Bounded a => a
minBound, Piece
forall a. Bounded a => a
maxBound)
type LocatedPiece x y = (Cartesian.Coordinates.Coordinates x y, Piece)