{-
	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; cf. 'Component.Move.Move'.
-}

module BishBosh.Cartesian.Vector(
-- ** Data-types
	Vector(
--		MkVector,
		getXDistance,
		getYDistance
	),
-- * Constants
	attackVectorsForKnight,
	attackVectorsForKing,
-- * Functions
	attackVectorsForPawn,
	translate,
	maybeTranslate,
	toMaybeDirection,
-- ** Constructor
	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.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

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

-- | Whether the vector has a non-zero length (or a well-defined direction).
hasDistance :: Type.Length.X -> Type.Length.Y -> Bool
hasDistance :: X -> X -> Bool
hasDistance X
0 X
0	= Bool
False
hasDistance X
_ X
_	= Bool
True

-- | Construct a /vector/ by measuring the signed distance between source-/coordinates/ & destination.
measureDistance
	:: Cartesian.Coordinates.Coordinates	-- ^ Source.
	-> Cartesian.Coordinates.Coordinates	-- ^ Destination.
	-> 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

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

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

-- | 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 :: 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)

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

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

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

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

{- |
	* 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 :: 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

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

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

{- |
	* 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 :: 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 the specified /coordinates/ by the specified /vector/.
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

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

{- |
	* 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 :: 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