{-
	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,
	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

-- | 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 MkVector {
		getXDistance	= xDistance,
		getYDistance	= yDistance
	} = Control.DeepSeq.rnf (xDistance, yDistance)
-}
	rnf :: Vector -> ()
rnf Vector
_	= ()	-- N.B.: it's already strict.

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)

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

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

	* N.B.: the @Pawn@'s ability to advance without taking, isn't dealt with here.
-}
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	-- 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 :: 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

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

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

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

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