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.Data.Enum as Data.Enum
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.DeepSeq
import qualified Control.Exception
data Vector distance = MkVector {
Vector distance -> distance
getXDistance :: !distance,
Vector distance -> distance
getYDistance :: !distance
} deriving (Vector distance -> Vector distance -> Bool
(Vector distance -> Vector distance -> Bool)
-> (Vector distance -> Vector distance -> Bool)
-> Eq (Vector distance)
forall distance.
Eq distance =>
Vector distance -> Vector distance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector distance -> Vector distance -> Bool
$c/= :: forall distance.
Eq distance =>
Vector distance -> Vector distance -> Bool
== :: Vector distance -> Vector distance -> Bool
$c== :: forall distance.
Eq distance =>
Vector distance -> Vector distance -> Bool
Eq, Int -> Vector distance -> ShowS
[Vector distance] -> ShowS
Vector distance -> String
(Int -> Vector distance -> ShowS)
-> (Vector distance -> String)
-> ([Vector distance] -> ShowS)
-> Show (Vector distance)
forall distance. Show distance => Int -> Vector distance -> ShowS
forall distance. Show distance => [Vector distance] -> ShowS
forall distance. Show distance => Vector distance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector distance] -> ShowS
$cshowList :: forall distance. Show distance => [Vector distance] -> ShowS
show :: Vector distance -> String
$cshow :: forall distance. Show distance => Vector distance -> String
showsPrec :: Int -> Vector distance -> ShowS
$cshowsPrec :: forall distance. Show distance => Int -> Vector distance -> ShowS
Show)
instance Num distance => Property.Opposable.Opposable (Vector distance) where
getOpposite :: Vector distance -> Vector distance
getOpposite (MkVector distance
xDistance distance
yDistance) = distance -> distance -> Vector distance
forall distance. distance -> distance -> Vector distance
MkVector (distance -> distance
forall a. Num a => a -> a
negate distance
xDistance) (distance -> distance
forall a. Num a => a -> a
negate distance
yDistance)
hasDistance :: (Eq distance, Num distance) => distance -> distance -> Bool
hasDistance :: distance -> distance -> Bool
hasDistance distance
xDistance distance
yDistance = distance
xDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
/= distance
0 Bool -> Bool -> Bool
|| distance
yDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
/= distance
0
mkVector :: (Num distance, Ord distance) => distance -> distance -> Vector distance
{-# INLINE mkVector #-}
mkVector :: distance -> distance -> Vector distance
mkVector distance
xDistance distance
yDistance = Bool -> Vector distance -> Vector distance
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
distance -> distance -> Bool
forall distance.
(Eq distance, Num distance) =>
distance -> distance -> Bool
hasDistance distance
xDistance distance
yDistance Bool -> Bool -> Bool
&& distance -> distance
forall a. Num a => a -> a
abs distance
xDistance distance -> distance -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> distance
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength Bool -> Bool -> Bool
&& distance -> distance
forall a. Num a => a -> a
abs distance
yDistance distance -> distance -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> distance
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Ordinate.yLength
) (Vector distance -> Vector distance)
-> Vector distance -> Vector distance
forall a b. (a -> b) -> a -> b
$ distance -> distance -> Vector distance
forall distance. distance -> distance -> Vector distance
MkVector distance
xDistance distance
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 :: Coordinates x y -> Coordinates x y -> Vector distance
measureDistance Coordinates x y
source Coordinates x y
destination = (distance -> distance -> Vector distance)
-> (distance, distance) -> Vector distance
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry distance -> distance -> Vector distance
forall distance.
(Num distance, Ord distance) =>
distance -> distance -> Vector distance
mkVector ((distance, distance) -> Vector distance)
-> (distance, distance) -> Vector distance
forall a b. (a -> b) -> a -> b
$ Coordinates x y -> Coordinates x y -> (distance, distance)
forall x y distance.
(Enum x, Enum y, Num distance) =>
Coordinates x y -> Coordinates x y -> (distance, distance)
Cartesian.Coordinates.measureDistance Coordinates x y
source Coordinates x y
destination
isDiagonal :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isDiagonal #-}
isDiagonal :: Vector distance -> Bool
isDiagonal (MkVector distance
xDistance distance
yDistance) = distance -> distance
forall a. Num a => a -> a
abs distance
xDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance -> distance
forall a. Num a => a -> a
abs distance
yDistance
isParallel :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isParallel #-}
isParallel :: Vector distance -> Bool
isParallel (MkVector distance
xDistance distance
yDistance) = distance
xDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
0 Bool -> Bool -> Bool
|| distance
yDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
0
isStraight :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isStraight #-}
isStraight :: Vector distance -> Bool
isStraight Vector distance
vector = Vector distance -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
isParallel Vector distance
vector Bool -> Bool -> Bool
|| Vector distance -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
isDiagonal Vector distance
vector
type VectorInt = Vector Type.Length.Distance
instance Control.DeepSeq.NFData distance => Control.DeepSeq.NFData (Vector distance) where
rnf :: Vector distance -> ()
rnf MkVector { getXDistance :: forall distance. Vector distance -> distance
getXDistance = distance
xDistance, getYDistance :: forall distance. Vector distance -> distance
getYDistance = distance
yDistance } = (distance, distance) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (distance
xDistance, distance
yDistance)
instance (Eq distance, Num distance) => Property.Orientated.Orientated (Vector distance) where
{-# SPECIALISE instance Property.Orientated.Orientated VectorInt #-}
isDiagonal :: Vector distance -> Bool
isDiagonal = Vector distance -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
isDiagonal
isParallel :: Vector distance -> Bool
isParallel = Vector distance -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
isParallel
attackVectorsForPawn :: Num distance => Attribute.LogicalColour.LogicalColour -> [Vector distance]
attackVectorsForPawn :: LogicalColour -> [Vector distance]
attackVectorsForPawn LogicalColour
logicalColour = [
distance -> distance -> Vector distance
forall distance. distance -> distance -> Vector distance
MkVector distance
x (distance -> Vector distance) -> distance -> Vector distance
forall a b. (a -> b) -> a -> b
$ (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
then distance -> distance
forall a. Num a => a -> a
negate
else distance -> distance
forall a. a -> a
id
) distance
1 | distance
x <- [distance -> distance
forall a. Num a => a -> a
negate distance
1, distance
1]
]
attackVectorsForKnight :: Num distance => [Vector distance]
attackVectorsForKnight :: [Vector distance]
attackVectorsForKnight = [
distance -> distance -> Vector distance
forall distance. distance -> distance -> Vector distance
MkVector (distance -> distance
fX distance
xDistance) (distance -> distance
fY (distance -> distance) -> distance -> distance
forall a b. (a -> b) -> a -> b
$ distance
3 distance -> distance -> distance
forall a. Num a => a -> a -> a
- distance
xDistance) |
distance -> distance
fX <- [distance -> distance]
negateOrNot,
distance -> distance
fY <- [distance -> distance]
negateOrNot,
distance
xDistance <- [distance
1, distance
2]
] where
negateOrNot :: [distance -> distance]
negateOrNot = [distance -> distance
forall a. Num a => a -> a
negate, distance -> distance
forall a. a -> a
id]
attackVectorsForKing :: (Eq distance, Num distance) => [Vector distance]
attackVectorsForKing :: [Vector distance]
attackVectorsForKing = [
distance -> distance -> Vector distance
forall distance. distance -> distance -> Vector distance
MkVector distance
xDistance distance
yDistance |
distance
xDistance <- [distance]
signumValues,
distance
yDistance <- [distance]
signumValues,
distance -> distance -> Bool
forall distance.
(Eq distance, Num distance) =>
distance -> distance -> Bool
hasDistance distance
xDistance distance
yDistance
] where
signumValues :: [distance]
signumValues = [distance -> distance
forall a. Num a => a -> a
negate distance
1, distance
0, distance
1]
isPawnAttack :: (Eq distance, Num distance) => Attribute.LogicalColour.LogicalColour -> Vector distance -> Bool
{-# INLINE isPawnAttack #-}
isPawnAttack :: LogicalColour -> Vector distance -> Bool
isPawnAttack LogicalColour
logicalColour (MkVector distance
xDistance distance
yDistance) = distance -> distance
forall a. Num a => a -> a
abs distance
xDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
1 Bool -> Bool -> Bool
&& distance
yDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
then distance -> distance
forall a. Num a => a -> a
negate
else distance -> distance
forall a. a -> a
id
) distance
1
isKnightsMove :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isKnightsMove #-}
isKnightsMove :: Vector distance -> Bool
isKnightsMove (MkVector distance
xDistance distance
yDistance) = case distance -> distance
forall a. Num a => a -> a
abs distance
xDistance of
distance
1 -> distance
absYDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
2
distance
2 -> distance
absYDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
1
distance
_ -> Bool
False
where
absYDistance :: distance
absYDistance = distance -> distance
forall a. Num a => a -> a
abs distance
yDistance
isKingsMove :: (Num distance, Ord distance) => Vector distance -> Bool
isKingsMove :: Vector distance -> Bool
isKingsMove (MkVector distance
0 distance
0) = Bool
False
isKingsMove (MkVector distance
xDistance distance
yDistance) = distance -> distance
forall a. Num a => a -> a
abs distance
xDistance distance -> distance -> Bool
forall a. Ord a => a -> a -> Bool
<= distance
1 Bool -> Bool -> Bool
&& distance -> distance
forall a. Num a => a -> a
abs distance
yDistance distance -> distance -> Bool
forall a. Ord a => a -> a -> Bool
<= distance
1
matchesPawnDoubleAdvance
:: (Eq distance, Num distance)
=> Attribute.LogicalColour.LogicalColour
-> Vector distance
-> Bool
matchesPawnDoubleAdvance :: LogicalColour -> Vector distance -> Bool
matchesPawnDoubleAdvance LogicalColour
logicalColour (MkVector distance
xDistance distance
yDistance) = distance
xDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== distance
0 Bool -> Bool -> Bool
&& distance
yDistance distance -> distance -> Bool
forall a. Eq a => a -> a -> Bool
== (
if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
then distance -> distance
forall a. Num a => a -> a
negate
else distance -> distance
forall a. a -> a
id
) distance
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 x y -> Vector distance -> Coordinates x y
translate Coordinates x y
coordinates (MkVector distance
xDistance distance
yDistance) = ((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y
Cartesian.Coordinates.translate (
(Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ distance -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral distance
xDistance) (x -> x) -> (y -> y) -> (x, y) -> (x, y)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int) -> y -> y
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ distance -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral distance
yDistance)
) Coordinates x y
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)
{-# SPECIALISE maybeTranslate :: Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y -> Vector Type.Length.Distance -> Maybe (Cartesian.Coordinates.Coordinates Type.Length.X Type.Length.Y) #-}
maybeTranslate :: Coordinates x y -> Vector distance -> Maybe (Coordinates x y)
maybeTranslate Coordinates x y
coordinates (MkVector distance
xDistance distance
yDistance) = ((x, y) -> (x, y)) -> Coordinates x y -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
((x, y) -> (x, y)) -> Coordinates x y -> Maybe (Coordinates x y)
Cartesian.Coordinates.maybeTranslate (
(Int -> Int) -> x -> x
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ distance -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral distance
xDistance) (x -> x) -> (y -> y) -> (x, y) -> (x, y)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int) -> y -> y
forall a b. (Enum a, Enum b) => (Int -> Int) -> a -> b
Data.Enum.translate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ distance -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral distance
yDistance)
) Coordinates x y
coordinates
toMaybeDirection :: (Num distance, Ord distance) => Vector distance -> Maybe Attribute.Direction.Direction
{-# INLINE toMaybeDirection #-}
toMaybeDirection :: Vector distance -> Maybe Direction
toMaybeDirection vector :: Vector distance
vector@(MkVector distance
xDistance distance
yDistance)
| Vector distance -> Bool
forall distance.
(Eq distance, Num distance) =>
Vector distance -> Bool
isStraight Vector distance
vector = Direction -> Maybe Direction
forall a. a -> Maybe a
Just (Direction -> Maybe Direction) -> Direction -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ Ordering -> Ordering -> Direction
Attribute.Direction.mkDirection (distance -> distance -> Ordering
forall a. Ord a => a -> a -> Ordering
compare distance
xDistance distance
0) (distance -> distance -> Ordering
forall a. Ord a => a -> a -> Ordering
compare distance
yDistance distance
0)
| Bool
otherwise = Maybe Direction
forall a. Maybe a
Nothing