{-
	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@]	The location of a square on the board.
-}

module BishBosh.Cartesian.Coordinates(
-- * Types
-- ** Data-types
	Coordinates(
--		MkCoordinates,
		getX,
		getY
	),
-- ** Type-synonyms
--	Transformation,
	ByCoordinates,
-- * Constants
	topLeft,
	bottomRight,
	nSquares,
--	range,
--	extrapolationsByCoordinatesByDirection,
--	interpolationsBySourceByDestination,
	radiusSquared,
-- * Functions
--	(>||<),
	extrapolate,
--	extrapolateInt,
	interpolate,
--	interpolateInt,
	range,
	getLogicalColourOfSquare,
	kingsStartingCoordinates,
	rooksStartingCoordinates,
	measureDistance,
	translate,
	maybeTranslate,
	translateX,
	maybeTranslateX,
	translateY,
	maybeTranslateY,
	getAdjacents,
	advance,
--	maybeAdvance,
	retreat,
	maybeRetreat,
--	rotate,
-- ** Constructors
	mkCoordinates,
	mkMaybeCoordinates,
	fromIx,
	mkRelativeCoordinates,
	listArrayByCoordinates,
-- ** Predicates
--	inBounds,
	isPawnsFirstRank,
	isEnPassantRank,
	areSquaresIsochromatic
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.Direction			as Attribute.Direction
import qualified	BishBosh.Attribute.LogicalColour		as Attribute.LogicalColour
import qualified	BishBosh.Attribute.LogicalColourOfSquare	as Attribute.LogicalColourOfSquare
import qualified	BishBosh.Cartesian.Abscissa			as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Ordinate			as Cartesian.Ordinate
import qualified	BishBosh.Data.Exception				as Data.Exception
import qualified	BishBosh.Property.Opposable			as Property.Opposable
import qualified	BishBosh.Property.Reflectable			as Property.Reflectable
import qualified	BishBosh.Property.Rotatable			as Property.Rotatable
import qualified	BishBosh.Text.ShowList				as Text.ShowList
import qualified	BishBosh.Types					as T
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Maybe
import qualified	Factory.Math.Power

-- | The /coordinates/ of a square on the board.
data Coordinates x y	= MkCoordinates {
	Coordinates x y -> x
getX	:: x,	-- ^ Abscissa.
	Coordinates x y -> y
getY	:: y	-- ^ Ordinate.
} deriving Coordinates x y -> Coordinates x y -> Bool
(Coordinates x y -> Coordinates x y -> Bool)
-> (Coordinates x y -> Coordinates x y -> Bool)
-> Eq (Coordinates x y)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Bool
/= :: Coordinates x y -> Coordinates x y -> Bool
$c/= :: forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Bool
== :: Coordinates x y -> Coordinates x y -> Bool
$c== :: forall x y.
(Eq x, Eq y) =>
Coordinates x y -> Coordinates x y -> Bool
Eq

instance (
	Control.DeepSeq.NFData	x,
	Control.DeepSeq.NFData	y
 ) => Control.DeepSeq.NFData (Coordinates x y) where
	rnf :: Coordinates x y -> ()
rnf MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x, getY :: forall x y. Coordinates x y -> y
getY = y
y }	= (x, y) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (x
x, y
y)

instance (Show x, Show y) => Show (Coordinates x y) where
	showsPrec :: Int -> Coordinates x y -> ShowS
showsPrec Int
_ MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x, getY :: forall x y. Coordinates x y -> y
getY = y
y }	= (x, y) -> ShowS
forall a. Show a => a -> ShowS
shows (x
x, y
y)

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Read	x,
	Read	y
 ) => Read (Coordinates x y) where
	readsPrec :: Int -> ReadS (Coordinates x y)
readsPrec Int
_ String
s	= [
		(Coordinates x y
coordinates, String
remainder) |
			((x
x, y
y), String
remainder)	<- ReadS (x, y)
forall a. Read a => ReadS a
reads String
s,
			Coordinates x y
coordinates		<- Maybe (Coordinates x y) -> [Coordinates x y]
forall a. Maybe a -> [a]
Data.Maybe.maybeToList (Maybe (Coordinates x y) -> [Coordinates x y])
-> Maybe (Coordinates x y) -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ x -> y -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Maybe (Coordinates x y)
mkMaybeCoordinates x
x y
y
	 ] -- List-comprehension.

instance (Ord x, Ord y) => Ord (Coordinates x y) where
	{-# SPECIALISE instance Ord (Coordinates T.X T.Y) #-}
	MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x, getY :: forall x y. Coordinates x y -> y
getY = y
y } compare :: Coordinates x y -> Coordinates x y -> Ordering
`compare` MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x', getY :: forall x y. Coordinates x y -> y
getY = y
y' }	= (y
y, x
x) (y, x) -> (y, x) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (y
y', x
x')	-- N.B.: x is less significant than y, as required by the implementation of 'Data.Array.IArray.Ix.inRange'.

instance (Enum x, Enum y) => Bounded (Coordinates x y) where
	minBound :: Coordinates x y
minBound = MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= x
forall x. Enum x => x
Cartesian.Abscissa.xMin,
		getY :: y
getY	= y
forall x. Enum x => x
Cartesian.Ordinate.yMin
	} -- Bottom Left.
	maxBound :: Coordinates x y
maxBound = MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= x
forall x. Enum x => x
Cartesian.Abscissa.xMax,
		getY :: y
getY	= y
forall x. Enum x => x
Cartesian.Ordinate.yMax
	} -- Top Right.

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Data.Array.IArray.Ix (Coordinates x y) where
	{-# SPECIALISE instance Data.Array.IArray.Ix (Coordinates T.X T.Y) #-}
	range :: (Coordinates x y, Coordinates x y) -> [Coordinates x y]
range (Coordinates x y
lower, Coordinates x y
upper)			= Bool -> [Coordinates x y] -> [Coordinates x y]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates x y
lower Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Coordinates x y
upper Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
forall a. Bounded a => a
maxBound) [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
range
	inRange :: (Coordinates x y, Coordinates x y) -> Coordinates x y -> Bool
inRange (Coordinates x y
lower, Coordinates x y
upper) Coordinates x y
coordinates	= Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Coordinates x y
coordinates Coordinates x y -> Coordinates x y -> Bool
forall a. Ord a => a -> a -> Bool
>= Coordinates x y
lower Bool -> Bool -> Bool
&& Coordinates x y
coordinates Coordinates x y -> Coordinates x y -> Bool
forall a. Ord a => a -> a -> Bool
<= Coordinates x y
upper) Bool
True
	index :: (Coordinates x y, Coordinates x y) -> Coordinates x y -> Int
index (Coordinates x y
lower, Coordinates x y
upper) MkCoordinates {
		getX :: forall x y. Coordinates x y -> x
getX	= x
x,
		getY :: forall x y. Coordinates x y -> y
getY	= y
y
	} = Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (
		Coordinates x y
lower Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Coordinates x y
upper Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
forall a. Bounded a => a
maxBound
	 ) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Num a => a -> a -> a
* (
		y -> Int
forall a. Enum a => a -> Int
fromEnum y
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Ordinate.yOrigin
	 ) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (
		x -> Int
forall a. Enum a => a -> Int
fromEnum x
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Abscissa.xOrigin
	 )

instance Enum y => Property.Reflectable.ReflectableOnX (Coordinates x y) where
	reflectOnX :: Coordinates x y -> Coordinates x y
reflectOnX coordinates :: Coordinates x y
coordinates@MkCoordinates { getY :: forall x y. Coordinates x y -> y
getY = y
y }	= Coordinates x y
coordinates { getY :: y
getY = y -> y
forall y. Enum y => y -> y
Cartesian.Ordinate.reflect y
y }

instance Enum x => Property.Reflectable.ReflectableOnY (Coordinates x y) where
	reflectOnY :: Coordinates x y -> Coordinates x y
reflectOnY coordinates :: Coordinates x y
coordinates@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x }	= Coordinates x y
coordinates { getX :: x
getX = x -> x
forall y. Enum y => y -> y
Cartesian.Abscissa.reflect x
x }

instance (Enum x, Enum y) => Property.Rotatable.Rotatable (Coordinates x y) where
	rotate90 :: Coordinates x y -> Coordinates x y
rotate90	= Direction -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Enum y) => Direction -> Transformation x y
rotate Direction
Attribute.Direction.w
	rotate180 :: Coordinates x y -> Coordinates x y
rotate180	= Direction -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Enum y) => Direction -> Transformation x y
rotate Direction
Attribute.Direction.s
	rotate270 :: Coordinates x y -> Coordinates x y
rotate270	= Direction -> Coordinates x y -> Coordinates x y
forall x y. (Enum x, Enum y) => Direction -> Transformation x y
rotate Direction
Attribute.Direction.e

-- | Constant.
topLeft :: (Enum x, Enum y) => Coordinates x y
topLeft :: Coordinates x y
topLeft = MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
	getX :: x
getX	= x
forall x. Enum x => x
Cartesian.Abscissa.xMin,
	getY :: y
getY	= y
forall x. Enum x => x
Cartesian.Ordinate.yMax
}

-- | Constant.
bottomRight :: (Enum x, Enum y) => Coordinates x y
bottomRight :: Coordinates x y
bottomRight = MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
	getX :: x
getX	= x
forall x. Enum x => x
Cartesian.Abscissa.xMax,
	getY :: y
getY	= y
forall x. Enum x => x
Cartesian.Ordinate.yMin
}

-- | The constant number of squares on the board.
nSquares :: Int
nSquares :: Int
nSquares	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
Cartesian.Ordinate.yLength

-- | Generates a raster over all the board's /coordinates/.
range :: (Enum x, Enum y) => [Coordinates x y]
{-# SPECIALISE range :: [Coordinates T.X T.Y] #-}
range :: [Coordinates x y]
range	= [
	MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= x
x,
		getY :: y
getY	= y
y
	} |
		y
y	<- [y]
forall y. Enum y => [y]
Cartesian.Ordinate.yRange,
		x
x	<- [x]
forall y. Enum y => [y]
Cartesian.Abscissa.xRange
 ] -- List-comprehension.

-- | Predicate.
inBounds :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> x
	-> y
	-> Bool
{-# INLINE inBounds #-}
inBounds :: x -> y -> Bool
inBounds x
x y
y	= x -> Bool
forall x. (Enum x, Ord x) => x -> Bool
Cartesian.Abscissa.inBounds x
x Bool -> Bool -> Bool
&& y -> Bool
forall x. (Enum x, Ord x) => x -> Bool
Cartesian.Ordinate.inBounds y
y

-- | Constructor.
mkCoordinates :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> x	-- ^ Abscissa.
	-> y	-- ^ Ordinate.
	-> Coordinates x y
mkCoordinates :: x -> y -> Coordinates x y
mkCoordinates x
x y
y	= Bool -> Coordinates x y -> Coordinates x y
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (x -> y -> Bool
forall x y. (Enum x, Enum y, Ord x, Ord y) => x -> y -> Bool
inBounds x
x y
y) (Coordinates x y -> Coordinates x y)
-> Coordinates x y -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ x -> y -> Coordinates x y
forall x y. x -> y -> Coordinates x y
MkCoordinates x
x y
y

-- | Safe constructor.
mkMaybeCoordinates :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> x	-- ^ Abscissa.
	-> y	-- ^ Ordinate.
	-> Maybe (Coordinates x y)
mkMaybeCoordinates :: x -> y -> Maybe (Coordinates x y)
mkMaybeCoordinates x
x y
y
	| x -> y -> Bool
forall x y. (Enum x, Enum y, Ord x, Ord y) => x -> y -> Bool
inBounds x
x y
y	= Coordinates x y -> Maybe (Coordinates x y)
forall a. a -> Maybe a
Just MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates { getX :: x
getX = x
x, getY :: y
getY = y
y }
	| Bool
otherwise	= Maybe (Coordinates x y)
forall a. Maybe a
Nothing

{- |
	* Construct from the specified array-index.

	* CAVEAT: assumes that the array is indexed by the whole range of /coordinates/.
-}
fromIx :: (Enum x, Enum y) => Int -> Coordinates x y
fromIx :: Int -> Coordinates x y
fromIx	= (
	\(Int
y, Int
x) -> MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Cartesian.Abscissa.xOrigin,
		getY :: y
getY	= Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Cartesian.Ordinate.yOrigin
	}
 ) ((Int, Int) -> Coordinates x y)
-> (Int -> (Int, Int)) -> Int -> Coordinates x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength)

-- | Translate the specified /coordinates/.
translate :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => ((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y
translate :: ((x, y) -> (x, y)) -> Coordinates x y -> Coordinates x y
translate (x, y) -> (x, y)
transformation MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} = (x -> y -> Coordinates x y) -> (x, y) -> Coordinates x y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry x -> y -> Coordinates x y
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Coordinates x y
mkCoordinates ((x, y) -> Coordinates x y) -> (x, y) -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ (x, y) -> (x, y)
transformation (x
x, y
y)

-- | Where legal, translate the specified /coordinates/.
maybeTranslate :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> ((x, y) -> (x, y))	-- ^ Translation.
	-> Coordinates x y
	-> Maybe (Coordinates x y)
{-# INLINE maybeTranslate #-}
maybeTranslate :: ((x, y) -> (x, y)) -> Coordinates x y -> Maybe (Coordinates x y)
maybeTranslate (x, y) -> (x, y)
transformation MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} = (x -> y -> Maybe (Coordinates x y))
-> (x, y) -> Maybe (Coordinates x y)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry x -> y -> Maybe (Coordinates x y)
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
x -> y -> Maybe (Coordinates x y)
mkMaybeCoordinates ((x, y) -> Maybe (Coordinates x y))
-> (x, y) -> Maybe (Coordinates x y)
forall a b. (a -> b) -> a -> b
$ (x, y) -> (x, y)
transformation (x
x, y
y)

-- | Translate the specified abscissa.
translateX :: (Enum x, Ord x) => (x -> x) -> Transformation x y
translateX :: (x -> x) -> Transformation x y
translateX x -> x
transformation coordinates :: Coordinates x y
coordinates@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x }	= Coordinates x y
coordinates { getX :: x
getX = (x -> x) -> x -> x
forall x. (Enum x, Ord x) => (x -> x) -> x -> x
Cartesian.Abscissa.translate x -> x
transformation x
x }

-- | Where legal, translate the /x/-component of the specified /coordinates/.
maybeTranslateX
	:: (Enum x, Ord x)
	=> (x -> x)	-- ^ Translation.
	-> Coordinates x y
	-> Maybe (Coordinates x y)
maybeTranslateX :: (x -> x) -> Coordinates x y -> Maybe (Coordinates x y)
maybeTranslateX x -> x
transformation coordinates :: Coordinates x y
coordinates@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x }	= (\x
x' -> Coordinates x y
coordinates { getX :: x
getX = x
x' }) (x -> Coordinates x y) -> Maybe x -> Maybe (Coordinates x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (x -> x) -> x -> Maybe x
forall x. (Enum x, Ord x) => (x -> x) -> x -> Maybe x
Cartesian.Abscissa.maybeTranslate x -> x
transformation x
x

-- | Translate the specified ordinate.
translateY :: (Enum y, Ord y) => (y -> y) -> Transformation x y
translateY :: (y -> y) -> Transformation x y
translateY y -> y
transformation coordinates :: Coordinates x y
coordinates@MkCoordinates { getY :: forall x y. Coordinates x y -> y
getY = y
y }	= Coordinates x y
coordinates { getY :: y
getY = (y -> y) -> y -> y
forall x. (Enum x, Ord x) => (x -> x) -> x -> x
Cartesian.Ordinate.translate y -> y
transformation y
y }

-- | Where legal, translate the /y/-component of the specified /coordinates/.
maybeTranslateY
	:: (Enum y, Ord y)
	=> (y -> y)	-- ^ Translation.
	-> Coordinates x y
	-> Maybe (Coordinates x y)
maybeTranslateY :: (y -> y) -> Coordinates x y -> Maybe (Coordinates x y)
maybeTranslateY y -> y
transformation coordinates :: Coordinates x y
coordinates@MkCoordinates { getY :: forall x y. Coordinates x y -> y
getY = y
y }	= (\y
y' -> Coordinates x y
coordinates { getY :: y
getY = y
y' }) (y -> Coordinates x y) -> Maybe y -> Maybe (Coordinates x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (y -> y) -> y -> Maybe y
forall x. (Enum x, Ord x) => (x -> x) -> x -> Maybe x
Cartesian.Ordinate.maybeTranslate y -> y
transformation y
y

-- | Construct /coordinates/ relative to 'minBound'.
mkRelativeCoordinates :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> ((x, y) -> (x, y))	-- ^ Translation.
	-> Coordinates x y
mkRelativeCoordinates :: ((x, y) -> (x, y)) -> Coordinates x y
mkRelativeCoordinates	= (((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
`translate` Coordinates x y
forall a. Bounded a => a
minBound)

-- | Move one step towards the opponent.
advance
	:: (Enum y, Ord	y)
	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.
	-> Transformation x y
{-# INLINE advance #-}
advance :: LogicalColour -> Transformation x y
advance LogicalColour
logicalColour	= (y -> y) -> Transformation x y
forall y x. (Enum y, Ord y) => (y -> y) -> Transformation x y
translateY ((y -> y) -> Transformation x y) -> (y -> y) -> Transformation x y
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
	then y -> y
forall y. Enum y => y -> y
pred
	else y -> y
forall y. Enum y => y -> y
succ

-- | Where legal, move one step towards the opponent.
maybeAdvance
	:: (Enum y, Ord	y)
	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to advance.
	-> Coordinates x y				-- ^ The location from which to advanced.
	-> Maybe (Coordinates x y)
maybeAdvance :: LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
maybeAdvance LogicalColour
logicalColour	= (y -> y) -> Coordinates x y -> Maybe (Coordinates x y)
forall y x.
(Enum y, Ord y) =>
(y -> y) -> Coordinates x y -> Maybe (Coordinates x y)
maybeTranslateY ((y -> y) -> Coordinates x y -> Maybe (Coordinates x y))
-> (y -> y) -> Coordinates x y -> Maybe (Coordinates x y)
forall a b. (a -> b) -> a -> b
$ if LogicalColour -> Bool
Attribute.LogicalColour.isBlack LogicalColour
logicalColour
	then y -> y
forall y. Enum y => y -> y
pred
	else y -> y
forall y. Enum y => y -> y
succ

-- | Move one step away from the opponent.
retreat
	:: (Enum y, Ord	y)
	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.
	-> Transformation x y
retreat :: LogicalColour -> Transformation x y
retreat	= LogicalColour -> Transformation x y
forall y x. (Enum y, Ord y) => LogicalColour -> Transformation x y
advance (LogicalColour -> Transformation x y)
-> (LogicalColour -> LogicalColour)
-> LogicalColour
-> Transformation x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite

-- | Where legal, move one step away from the opponent.
maybeRetreat
	:: (Enum y, Ord y)
	=> Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the /piece/ which is to retreat.
	-> Coordinates x y				-- ^ The location from which to retreat.
	-> Maybe (Coordinates x y)
maybeRetreat :: LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
maybeRetreat	= LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
forall y x.
(Enum y, Ord y) =>
LogicalColour -> Coordinates x y -> Maybe (Coordinates x y)
maybeAdvance (LogicalColour -> Coordinates x y -> Maybe (Coordinates x y))
-> (LogicalColour -> LogicalColour)
-> LogicalColour
-> Coordinates x y
-> Maybe (Coordinates x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite

-- | Get the /coordinates/ immediately left & right.
getAdjacents :: (Enum x, Eq x) => Coordinates x y -> [Coordinates x y]
getAdjacents :: Coordinates x y -> [Coordinates x y]
getAdjacents coordinates :: Coordinates x y
coordinates@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x }	= (x -> Coordinates x y) -> [x] -> [Coordinates x y]
forall a b. (a -> b) -> [a] -> [b]
map (\x
x' -> Coordinates x y
coordinates { getX :: x
getX = x
x' }) ([x] -> [Coordinates x y]) -> [x] -> [Coordinates x y]
forall a b. (a -> b) -> a -> b
$ x -> [x]
forall x. (Enum x, Eq x) => x -> [x]
Cartesian.Abscissa.getAdjacents x
x

infix 6 >||<	-- Just greater than (:).

-- | Alternative to @ zipWith $ curry MkCoordinates @.
(>||<) :: [x] -> [y] -> [Coordinates x y]
{-# INLINE (>||<) #-}
(x
x' : [x]
xs) >||< :: [x] -> [y] -> [Coordinates x y]
>||< (y
y' : [y]
ys)	= MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates { getX :: x
getX = x
x', getY :: y
getY = y
y' } Coordinates x y -> [Coordinates x y] -> [Coordinates x y]
forall a. a -> [a] -> [a]
: [x]
xs [x] -> [y] -> [Coordinates x y]
forall x y. [x] -> [y] -> [Coordinates x y]
>||< [y]
ys	-- Recurse.
[x]
_ >||< [y]
_			= []	-- To avoid unnecessary evaluation, 'zipWith' encodes two patterns for this, but is slightly slower.

{- |
	* Generates a line of /coordinates/, starting just after the specified source & proceeding in the specified /direction/ to the edge of the board.

	* CAVEAT: this is a performance-hotspot (it's also responsible for the allocation of a third of the application's memory); refactor => re-profile.
	In consequence, it is typically automatically avoided using a rewrite-rule to lookup an array of the results from all possible calls.
-}
extrapolate
	:: (Enum x, Enum y)
	=> Attribute.Direction.Direction	-- ^ The direction in which to proceed.
	-> Coordinates x y			-- ^ The point from which to start.
	-> [Coordinates x y]
{-# NOINLINE extrapolate #-}	-- Ensure the rewrite-rule triggers.
{-# RULES "extrapolate/Int" extrapolate = extrapolateInt #-}	-- CAVEAT: the call-stack leading here must be specialised to ensure this rule triggers.
extrapolate :: Direction -> Coordinates x y -> [Coordinates x y]
extrapolate Direction
direction MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} = (
	case Direction -> Ordering
Attribute.Direction.getXDirection Direction
direction of
		Ordering
GT	-> [x -> x
forall y. Enum y => y -> y
succ x
x .. x
forall x. Enum x => x
Cartesian.Abscissa.xMax]
		Ordering
LT	-> let startX :: x
startX = x -> x
forall y. Enum y => y -> y
pred x
x in x
startX x -> [x] -> [x]
`seq` [x
startX, x -> x
forall y. Enum y => y -> y
pred x
startX .. x
forall x. Enum x => x
Cartesian.Abscissa.xMin]
		Ordering
EQ	-> x -> [x]
forall a. a -> [a]
repeat x
x
 ) [x] -> [y] -> [Coordinates x y]
forall x y. [x] -> [y] -> [Coordinates x y]
>||< (
	case Direction -> Ordering
Attribute.Direction.getYDirection Direction
direction of
		Ordering
GT	-> [y -> y
forall y. Enum y => y -> y
succ y
y .. y
forall x. Enum x => x
Cartesian.Ordinate.yMax]
		Ordering
LT	-> let startY :: y
startY = y -> y
forall y. Enum y => y -> y
pred y
y in y
startY y -> [y] -> [y]
`seq` [y
startY, y -> y
forall y. Enum y => y -> y
pred y
startY .. y
forall x. Enum x => x
Cartesian.Ordinate.yMin]
		Ordering
EQ	-> y -> [y]
forall a. a -> [a]
repeat y
y
 )

-- | A specialisation of 'extrapolate'.
extrapolateInt :: Attribute.Direction.Direction -> Coordinates T.X T.Y -> [Coordinates T.X T.Y]
extrapolateInt :: Direction -> Coordinates Int Int -> [Coordinates Int Int]
extrapolateInt Direction
direction Coordinates Int Int
coordinates	= ByCoordinates Int Int (ByDirection [Coordinates Int Int])
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ByCoordinates x y (ByDirection [Coordinates x y])
extrapolationsByCoordinatesByDirection ByCoordinates Int Int (ByDirection [Coordinates Int Int])
-> Coordinates Int Int -> ByDirection [Coordinates Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates Int Int
coordinates ByDirection [Coordinates Int Int]
-> Direction -> [Coordinates Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Direction
direction

-- | The constant lists of /coordinates/, extrapolated from every /coordinate/ in the /board/, in every /direction/.
extrapolationsByCoordinatesByDirection :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => ByCoordinates x y (Attribute.Direction.ByDirection [Coordinates x y])
{-# SPECIALISE extrapolationsByCoordinatesByDirection :: ByCoordinates T.X T.Y (Attribute.Direction.ByDirection [Coordinates T.X T.Y]) #-}	-- To promote memoisation.
extrapolationsByCoordinatesByDirection :: ByCoordinates x y (ByDirection [Coordinates x y])
extrapolationsByCoordinatesByDirection	= [ByDirection [Coordinates x y]]
-> ByCoordinates x y (ByDirection [Coordinates x y])
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
listArrayByCoordinates [
	[[Coordinates x y]] -> ByDirection [Coordinates x y]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a Direction e
Attribute.Direction.listArrayByDirection [
		(
			case Direction -> Ordering
Attribute.Direction.getXDirection Direction
direction of
				Ordering
GT	-> [x -> x
forall y. Enum y => y -> y
succ x
x .. x
forall x. Enum x => x
Cartesian.Abscissa.xMax]
				Ordering
LT	-> let startX :: x
startX = x -> x
forall y. Enum y => y -> y
pred x
x in x
startX x -> [x] -> [x]
`seq` [x
startX, x -> x
forall y. Enum y => y -> y
pred x
startX .. x
forall x. Enum x => x
Cartesian.Abscissa.xMin]
				Ordering
EQ	-> x -> [x]
forall a. a -> [a]
repeat x
x
		) [x] -> [y] -> [Coordinates x y]
forall x y. [x] -> [y] -> [Coordinates x y]
>||< (
			case Direction -> Ordering
Attribute.Direction.getYDirection Direction
direction of
				Ordering
GT	-> [y -> y
forall y. Enum y => y -> y
succ y
y .. y
forall x. Enum x => x
Cartesian.Ordinate.yMax]
				Ordering
LT	-> let startY :: y
startY = y -> y
forall y. Enum y => y -> y
pred y
y in y
startY y -> [y] -> [y]
`seq` [y
startY, y -> y
forall y. Enum y => y -> y
pred y
startY .. y
forall x. Enum x => x
Cartesian.Ordinate.yMin]
				Ordering
EQ	-> y -> [y]
forall a. a -> [a]
repeat y
y
		) | Direction
direction	<- [Direction]
Attribute.Direction.range
	] | MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x, getY :: forall x y. Coordinates x y -> y
getY = y
y }	<- [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
range
 ] -- List-comprehension.

{- |
	* Generates a line of /coordinates/ covering the half open interval @(source, destination]@.

	* CAVEAT: the destination-/coordinates/ must be a valid @Queen@'s /move/ from the source; so that all intermediate points lie on a square of the board.
-}
interpolate :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 )
	=> Coordinates x y	-- ^ Source.
	-> Coordinates x y	-- ^ Destination.
	-> [Coordinates x y]
{-# NOINLINE interpolate #-}	-- Ensure the rewrite-rule triggers.
{-# RULES "interpolate/Int" interpolate = interpolateInt #-}	-- CAVEAT: the call-stack leading here must be specialised to ensure this rule triggers.
interpolate :: Coordinates x y -> Coordinates x y -> [Coordinates x y]
interpolate source :: Coordinates x y
source@MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} destination :: Coordinates x y
destination@MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x',
	getY :: forall x y. Coordinates x y -> y
getY	= y
y'
}
	| Coordinates x y
source Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
destination	= []	-- CAVEAT: an invalid move.
	| Bool
otherwise		= (
		case x
x' x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` x
x of
			Ordering
GT	-> [x -> x
forall y. Enum y => y -> y
succ x
x .. x
x']
			Ordering
LT	-> let startX :: x
startX = x -> x
forall y. Enum y => y -> y
pred x
x in x
startX x -> [x] -> [x]
`seq` [x
startX, x -> x
forall y. Enum y => y -> y
pred x
startX .. x
x']
			Ordering
EQ	-> x -> [x]
forall a. a -> [a]
repeat x
x
	) [x] -> [y] -> [Coordinates x y]
forall x y. [x] -> [y] -> [Coordinates x y]
>||< (
		case y
y' y -> y -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` y
y of
			Ordering
GT	-> [y -> y
forall y. Enum y => y -> y
succ y
y .. y
y']
			Ordering
LT	-> let startY :: y
startY = y -> y
forall y. Enum y => y -> y
pred y
y in y
startY y -> [y] -> [y]
`seq` [y
startY, y -> y
forall y. Enum y => y -> y
pred y
startY .. y
y']
			Ordering
EQ	-> y -> [y]
forall a. a -> [a]
repeat y
y
	)

-- | A specialisation of 'interpolate'.
interpolateInt :: Coordinates T.X T.Y -> Coordinates T.X T.Y -> [Coordinates T.X T.Y]
interpolateInt :: Coordinates Int Int -> Coordinates Int Int -> [Coordinates Int Int]
interpolateInt Coordinates Int Int
coordinatesSource Coordinates Int Int
coordinatesDestination	= ByCoordinates Int Int (ByCoordinates Int Int [Coordinates Int Int])
forall x y.
(Enum x, Enum y, Ord x, Ord y) =>
ByCoordinates x y (ByCoordinates x y [Coordinates x y])
interpolationsBySourceByDestination ByCoordinates Int Int (ByCoordinates Int Int [Coordinates Int Int])
-> Coordinates Int Int
-> ByCoordinates Int Int [Coordinates Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates Int Int
coordinatesSource ByCoordinates Int Int [Coordinates Int Int]
-> Coordinates Int Int -> [Coordinates Int Int]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Coordinates Int Int
coordinatesDestination

-- | The list of /coordinates/, between every permutation of source & destination on the /board/.
interpolationsBySourceByDestination :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => ByCoordinates x y (ByCoordinates x y [Coordinates x y])
{-# SPECIALISE interpolationsBySourceByDestination :: ByCoordinates T.X T.Y (ByCoordinates T.X T.Y [Coordinates T.X T.Y]) #-}	-- To promote memoisation.
interpolationsBySourceByDestination :: ByCoordinates x y (ByCoordinates x y [Coordinates x y])
interpolationsBySourceByDestination	= [ByCoordinates x y [Coordinates x y]]
-> ByCoordinates x y (ByCoordinates x y [Coordinates x y])
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
listArrayByCoordinates [
	[[Coordinates x y]] -> ByCoordinates x y [Coordinates x y]
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
listArrayByCoordinates [
		if Coordinates x y
source Coordinates x y -> Coordinates x y -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates x y
destination
			then []
			else (
				case x
x' x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` x
x of
					Ordering
GT	-> [x -> x
forall y. Enum y => y -> y
succ x
x .. x
x']
					Ordering
LT	-> let startX :: x
startX = x -> x
forall y. Enum y => y -> y
pred x
x in x
startX x -> [x] -> [x]
`seq` [x
startX, x -> x
forall y. Enum y => y -> y
pred x
startX .. x
x']
					Ordering
EQ	-> x -> [x]
forall a. a -> [a]
repeat x
x
			) [x] -> [y] -> [Coordinates x y]
forall x y. [x] -> [y] -> [Coordinates x y]
>||< (
				case y
y' y -> y -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` y
y of
					Ordering
GT	-> [y -> y
forall y. Enum y => y -> y
succ y
y .. y
y']
					Ordering
LT	-> let startY :: y
startY = y -> y
forall y. Enum y => y -> y
pred y
y in y
startY y -> [y] -> [y]
`seq` [y
startY, y -> y
forall y. Enum y => y -> y
pred y
startY .. y
y']
					Ordering
EQ	-> y -> [y]
forall a. a -> [a]
repeat y
y
			)
		| destination :: Coordinates x y
destination@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x', getY :: forall x y. Coordinates x y -> y
getY = y
y' }	<- [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
range
	] | source :: Coordinates x y
source@MkCoordinates { getX :: forall x y. Coordinates x y -> x
getX = x
x, getY :: forall x y. Coordinates x y -> y
getY = y
y }	<- [Coordinates x y]
forall x y. (Enum x, Enum y) => [Coordinates x y]
range
 ] -- List-comprehension.

-- | The type of a function which changes one set of /coordinates/ to another.
type Transformation x y	= Coordinates x y -> Coordinates x y

{- |
	* Rotates the specified /coordinates/, so that the @Black@ pieces start on the specified side of the board; a /direction/ of @N@ involves no change.

	* CAVEAT: one can only request an integral multiple of 90 degrees.
-}
rotate :: (Enum x, Enum y) => Attribute.Direction.Direction -> Transformation x y
rotate :: Direction -> Transformation x y
rotate Direction
direction coordinates :: Coordinates x y
coordinates@MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} = case Direction -> Ordering
Attribute.Direction.getXDirection (Direction -> Ordering)
-> (Direction -> Ordering) -> Direction -> (Ordering, Ordering)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Direction -> Ordering
Attribute.Direction.getYDirection (Direction -> (Ordering, Ordering))
-> Direction -> (Ordering, Ordering)
forall a b. (a -> b) -> a -> b
$ Direction
direction of
	(Ordering
EQ, Ordering
GT)	-> Coordinates x y
coordinates
	(Ordering
LT, Ordering
EQ)	-> MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yDistance',
		getY :: y
getY	= Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xDistance
	} -- +90 degrees, i.e. anti-clockwise.
	(Ordering
EQ, Ordering
LT)	-> MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xDistance',
		getY :: y
getY	= Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yDistance'
	} -- 180 degrees.
	(Ordering
GT, Ordering
EQ)	-> MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
		getX :: x
getX	= Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yDistance,
		getY :: y
getY	= Int -> y
forall a. Enum a => Int -> a
toEnum (Int -> y) -> Int -> y
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Ordinate.yOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xDistance'
	} -- -90 degrees, i.e. clockwise.
	(Ordering, Ordering)
_		-> Exception -> Coordinates x y
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Coordinates x y)
-> (String -> Exception) -> String -> Coordinates x y
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.Coordinates.rotate:\tunable to rotate to direction" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> Coordinates x y) -> String -> Coordinates x y
forall a b. (a -> b) -> a -> b
$ Direction -> ShowS
forall a. Show a => a -> ShowS
shows Direction
direction String
"."
	where
		xDistance, xDistance', yDistance, yDistance'	:: T.Distance
		xDistance :: Int
xDistance	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ x -> Int
forall a. Enum a => a -> Int
fromEnum x
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Abscissa.xOrigin
		yDistance :: Int
yDistance	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ y -> Int
forall a. Enum a => a -> Int
fromEnum y
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
Cartesian.Ordinate.yOrigin
		xDistance' :: Int
xDistance'	= Int -> Int
forall y. Enum y => y -> y
pred Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xDistance
		yDistance' :: Int
yDistance'	= Int -> Int
forall y. Enum y => y -> y
pred Int
Cartesian.Ordinate.yLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yDistance

{- |
	* Measures the signed distance between source & destination /coordinates/.

	* CAVEAT: beware the potential fence-post error.
-}
measureDistance :: (
	Enum	x,
	Enum	y,
	Num	distance
 )
	=> Coordinates x y	-- ^ Source.
	-> Coordinates x y	-- ^ Destination.
	-> (distance, distance)
{-# INLINE measureDistance #-}
measureDistance :: Coordinates x y -> Coordinates x y -> (distance, distance)
measureDistance MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x,
	getY :: forall x y. Coordinates x y -> y
getY	= y
y
} MkCoordinates {
	getX :: forall x y. Coordinates x y -> x
getX	= x
x',
	getY :: forall x y. Coordinates x y -> y
getY	= y
y'
} = (Int -> distance
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> distance) -> Int -> distance
forall a b. (a -> b) -> a -> b
$ x -> Int
forall a. Enum a => a -> Int
fromEnum x
x' Int -> Int -> Int
forall a. Num a => a -> a -> a
- x -> Int
forall a. Enum a => a -> Int
fromEnum x
x, Int -> distance
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> distance) -> Int -> distance
forall a b. (a -> b) -> a -> b
$ y -> Int
forall a. Enum a => a -> Int
fromEnum y
y' Int -> Int -> Int
forall a. Num a => a -> a -> a
- y -> Int
forall a. Enum a => a -> Int
fromEnum y
y)

-- | The constant square of the radius of all coordinates.
radiusSquared :: (
	Fractional	radiusSquared,
	Integral	x,
	Integral	y
 ) => ByCoordinates x y radiusSquared
{-# SPECIALISE radiusSquared :: ByCoordinates T.X T.Y T.RadiusSquared #-}
radiusSquared :: ByCoordinates x y radiusSquared
radiusSquared	= [radiusSquared] -> ByCoordinates x y radiusSquared
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
listArrayByCoordinates [
	radiusSquared -> radiusSquared
forall n. Num n => n -> n
Factory.Math.Power.square (
		Int -> radiusSquared
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x :: T.X) radiusSquared -> radiusSquared -> radiusSquared
forall a. Num a => a -> a -> a
- radiusSquared
forall centre. Fractional centre => centre
Cartesian.Abscissa.centre
	) radiusSquared -> radiusSquared -> radiusSquared
forall a. Num a => a -> a -> a
+ radiusSquared -> radiusSquared
forall n. Num n => n -> n
Factory.Math.Power.square (
		Int -> radiusSquared
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
y :: T.Y) radiusSquared -> radiusSquared -> radiusSquared
forall a. Num a => a -> a -> a
- radiusSquared
forall centre. Fractional centre => centre
Cartesian.Ordinate.centre
	) | MkCoordinates {
		getX :: forall x y. Coordinates x y -> x
getX	= Int
x,
		getY :: forall x y. Coordinates x y -> y
getY	= Int
y
	} <- [Coordinates Int Int]
forall x y. (Enum x, Enum y) => [Coordinates x y]
range
 ] -- List-comprehension.

-- | The /logical colour/ of the specified square.
getLogicalColourOfSquare :: (Enum x, Enum y) => Coordinates x y -> Attribute.LogicalColourOfSquare.LogicalColourOfSquare
getLogicalColourOfSquare :: Coordinates x y -> LogicalColourOfSquare
getLogicalColourOfSquare Coordinates x y
coordinates
	| Int -> Bool
forall a. Integral a => a -> Bool
even Int
xDistance Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Bool
forall a. Integral a => a -> Bool
even Int
yDistance	= LogicalColourOfSquare
Attribute.LogicalColourOfSquare.black
	| Bool
otherwise				= LogicalColourOfSquare
Attribute.LogicalColourOfSquare.white
	where
		xDistance, yDistance	:: T.Distance
		(Int
xDistance, Int
yDistance)	= Coordinates x y -> Coordinates x y -> (Int, Int)
forall x y distance.
(Enum x, Enum y, Num distance) =>
Coordinates x y -> Coordinates x y -> (distance, distance)
measureDistance Coordinates x y
forall a. Bounded a => a
minBound Coordinates x y
coordinates

-- | Whether the specified squares have the same /logical colour/.
areSquaresIsochromatic :: (Enum x, Enum y) => [Coordinates x y] -> Bool
areSquaresIsochromatic :: [Coordinates x y] -> Bool
areSquaresIsochromatic	= (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> ([Coordinates x y] -> (Bool, Bool)) -> [Coordinates x y] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LogicalColourOfSquare -> Bool) -> [LogicalColourOfSquare] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (LogicalColourOfSquare -> LogicalColourOfSquare -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColourOfSquare
forall a. Bounded a => a
minBound) ([LogicalColourOfSquare] -> Bool)
-> ([LogicalColourOfSquare] -> Bool)
-> [LogicalColourOfSquare]
-> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (LogicalColourOfSquare -> Bool) -> [LogicalColourOfSquare] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (LogicalColourOfSquare -> LogicalColourOfSquare -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColourOfSquare
forall a. Bounded a => a
maxBound)) ([LogicalColourOfSquare] -> (Bool, Bool))
-> ([Coordinates x y] -> [LogicalColourOfSquare])
-> [Coordinates x y]
-> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coordinates x y -> LogicalColourOfSquare)
-> [Coordinates x y] -> [LogicalColourOfSquare]
forall a b. (a -> b) -> [a] -> [b]
map Coordinates x y -> LogicalColourOfSquare
forall x y.
(Enum x, Enum y) =>
Coordinates x y -> LogicalColourOfSquare
getLogicalColourOfSquare

-- | The conventional starting /coordinates/ for the @King@ of the specified /logical colour/.
kingsStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> Coordinates x y
kingsStartingCoordinates :: LogicalColour -> Coordinates x y
kingsStartingCoordinates LogicalColour
logicalColour	= MkCoordinates :: forall x y. x -> y -> Coordinates x y
MkCoordinates {
	getX :: x
getX	= Int -> x
forall a. Enum a => Int -> a
toEnum (Int -> x) -> Int -> x
forall a b. (a -> b) -> a -> b
$ Int
Cartesian.Abscissa.xOrigin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4,
	getY :: y
getY	= LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.firstRank LogicalColour
logicalColour
}

-- | The conventional starting /coordinates/ for each @Rook@.
rooksStartingCoordinates :: (Enum x, Enum y) => Attribute.LogicalColour.LogicalColour -> [Coordinates x y]
rooksStartingCoordinates :: LogicalColour -> [Coordinates x y]
rooksStartingCoordinates LogicalColour
Attribute.LogicalColour.Black	= [Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
topLeft, Coordinates x y
forall a. Bounded a => a
maxBound]
rooksStartingCoordinates LogicalColour
_				= [Coordinates x y
forall a. Bounded a => a
minBound, Coordinates x y
forall x y. (Enum x, Enum y) => Coordinates x y
bottomRight]

-- | Whether the specified /coordinates/ are where a @Pawn@ of the specified /logical colour/ starts.
isPawnsFirstRank
	:: (Enum y, Eq y)
	=> Attribute.LogicalColour.LogicalColour
	-> Coordinates x y
	-> Bool
{-# INLINE isPawnsFirstRank #-}
isPawnsFirstRank :: LogicalColour -> Coordinates x y -> Bool
isPawnsFirstRank LogicalColour
logicalColour MkCoordinates { getY :: forall x y. Coordinates x y -> y
getY = y
y }	= y
y y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.pawnsFirstRank LogicalColour
logicalColour

-- | Whether a @Pawn@ is currently on the appropriate /rank/ to take an opponent's @Pawn@ /en-passant/.
isEnPassantRank
	:: (Enum y, Eq y)
	=> Attribute.LogicalColour.LogicalColour
	-> Coordinates x y
	-> Bool
isEnPassantRank :: LogicalColour -> Coordinates x y -> Bool
isEnPassantRank LogicalColour
logicalColour MkCoordinates { getY :: forall x y. Coordinates x y -> y
getY = y
y }	= y
y y -> y -> Bool
forall a. Eq a => a -> a -> Bool
== LogicalColour -> y
forall y. Enum y => LogicalColour -> y
Cartesian.Ordinate.enPassantRank LogicalColour
logicalColour

-- | A boxed array indexed by /coordinates/, of arbitrary elements.
type ByCoordinates x y	= Data.Array.IArray.Array (Coordinates x y)

-- | Array-constructor.
listArrayByCoordinates :: (
	Data.Array.IArray.IArray	a e,
	Enum				x,
	Enum				y,
	Ord				x,
	Ord				y
 ) => [e] -> a (Coordinates x y) e
listArrayByCoordinates :: [e] -> a (Coordinates x y) e
listArrayByCoordinates	= (Coordinates x y, Coordinates x y) -> [e] -> a (Coordinates x y) e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Coordinates x y
forall a. Bounded a => a
minBound, Coordinates x y
forall a. Bounded a => a
maxBound)