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