{-
	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@]	Defines options common to native (i.e. not some separate GUI) interfaces.
-}

module BishBosh.Input.NativeUIOptions(
-- * Types
-- ** Type-synonyms
--	ScreenCoordinates,
--	DepictFigurine,
-- ** Data-types
	NativeUIOptions(
--		MkNativeUIOptions,
		getBoardMagnification,
		getColourScheme,
		getDepictFigurine
	),
-- * Constants
	tag,
	boardMagnificationTag,
--	nRowsTag,
--	nColumnsTag,
-- * Functions
-- ** Constructors
	mkNativeUIOptions
) where

import			BishBosh.Data.Bool()
import			Control.Arrow((***))
import qualified	BishBosh.Colour.ColourScheme	as Colour.ColourScheme
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	BishBosh.Type.Length		as Type.Length
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

-- | Used to qualify XML.
tag :: String
tag :: String
tag			= String
"nativeUIOptions"

-- | Used to qualify XML.
boardMagnificationTag :: String
boardMagnificationTag :: String
boardMagnificationTag	= String
"boardMagnification"

-- | Used to qualify XML.
depictFigurineTag :: String
depictFigurineTag :: String
depictFigurineTag	= String
"depictFigurine"

-- | Used to qualify XML.
nRowsTag :: String
nRowsTag :: String
nRowsTag		= String
"nRows"

-- | Used to qualify XML.
nColumnsTag :: String
nColumnsTag :: String
nColumnsTag		= String
"nColumns"

-- | The coordinates used to index the screen. CAVEAT: the name is an anachronistic hang-over from a discarded implementation of a Curses display.
type ScreenCoordinates	= (Type.Length.Row, Type.Length.Column)

-- | Whether to a depict a piece using a Unicode figurine.
type DepictFigurine	= Bool

-- | Constructor.
data NativeUIOptions	= MkNativeUIOptions {
	NativeUIOptions -> ScreenCoordinates
getBoardMagnification	:: ScreenCoordinates,	-- ^ The factor by which the dimensions of the board are stretched when displayed.
	NativeUIOptions -> ColourScheme
getColourScheme		:: Colour.ColourScheme.ColourScheme,
	NativeUIOptions -> DepictFigurine
getDepictFigurine	:: DepictFigurine	-- ^ Whether to a depict pieces using Unicode figurines.
} deriving NativeUIOptions -> NativeUIOptions -> DepictFigurine
(NativeUIOptions -> NativeUIOptions -> DepictFigurine)
-> (NativeUIOptions -> NativeUIOptions -> DepictFigurine)
-> Eq NativeUIOptions
forall a.
(a -> a -> DepictFigurine) -> (a -> a -> DepictFigurine) -> Eq a
/= :: NativeUIOptions -> NativeUIOptions -> DepictFigurine
$c/= :: NativeUIOptions -> NativeUIOptions -> DepictFigurine
== :: NativeUIOptions -> NativeUIOptions -> DepictFigurine
$c== :: NativeUIOptions -> NativeUIOptions -> DepictFigurine
Eq

instance Control.DeepSeq.NFData NativeUIOptions where
	rnf :: NativeUIOptions -> ()
rnf MkNativeUIOptions {
		getBoardMagnification :: NativeUIOptions -> ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
		getColourScheme :: NativeUIOptions -> ColourScheme
getColourScheme		= ColourScheme
colourScheme,
		getDepictFigurine :: NativeUIOptions -> DepictFigurine
getDepictFigurine	= DepictFigurine
depictFigurine
	} = (ScreenCoordinates, ColourScheme, DepictFigurine) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf (
		ScreenCoordinates
boardMagnification,
		ColourScheme
colourScheme,
		DepictFigurine
depictFigurine
	 )

instance Show NativeUIOptions where
	showsPrec :: Int -> NativeUIOptions -> ShowS
showsPrec Int
precision MkNativeUIOptions {
		getBoardMagnification :: NativeUIOptions -> ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
		getColourScheme :: NativeUIOptions -> ColourScheme
getColourScheme		= ColourScheme
colourScheme,
		getDepictFigurine :: NativeUIOptions -> DepictFigurine
getDepictFigurine	= DepictFigurine
depictFigurine
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' [
		(
			String
boardMagnificationTag,
			Int -> ScreenCoordinates -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision ScreenCoordinates
boardMagnification
		), (
			String
Colour.ColourScheme.tag,
			Int -> ColourScheme -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision ColourScheme
colourScheme
		), (
			String
depictFigurineTag,
			Int -> DepictFigurine -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision DepictFigurine
depictFigurine
		)
	 ]

instance Data.Default.Default NativeUIOptions where
	def :: NativeUIOptions
def = MkNativeUIOptions :: ScreenCoordinates
-> ColourScheme -> DepictFigurine -> NativeUIOptions
MkNativeUIOptions {
		getBoardMagnification :: ScreenCoordinates
getBoardMagnification	= (Int
1, Int
1),
		getColourScheme :: ColourScheme
getColourScheme		= ColourScheme
forall a. Default a => a
Data.Default.def,
		getDepictFigurine :: DepictFigurine
getDepictFigurine	= DepictFigurine
False
	}

instance HXT.XmlPickler NativeUIOptions where
	xpickle :: PU NativeUIOptions
xpickle	= String -> PU NativeUIOptions -> PU NativeUIOptions
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU NativeUIOptions -> PU NativeUIOptions)
-> (PU (ScreenCoordinates, ColourScheme, DepictFigurine)
    -> PU NativeUIOptions)
-> PU (ScreenCoordinates, ColourScheme, DepictFigurine)
-> PU NativeUIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenCoordinates, ColourScheme, DepictFigurine)
 -> NativeUIOptions,
 NativeUIOptions
 -> (ScreenCoordinates, ColourScheme, DepictFigurine))
-> PU (ScreenCoordinates, ColourScheme, DepictFigurine)
-> PU NativeUIOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		\(ScreenCoordinates
a, ColourScheme
b, DepictFigurine
c) -> ScreenCoordinates
-> ColourScheme -> DepictFigurine -> NativeUIOptions
mkNativeUIOptions ScreenCoordinates
a ColourScheme
b DepictFigurine
c,	-- Construct.
		\MkNativeUIOptions {
			getBoardMagnification :: NativeUIOptions -> ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
			getColourScheme :: NativeUIOptions -> ColourScheme
getColourScheme		= ColourScheme
colourScheme,
			getDepictFigurine :: NativeUIOptions -> DepictFigurine
getDepictFigurine	= DepictFigurine
depictFigurine
		} -> (
			ScreenCoordinates
boardMagnification,
			ColourScheme
colourScheme,
			DepictFigurine
depictFigurine
		)
	 ) (PU (ScreenCoordinates, ColourScheme, DepictFigurine)
 -> PU NativeUIOptions)
-> PU (ScreenCoordinates, ColourScheme, DepictFigurine)
-> PU NativeUIOptions
forall a b. (a -> b) -> a -> b
$ PU ScreenCoordinates
-> PU ColourScheme
-> PU DepictFigurine
-> PU (ScreenCoordinates, ColourScheme, DepictFigurine)
forall a b c. PU a -> PU b -> PU c -> PU (a, b, c)
HXT.xpTriple (
		NativeUIOptions -> ScreenCoordinates
getBoardMagnification NativeUIOptions
def ScreenCoordinates -> PU ScreenCoordinates -> PU ScreenCoordinates
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU ScreenCoordinates -> PU ScreenCoordinates
forall a. String -> PU a -> PU a
HXT.xpElem String
boardMagnificationTag (
			String -> PU Int -> PU Int
forall a. String -> PU a -> PU a
HXT.xpAttr String
nRowsTag PU Int
forall a. XmlPickler a => PU a
HXT.xpickle PU Int -> PU Int -> PU ScreenCoordinates
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU Int -> PU Int
forall a. String -> PU a -> PU a
HXT.xpAttr String
nColumnsTag PU Int
forall a. XmlPickler a => PU a
HXT.xpickle
		)
	 ) (
		NativeUIOptions -> ColourScheme
getColourScheme NativeUIOptions
def ColourScheme -> PU ColourScheme -> PU ColourScheme
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` PU ColourScheme
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) (
		NativeUIOptions -> DepictFigurine
getDepictFigurine NativeUIOptions
def DepictFigurine -> PU DepictFigurine -> PU DepictFigurine
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU DepictFigurine -> PU DepictFigurine
forall a. String -> PU a -> PU a
HXT.xpAttr String
depictFigurineTag PU DepictFigurine
forall a. XmlPickler a => PU a
HXT.xpickle
	 ) where
		def :: NativeUIOptions
def	= NativeUIOptions
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkNativeUIOptions
	:: ScreenCoordinates	-- ^ The factor by which the dimensions of the board are stretched when displayed.
	-> Colour.ColourScheme.ColourScheme
	-> DepictFigurine
	-> NativeUIOptions
mkNativeUIOptions :: ScreenCoordinates
-> ColourScheme -> DepictFigurine -> NativeUIOptions
mkNativeUIOptions ScreenCoordinates
boardMagnification ColourScheme
colourScheme DepictFigurine
depictFigurine
	| (DepictFigurine -> DepictFigurine -> DepictFigurine)
-> (DepictFigurine, DepictFigurine) -> DepictFigurine
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DepictFigurine -> DepictFigurine -> DepictFigurine
(||) ((DepictFigurine, DepictFigurine) -> DepictFigurine)
-> (DepictFigurine, DepictFigurine) -> DepictFigurine
forall a b. (a -> b) -> a -> b
$ (
		(Int -> Int -> DepictFigurine
forall a. Ord a => a -> a -> DepictFigurine
< Int
1) (Int -> DepictFigurine)
-> (Int -> DepictFigurine)
-> ScreenCoordinates
-> (DepictFigurine, DepictFigurine)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int -> DepictFigurine
forall a. Ord a => a -> a -> DepictFigurine
< Int
1)
	) ScreenCoordinates
boardMagnification	= Exception -> NativeUIOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> NativeUIOptions)
-> (String -> Exception) -> String -> NativeUIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.NativeUIOptions.mkNativeUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
boardMagnificationTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> NativeUIOptions) -> String -> NativeUIOptions
forall a b. (a -> b) -> a -> b
$ ScreenCoordinates -> ShowS
forall a. Show a => a -> ShowS
shows ScreenCoordinates
boardMagnification String
" must both exceed zero."
	| (DepictFigurine -> DepictFigurine -> DepictFigurine)
-> (DepictFigurine, DepictFigurine) -> DepictFigurine
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DepictFigurine -> DepictFigurine -> DepictFigurine
(||) ((DepictFigurine, DepictFigurine) -> DepictFigurine)
-> (DepictFigurine, DepictFigurine) -> DepictFigurine
forall a b. (a -> b) -> a -> b
$ (
		Int -> DepictFigurine
forall a. Integral a => a -> DepictFigurine
even (Int -> DepictFigurine)
-> (Int -> DepictFigurine)
-> ScreenCoordinates
-> (DepictFigurine, DepictFigurine)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> DepictFigurine
forall a. Integral a => a -> DepictFigurine
even
	) ScreenCoordinates
boardMagnification	= Exception -> NativeUIOptions
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> NativeUIOptions)
-> (String -> Exception) -> String -> NativeUIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.NativeUIOptions.mkNativeUIOptions:\t" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
boardMagnificationTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> NativeUIOptions) -> String -> NativeUIOptions
forall a b. (a -> b) -> a -> b
$ ScreenCoordinates -> ShowS
forall a. Show a => a -> ShowS
shows ScreenCoordinates
boardMagnification String
" must both be odd."
	| DepictFigurine
otherwise		= MkNativeUIOptions :: ScreenCoordinates
-> ColourScheme -> DepictFigurine -> NativeUIOptions
MkNativeUIOptions {
		getBoardMagnification :: ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
		getColourScheme :: ColourScheme
getColourScheme		= ColourScheme
colourScheme,
		getDepictFigurine :: DepictFigurine
getDepictFigurine	= DepictFigurine
depictFigurine
	}