module BishBosh.Cartesian.Vector(
Vector(
getXDistance,
getYDistance
),
attackVectorsForKnight,
attackVectorsForKing,
attackVectorsForPawn,
translate,
maybeTranslate,
toMaybeDirection,
measureDistance,
isPawnAttack,
isKnightsMove,
isKingsMove,
matchesPawnDoubleAdvance
) where
import Control.Arrow((***))
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Colour.LogicalColour as Colour.LogicalColour
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Direction.Direction as Direction.Direction
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified BishBosh.Property.Orientated as Property.Orientated
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified BishBosh.Type.Length as Type.Length
import qualified Control.DeepSeq
import qualified Control.Exception
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 Vector
_ = ()
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
isVertical :: Vector -> Bool
isVertical MkVector { getXDistance :: Vector -> X
getXDistance = X
xDistance } = X
xDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0
isHorizontal :: Vector -> Bool
isHorizontal MkVector { getYDistance :: Vector -> X
getYDistance = X
yDistance } = X
yDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
0
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
isDiagonal :: Vector -> Bool
isDiagonal 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 -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X
forall a. Num a => a -> a
abs X
yDistance)
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
attackVectorsForPawn :: Colour.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
Colour.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 :: Vector -> Colour.LogicalColour.LogicalColour -> Bool
{-# INLINE isPawnAttack #-}
isPawnAttack :: Vector -> LogicalColour -> Bool
isPawnAttack MkVector {
getXDistance :: Vector -> X
getXDistance = X
xDistance,
getYDistance :: Vector -> X
getYDistance = X
yDistance
} LogicalColour
logicalColour = 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
Colour.LogicalColour.isBlack LogicalColour
logicalColour
then X -> X
forall a. Num a => a -> a
negate X
1
else X
1
isKnightsMove :: Vector -> Bool
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 :: Vector -> Colour.LogicalColour.LogicalColour -> Bool
matchesPawnDoubleAdvance :: Vector -> LogicalColour -> Bool
matchesPawnDoubleAdvance MkVector {
getXDistance :: Vector -> X
getXDistance = X
0,
getYDistance :: Vector -> X
getYDistance = X
yDistance
} LogicalColour
logicalColour = X
yDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== if LogicalColour -> Bool
Colour.LogicalColour.isBlack LogicalColour
logicalColour then X -> X
forall a. Num a => a -> a
negate X
2 else X
2
matchesPawnDoubleAdvance Vector
_ LogicalColour
_ = Bool
False
translate :: Vector -> Cartesian.Coordinates.Coordinates -> Cartesian.Coordinates.Coordinates
translate :: Vector -> Coordinates -> Coordinates
translate 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, X)) -> Coordinates -> Coordinates)
-> ((X, X) -> (X, X)) -> Coordinates -> Coordinates
forall a b. (a -> b) -> a -> b
$ (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)
maybeTranslate :: Vector -> Cartesian.Coordinates.Coordinates -> Maybe Cartesian.Coordinates.Coordinates
maybeTranslate :: Vector -> Coordinates -> Maybe Coordinates
maybeTranslate 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, X)) -> Coordinates -> Maybe Coordinates)
-> ((X, X) -> (X, X)) -> Coordinates -> Maybe Coordinates
forall a b. (a -> b) -> a -> b
$ (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)
toMaybeDirection :: Vector -> Maybe Direction.Direction.Direction
toMaybeDirection :: Vector -> Maybe Direction
toMaybeDirection vector :: Vector
vector@(MkVector X
xDistance X
yDistance) = case (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) of
(Ordering
LT, Ordering
ySense) -> case Ordering
ySense of
Ordering
LT
| X
xDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
yDistance' -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.sw
| Bool
otherwise -> Maybe Direction
forall a. Maybe a
Nothing
Ordering
EQ -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.w
Ordering
GT
| X -> X
forall a. Num a => a -> a
negate X
xDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
yDistance' -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.nw
| Bool
otherwise -> Maybe Direction
forall a. Maybe a
Nothing
(Ordering
EQ, Ordering
ySense) -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just (Direction -> Maybe Direction) -> Direction -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ case Ordering
ySense of
Ordering
LT -> Direction
Direction.Direction.s
Ordering
EQ -> Exception -> Direction
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Direction)
-> (String -> Exception) -> String -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkRequestFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Cartesian.Vector.toMaybeDirection:\tundefined direction" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> Direction) -> String -> Direction
forall a b. (a -> b) -> a -> b
$ Vector -> ShowS
forall a. Show a => a -> ShowS
shows Vector
vector String
"."
Ordering
GT -> Direction
Direction.Direction.n
(Ordering
GT, Ordering
ySense) -> case Ordering
ySense of
Ordering
LT
| X
xDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X -> X
forall a. Num a => a -> a
negate X
yDistance' -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.se
| Bool
otherwise -> Maybe Direction
forall a. Maybe a
Nothing
Ordering
EQ -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.e
Ordering
GT
| X
xDistance X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
yDistance' -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
Direction.Direction.ne
| Bool
otherwise -> Maybe Direction
forall a. Maybe a
Nothing
where
yDistance' :: X
yDistance' = X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral X
yDistance