{-# LANGUAGE CPP, LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
module BishBosh.Component.Piece(
LocatedPiece,
Piece(
getLogicalColour,
getRank
),
nPiecesPerSide,
range,
findAttackDestinations,
showPieces,
getAttackDirections,
promote,
mkBishop,
mkKing,
mkKnight,
mkPawn,
mkPiece,
mkQueen,
mkRook,
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.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Type.Count as Type.Count
import qualified BishBosh.Type.Length as Type.Length
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
#ifdef USE_PARALLEL
import qualified Control.Parallel.Strategies
#endif
tag :: String
tag :: String
tag = String
"piece"
nPiecesPerSide :: Type.Count.NPieces
nPiecesPerSide :: NPieces
nPiecesPerSide = NPieces -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NPieces -> NPieces) -> NPieces -> NPieces
forall a b. (a -> b) -> a -> b
$ 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 -> NPieces
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
}
range :: [Piece]
range :: [Piece]
range = [
MkPiece :: LogicalColour -> Rank -> Piece
MkPiece {
getLogicalColour :: LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Rank
getRank = Rank
rank
} |
LogicalColour
logicalColour <- [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members,
Rank
rank <- [Rank]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
]
showPieces :: String
showPieces :: String
showPieces = (Piece -> String) -> [Piece] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Piece -> String
forall a. Show a => a -> String
show [Piece]
range
instance Property.FixedMembership.FixedMembership Piece where
members :: [Piece]
members = [Piece]
range
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)
promote :: Attribute.Rank.Rank -> Piece -> Piece
promote :: Rank -> Piece -> Piece
promote Rank
newRank Piece
piece = Piece
piece { getRank :: Rank
getRank = Rank
newRank }
type ByRankByLogicalColour element = Attribute.LogicalColour.ArrayByLogicalColour (Data.Map.Map Attribute.Rank.Rank element)
mkByRankByLogicalColour ::
#ifdef USE_PARALLEL
Control.DeepSeq.NFData element =>
#endif
[Attribute.Rank.Rank] -> (Attribute.LogicalColour.LogicalColour -> Attribute.Rank.Rank -> element) -> ByRankByLogicalColour element
mkByRankByLogicalColour :: [Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
ranks LogicalColour -> Rank -> element
mkElement = [Map Rank element] -> ByRankByLogicalColour element
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Attribute.LogicalColour.listArrayByLogicalColour
#ifdef USE_PARALLEL
([Map Rank element] -> ByRankByLogicalColour element)
-> ([Map Rank element] -> [Map Rank element])
-> [Map Rank element]
-> ByRankByLogicalColour element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy [Map Rank element]
-> [Map Rank element] -> [Map Rank element]
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (Strategy (Map Rank element) -> Strategy [Map Rank element]
forall a. Strategy a -> Strategy [a]
Control.Parallel.Strategies.parList Strategy (Map Rank element)
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq)
#endif
([Map Rank element] -> ByRankByLogicalColour element)
-> [Map Rank element] -> ByRankByLogicalColour element
forall a b. (a -> b) -> a -> b
$ (LogicalColour -> Map Rank element)
-> [LogicalColour] -> [Map Rank element]
forall a b. (a -> b) -> [a] -> [b]
map (
\LogicalColour
logicalColour -> [(Rank, element)] -> Map Rank element
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([(Rank, element)] -> Map Rank element)
-> [(Rank, element)] -> Map Rank element
forall a b. (a -> b) -> a -> b
$ (Rank -> (Rank, element)) -> [Rank] -> [(Rank, element)]
forall a b. (a -> b) -> [a] -> [b]
map (Rank -> Rank
forall a. a -> a
id (Rank -> Rank) -> (Rank -> element) -> Rank -> (Rank, element)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& LogicalColour -> Rank -> element
mkElement LogicalColour
logicalColour) [Rank]
ranks
) [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
attackVectorsByRankByLogicalColour :: (
#ifdef USE_PARALLEL
Control.DeepSeq.NFData distance,
#endif
Num distance,
Ord distance
) => ByRankByLogicalColour [Cartesian.Vector.Vector distance]
attackVectorsByRankByLogicalColour :: ByRankByLogicalColour [Vector distance]
attackVectorsByRankByLogicalColour = [Rank]
-> (LogicalColour -> Rank -> [Vector distance])
-> ByRankByLogicalColour [Vector distance]
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour -> Rank -> [Vector distance])
-> ByRankByLogicalColour [Vector distance])
-> (LogicalColour -> Rank -> [Vector distance])
-> ByRankByLogicalColour [Vector distance]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
Rank
Attribute.Rank.Pawn -> LogicalColour -> [Vector distance]
forall distance. Num distance => LogicalColour -> [Vector distance]
Cartesian.Vector.attackVectorsForPawn LogicalColour
logicalColour
Rank
Attribute.Rank.Knight -> [Vector distance]
forall distance. Num distance => [Vector distance]
Cartesian.Vector.attackVectorsForKnight
Rank
Attribute.Rank.King -> [Vector distance]
forall distance. (Eq distance, Num distance) => [Vector distance]
Cartesian.Vector.attackVectorsForKing
Rank
rank -> String -> [Vector distance]
forall a. (?callStack::CallStack) => String -> a
error (String -> [Vector distance])
-> ShowS -> String -> [Vector distance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Component.Piece.attackVectorsByRankByLogicalColour:\trank must attack over fixed range; " (String -> [Vector distance]) -> String -> [Vector distance]
forall a b. (a -> b) -> a -> b
$ Rank -> ShowS
forall a. Show a => a -> ShowS
shows Rank
rank String
"."
type AttackDestinationsByCoordinatesByRankByLogicalColour x y = ByRankByLogicalColour (Cartesian.Coordinates.ArrayByCoordinates x y [Cartesian.Coordinates.Coordinates x y])
attackDestinationsByCoordinatesByRankByLogicalColour :: (
#ifdef USE_PARALLEL
Control.DeepSeq.NFData x,
Control.DeepSeq.NFData y,
#endif
Enum x,
Enum y,
Ord x,
Ord y
) => AttackDestinationsByCoordinatesByRankByLogicalColour x y
{-# SPECIALISE attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour Type.Length.X Type.Length.Y #-}
attackDestinationsByCoordinatesByRankByLogicalColour :: AttackDestinationsByCoordinatesByRankByLogicalColour x y
attackDestinationsByCoordinatesByRankByLogicalColour = [Rank]
-> (LogicalColour
-> Rank -> Array (Coordinates x y) [Coordinates x y])
-> AttackDestinationsByCoordinatesByRankByLogicalColour x y
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.fixedAttackRange ((LogicalColour
-> Rank -> Array (Coordinates x y) [Coordinates x y])
-> AttackDestinationsByCoordinatesByRankByLogicalColour x y)
-> (LogicalColour
-> Rank -> Array (Coordinates x y) [Coordinates x y])
-> AttackDestinationsByCoordinatesByRankByLogicalColour x y
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour Rank
rank -> [[Coordinates x y]] -> Array (Coordinates x y) [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 ([[Coordinates x y]] -> Array (Coordinates x y) [Coordinates x y])
-> [[Coordinates x y]] -> Array (Coordinates x y) [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ (Coordinates x y -> [Coordinates x y])
-> [Coordinates x y] -> [[Coordinates x y]]
forall a b. (a -> b) -> [a] -> [b]
map (
Coordinates x y -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
`findAttackDestinations'` LogicalColour -> Rank -> Piece
mkPiece LogicalColour
logicalColour Rank
rank
) [Coordinates x y]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
findAttackDestinations' :: (
Enum x,
Enum y,
Ord x,
Ord y
)
=> Cartesian.Coordinates.Coordinates x y
-> Piece
-> [Cartesian.Coordinates.Coordinates x y]
findAttackDestinations' :: Coordinates x y -> Piece -> [Coordinates x y]
findAttackDestinations' Coordinates x y
source MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = (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
) (
ByRankByLogicalColour [Vector NPieces]
forall distance.
(NFData distance, Num distance, Ord distance) =>
ByRankByLogicalColour [Vector distance]
attackVectorsByRankByLogicalColour ByRankByLogicalColour [Vector NPieces]
-> LogicalColour -> Map Rank [Vector NPieces]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Vector NPieces] -> Rank -> [Vector NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Rank
rank :: [Cartesian.Vector.VectorInt]
)
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 -> Piece -> [Coordinates x y]
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
Coordinates x y -> Piece -> [Coordinates x y]
findAttackDestinations'
findAttackDestinationsInt :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> [Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y]
findAttackDestinationsInt :: Coordinates NPieces NPieces
-> Piece -> [Coordinates NPieces NPieces]
findAttackDestinationsInt Coordinates NPieces NPieces
coordinates MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = AttackDestinationsByCoordinatesByRankByLogicalColour
NPieces NPieces
forall x y.
(NFData x, NFData y, Enum x, Enum y, Ord x, Ord y) =>
AttackDestinationsByCoordinatesByRankByLogicalColour x y
attackDestinationsByCoordinatesByRankByLogicalColour AttackDestinationsByCoordinatesByRankByLogicalColour
NPieces NPieces
-> LogicalColour
-> Map
Rank
(ArrayByCoordinates NPieces NPieces [Coordinates NPieces NPieces])
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map
Rank
(ArrayByCoordinates NPieces NPieces [Coordinates NPieces NPieces])
-> Rank
-> ArrayByCoordinates NPieces NPieces [Coordinates NPieces NPieces]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Rank
rank ArrayByCoordinates NPieces NPieces [Coordinates NPieces NPieces]
-> Coordinates NPieces NPieces -> [Coordinates NPieces NPieces]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates NPieces NPieces
coordinates
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Attribute.Direction.Direction]
attackDirectionsByRankByLogicalColour :: ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour = [Rank]
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall element.
NFData element =>
[Rank]
-> (LogicalColour -> Rank -> element)
-> ByRankByLogicalColour element
mkByRankByLogicalColour [Rank]
Attribute.Rank.earthBound ((LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction])
-> (LogicalColour -> Rank -> [Direction])
-> ByRankByLogicalColour [Direction]
forall a b. (a -> b) -> a -> b
$ \LogicalColour
logicalColour -> \case
Rank
Attribute.Rank.Pawn -> LogicalColour -> [Direction]
Attribute.Direction.attackDirectionsForPawn LogicalColour
logicalColour
Rank
Attribute.Rank.Bishop -> [Direction]
Attribute.Direction.diagonals
Rank
Attribute.Rank.Rook -> [Direction]
Attribute.Direction.parallels
Rank
_ -> [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
getAttackDirections :: Piece -> [Attribute.Direction.Direction]
getAttackDirections :: Piece -> [Direction]
getAttackDirections MkPiece {
getLogicalColour :: Piece -> LogicalColour
getLogicalColour = LogicalColour
logicalColour,
getRank :: Piece -> Rank
getRank = Rank
rank
} = ByRankByLogicalColour [Direction]
attackDirectionsByRankByLogicalColour ByRankByLogicalColour [Direction]
-> LogicalColour -> Map Rank [Direction]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! LogicalColour
logicalColour Map Rank [Direction] -> Rank -> [Direction]
forall k a. Ord k => Map k a -> k -> a
Data.Map.! Rank
rank
canAttackAlong
:: (Enum x, Enum y)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Piece
-> Bool
{-# SPECIALISE canAttackAlong :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> Bool #-}
canAttackAlong :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canAttackAlong Coordinates x y
source Coordinates x y
destination Piece
piece = (
case Piece -> Rank
getRank Piece
piece 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 Type.Length.X Type.Length.Y -> Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Piece -> Bool #-}
canMoveBetween :: Coordinates x y -> Coordinates x y -> Piece -> Bool
canMoveBetween Coordinates x y
source Coordinates x y
destination Piece
piece = (
case Piece -> Rank
getRank Piece
piece 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 ArrayByPiece = 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)