module BishBosh.Cartesian.Vector(
VectorInt,
Vector(
getXDistance,
getYDistance
),
attackVectorsForKnight,
attackVectorsForKing,
attackVectorsForPawn,
translate,
maybeTranslate,
toMaybeDirection,
mkVector,
measureDistance,
isDiagonal,
isParallel,
isStraight,
isPawnAttack,
isKnightsMove,
isKingsMove,
matchesPawnDoubleAdvance
) where
import Control.Arrow((***))
import qualified BishBosh.Attribute.Direction as Attribute.Direction
import qualified BishBosh.Attribute.LogicalColour as Attribute.LogicalColour
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.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Types as T
import qualified Control.Exception
data Vector distance = MkVector {
getXDistance :: !distance,
getYDistance :: !distance
} deriving (Eq, Show)
instance Num distance => Property.Opposable.Opposable (Vector distance) where
getOpposite (MkVector xDistance yDistance) = MkVector (negate xDistance) (negate yDistance)
mkVector :: (Num distance, Ord distance) => distance -> distance -> Vector distance
{-# INLINE mkVector #-}
mkVector xDistance yDistance = Control.Exception.assert (
(
xDistance /= 0 || yDistance /= 0
) && abs xDistance < fromIntegral Cartesian.Abscissa.xLength && abs yDistance < fromIntegral Cartesian.Ordinate.yLength
) $ MkVector xDistance yDistance
measureDistance :: (
Enum x,
Enum y,
Num distance,
Ord distance
)
=> Cartesian.Coordinates.Coordinates x y
-> Cartesian.Coordinates.Coordinates x y
-> Vector distance
{-# INLINE measureDistance #-}
measureDistance source destination = uncurry mkVector $ Cartesian.Coordinates.measureDistance source destination
isDiagonal :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isDiagonal #-}
isDiagonal (MkVector xDistance yDistance) = abs xDistance == abs yDistance
isParallel :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isParallel #-}
isParallel (MkVector xDistance yDistance) = xDistance == 0 || yDistance == 0
isStraight :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isStraight #-}
isStraight vector = isParallel vector || isDiagonal vector
type VectorInt = Vector T.Distance
instance (Eq distance, Num distance) => Property.Orientated.Orientated (Vector distance) where
{-# SPECIALISE instance Property.Orientated.Orientated VectorInt #-}
isDiagonal = isDiagonal
isParallel = isParallel
attackVectorsForPawn :: Num distance => Attribute.LogicalColour.LogicalColour -> [Vector distance]
attackVectorsForPawn logicalColour = [
MkVector x $ (
if Attribute.LogicalColour.isBlack logicalColour
then negate
else id
) 1 | x <- [negate 1, 1]
]
attackVectorsForKnight :: Num distance => [Vector distance]
attackVectorsForKnight = [
MkVector (fX xDistance) (fY $ 3 - xDistance) |
fX <- [negate, id],
fY <- [negate, id],
xDistance <- [1, 2]
]
attackVectorsForKing :: (Eq distance, Num distance) => [Vector distance]
attackVectorsForKing = [
MkVector xDistance yDistance |
xDistance <- [negate 1, 0, 1],
yDistance <- [negate 1, 0, 1],
xDistance /= 0 || yDistance /= 0
]
isPawnAttack :: (Eq distance, Num distance) => Attribute.LogicalColour.LogicalColour -> Vector distance -> Bool
{-# INLINE isPawnAttack #-}
isPawnAttack logicalColour (MkVector xDistance yDistance) = abs xDistance == 1 && yDistance == (
if Attribute.LogicalColour.isBlack logicalColour
then negate
else id
) 1
isKnightsMove :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isKnightsMove #-}
isKnightsMove (MkVector xDistance yDistance) = case abs xDistance of
1 -> absYDistance == 2
2 -> absYDistance == 1
_ -> False
where
absYDistance = abs yDistance
isKingsMove :: (Num distance, Ord distance) => Vector distance -> Bool
isKingsMove (MkVector 0 0) = False
isKingsMove (MkVector xDistance yDistance) = abs xDistance <= 1 && abs yDistance <= 1
matchesPawnDoubleAdvance
:: (Eq distance, Num distance)
=> Attribute.LogicalColour.LogicalColour
-> Vector distance
-> Bool
matchesPawnDoubleAdvance logicalColour (MkVector xDistance yDistance) = xDistance == 0 && yDistance == (
if Attribute.LogicalColour.isBlack logicalColour
then negate
else id
) 2
translate :: (
Enum x,
Enum y,
Integral distance,
Ord x,
Ord y
)
=> Cartesian.Coordinates.Coordinates x y
-> Vector distance
-> Cartesian.Coordinates.Coordinates x y
translate coordinates (MkVector xDistance yDistance) = Cartesian.Coordinates.translate (
toEnum . (+ fromIntegral xDistance) . fromEnum *** toEnum . (+ fromIntegral yDistance) . fromEnum
) coordinates
maybeTranslate :: (
Enum x,
Enum y,
Integral distance,
Ord x,
Ord y
)
=> Cartesian.Coordinates.Coordinates x y
-> Vector distance
-> Maybe (Cartesian.Coordinates.Coordinates x y)
{-# INLINE maybeTranslate #-}
maybeTranslate coordinates (MkVector xDistance yDistance) = Cartesian.Coordinates.maybeTranslate (
toEnum . (+ fromIntegral xDistance) . fromEnum *** toEnum . (+ fromIntegral yDistance) . fromEnum
) coordinates
toMaybeDirection :: (Num distance, Ord distance) => Vector distance -> Maybe Attribute.Direction.Direction
{-# INLINE toMaybeDirection #-}
toMaybeDirection vector@(MkVector xDistance yDistance)
| isStraight vector = Just $ Attribute.Direction.mkDirection (compare xDistance 0) (compare yDistance 0)
| otherwise = Nothing