{-
	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 the /x/-axis by which the /board/ is indexed.

	* AKA the /file/ of a piece.

	* N.B. this coordinate-system is for internal use only, and doesn't attempt to replicate any standard chess-notation.
-}

module BishBosh.Cartesian.Abscissa(
-- * Constants
	xLength,
	xMin,
	xMax,
	xBounds,
	xRange,
	bishopsFiles,
	kingsFile,
--	adjacents,
-- * Functions
	toIx,
	fromIx,
	reflect,
	translate,
	maybeTranslate,
	getAdjacents,
--	getAdjacents',
-- ** Constructors
	listArrayByAbscissa,
-- ** Predicates
	inBounds
) where

import			Control.Arrow((&&&))
import			Data.Array.IArray((!))
import qualified	BishBosh.Type.Length	as Type.Length
import qualified	Control.Exception
import qualified	Data.Array.IArray

-- | The constant length of the /x/-axis.
xLength :: Type.Length.X
xLength :: X
xLength	= X
8

-- | The constant bounds of abscissae.
xBounds :: (Type.Length.X, Type.Length.X)
xMin, xMax :: Type.Length.X
xBounds :: (X, X)
xBounds@(X
xMin, X
xMax)	= (X
0, X
xMin X -> X -> X
forall a. Num a => a -> a -> a
+ X -> X
forall a. Enum a => a -> a
pred {-fence-post-} X
xLength)

-- | The constant list of all abscissae.
xRange :: [Type.Length.X]
xRange :: [X]
xRange	= (X -> X -> [X]) -> (X, X) -> [X]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry X -> X -> [X]
forall a. Enum a => a -> a -> [a]
enumFromTo (X, X)
xBounds

-- | The conventional starting /file/s for the @Bishops@ of either /logical colour/.
bishopsFiles :: [Type.Length.X]
bishopsFiles :: [X]
bishopsFiles	= (X -> X) -> [X] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map X -> X
fromIx [X
2, X
5]

-- | The conventional starting /file/ for the @King@ of either /logical colour/.
kingsFile :: Type.Length.X
kingsFile :: X
kingsFile	= X -> X
fromIx X
4

-- | Convert to an array-index.
toIx :: Type.Length.X -> Int
toIx :: X -> X
toIx	= X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> (X -> X) -> X -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X -> X
forall a. Num a => a -> a -> a
subtract X
xMin

-- | Convert from an array-index.
fromIx :: Int -> Type.Length.X
fromIx :: X -> X
fromIx	= (X -> X -> X
forall a. Num a => a -> a -> a
+ X
xMin) (X -> X) -> (X -> X) -> X -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Reflects about the mid-point of the axis.
reflect :: Type.Length.X -> Type.Length.X
reflect :: X -> X
reflect	= (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
xMin X -> X -> X
forall a. Num a => a -> a -> a
+ X
xMax X -> X -> X
forall a. Num a => a -> a -> a
-)

-- | Predicate.
inBounds :: Type.Length.X -> Bool
{-# INLINE inBounds #-}
inBounds :: X -> Bool
inBounds	= (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) ((Bool, Bool) -> Bool) -> (X -> (Bool, Bool)) -> X -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
xMin) (X -> Bool) -> (X -> Bool) -> X -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
xMax))

-- | Translate the specified ordinate.
translate :: (Type.Length.X -> Type.Length.X) -> Type.Length.X -> Type.Length.X
translate :: (X -> X) -> X -> X
translate X -> X
transformation	= (\X
x -> Bool -> X -> X
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (X -> Bool
inBounds X
x) X
x) (X -> X) -> (X -> X) -> X -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
transformation

-- | Where legal, translate the specified abscissa.
maybeTranslate :: (Type.Length.X -> Type.Length.X) -> Type.Length.X -> Maybe Type.Length.X
maybeTranslate :: (X -> X) -> X -> Maybe X
maybeTranslate X -> X
transformation	= (
	\X
x -> if X -> Bool
inBounds X
x
		then X -> Maybe X
forall a. a -> Maybe a
Just X
x
		else Maybe X
forall a. Maybe a
Nothing
 ) (X -> Maybe X) -> (X -> X) -> X -> Maybe X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
transformation

-- | Get the abscissae immediately left & right.
getAdjacents' :: Type.Length.X -> [Type.Length.X]
getAdjacents' :: X -> [X]
getAdjacents' X
x
	| X
x X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
xMin	= [X -> X
forall a. Enum a => a -> a
succ X
xMin]
	| X
x X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
xMax	= [X -> X
forall a. Enum a => a -> a
pred X
xMax]
	| Bool
otherwise	= [X -> X
forall a. Enum a => a -> a
pred X
x, X -> X
forall a. Enum a => a -> a
succ X
x]

-- | The constant abscissae either side of each value.
adjacents :: Data.Array.IArray.Array Type.Length.X [Type.Length.X]
adjacents :: Array X [X]
adjacents	= [[X]] -> Array X [X]
forall (a :: * -> * -> *) e. IArray a e => [e] -> a X e
listArrayByAbscissa ([[X]] -> Array X [X]) -> [[X]] -> Array X [X]
forall a b. (a -> b) -> a -> b
$ (X -> [X]) -> [X] -> [[X]]
forall a b. (a -> b) -> [a] -> [b]
map X -> [X]
getAdjacents' [X]
xRange

-- | Get the abscissae immediately left & right.
getAdjacents :: Type.Length.X -> [Type.Length.X]
getAdjacents :: X -> [X]
getAdjacents	= (Array X [X]
adjacents Array X [X] -> X -> [X]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)

-- | Array-constructor.
listArrayByAbscissa :: Data.Array.IArray.IArray a e => [e] -> a Type.Length.X e
listArrayByAbscissa :: [e] -> a X e
listArrayByAbscissa	= (X, X) -> [e] -> a X e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (X, X)
xBounds