{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	BishBosh is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Describes a line's magnitude & direction, irrespective of its position.
-}

module BishBosh.Cartesian.Vector(
-- * Types
-- ** Type-synonyms
	VectorInt,
-- ** Data-types
	Vector(
--		MkVector,
		getXDistance,
		getYDistance
	),
-- * Constants
	attackVectorsForKnight,
	attackVectorsForKing,
-- * Functions
	attackVectorsForPawn,
	translate,
	maybeTranslate,
	toMaybeDirection,
-- ** Constructor
	mkVector,
	measureDistance,
-- ** Predicates
--	hasDistance,
	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

-- | The distance between two /coordinates/.
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)

-- | Whether the vector has a non-zero length (or a well-defined direction).
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

-- | Smart constructor.
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

-- | Construct a /vector/ by measuring the signed distance between source-/coordinates/ & destination.
measureDistance :: (
	Enum	x,
	Enum	y,
	Num	distance,
	Ord	distance
 )
	=> Cartesian.Coordinates.Coordinates x y	-- ^ Source.
	-> Cartesian.Coordinates.Coordinates x y	-- ^ Destination.
	-> 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

-- | Whether the specified /vector/ is at 45 degrees to an edge of the board, i.e. any move a @Bishop@ could make.
isDiagonal :: (Eq distance, Num distance) => Vector distance -> Bool
{-# INLINE isDiagonal #-}	-- N.B.: highly effective.
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

-- | Whether the specified /vector/ is parallel to an edge of the board, i.e. any move a @Rook@ could make.
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

-- | Whether the specified /vector/ is either parallel or at 45 degrees to an edge of the board, i.e. any move a @Queen@ could make.
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

-- | A suitable concrete type.
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

{- |
	* The list of attack-vectors for a @Pawn@.

	* N.B.: the @Pawn@'s ability to advance without taking, isn't dealt with here.
-}
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	-- Black moves down.
			else distance -> distance
forall a. a -> a
id		-- White moves up.
	) distance
1 | distance
x	<- [distance -> distance
forall a. Num a => a -> a
negate distance
1, distance
1]
 ] -- List-comprehension.

-- | The constant list of attack-vectors for a @Knight@.
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]

-- | The constant list of attack-vectors for a @King@.
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]

{- |
	* Whether the specified /vector/ might represent an attack (rather than an advance) by a @Pawn@.

	* CAVEAT: if the move started at the first rank, then it can't be a @Pawn@, but that's beyond the scope of this module (since a /Vector/ doesn't define absolute /coordinate/s).
-}
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

-- | Whether the specified /vector/ represents a move a @Knight@ could make.
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

-- | Whether the specified /vector/ represents a move a @King@ could make.
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

{- |
	* Whether the specified /vector/ matches a @Pawn@'s initial double-advance move.

	* CAVEAT: passing this test doesn't guarantee that it is a @Pawn@'s double-advance move, since the move may not relate to a @Pawn@, or could be invalid.
-}
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 the specified /coordinates/ by the specified /vector/.
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

-- | Where legal, translate the specified /coordinates/ by the specified /vector/.
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

{- |
	* Where possible, converts the specified /vector/ into a /direction/.

	* @Nothing@ is returned for those /vector/s which don't translate into a legal /direction/ (e.g. a @Knight@'s move).
-}
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