{-
	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 interface(s).
-}

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

import			Control.Arrow((***))
import qualified	BishBosh.Attribute.ColourScheme	as Attribute.ColourScheme
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Text.ShowList		as Text.ShowList
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.
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.
type ScreenCoordinates row column	= (row, column)

-- | Constructor.
data NativeUIOptions row column	= MkNativeUIOptions {
	NativeUIOptions row column -> ScreenCoordinates row column
getBoardMagnification	:: ScreenCoordinates row column,	-- ^ The factor by which the dimensions of the board are stretched when displayed.
	NativeUIOptions row column -> ColourScheme
getColourScheme		:: Attribute.ColourScheme.ColourScheme
} deriving NativeUIOptions row column -> NativeUIOptions row column -> Bool
(NativeUIOptions row column -> NativeUIOptions row column -> Bool)
-> (NativeUIOptions row column
    -> NativeUIOptions row column -> Bool)
-> Eq (NativeUIOptions row column)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall row column.
(Eq row, Eq column) =>
NativeUIOptions row column -> NativeUIOptions row column -> Bool
/= :: NativeUIOptions row column -> NativeUIOptions row column -> Bool
$c/= :: forall row column.
(Eq row, Eq column) =>
NativeUIOptions row column -> NativeUIOptions row column -> Bool
== :: NativeUIOptions row column -> NativeUIOptions row column -> Bool
$c== :: forall row column.
(Eq row, Eq column) =>
NativeUIOptions row column -> NativeUIOptions row column -> Bool
Eq

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

instance (Show row, Show column) => Show (NativeUIOptions row column) where
	showsPrec :: Int -> NativeUIOptions row column -> ShowS
showsPrec Int
_ MkNativeUIOptions {
		getBoardMagnification :: forall row column.
NativeUIOptions row column -> ScreenCoordinates row column
getBoardMagnification	= ScreenCoordinates row column
boardMagnification,
		getColourScheme :: forall row column. NativeUIOptions row column -> ColourScheme
getColourScheme		= ColourScheme
colourScheme
	} = [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList' [
		(
			String
boardMagnificationTag,
			ScreenCoordinates row column -> ShowS
forall a. Show a => a -> ShowS
shows ScreenCoordinates row column
boardMagnification
		), (
			String
Attribute.ColourScheme.tag,
			ColourScheme -> ShowS
forall a. Show a => a -> ShowS
shows ColourScheme
colourScheme
		)
	 ]

instance (Num row, Num column) => Data.Default.Default (NativeUIOptions row column) where
	def :: NativeUIOptions row column
def = MkNativeUIOptions :: forall row column.
ScreenCoordinates row column
-> ColourScheme -> NativeUIOptions row column
MkNativeUIOptions {
		getBoardMagnification :: ScreenCoordinates row column
getBoardMagnification	= (row
1, column
1),
		getColourScheme :: ColourScheme
getColourScheme		= ColourScheme
forall a. Default a => a
Data.Default.def
	}

instance (
	HXT.XmlPickler	column,
	HXT.XmlPickler	row,
	Integral	column,
	Integral	row,
	Show		column,
	Show		row
 ) => HXT.XmlPickler (NativeUIOptions row column) where
	xpickle :: PU (NativeUIOptions row column)
xpickle	= String
-> PU (NativeUIOptions row column)
-> PU (NativeUIOptions row column)
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU (NativeUIOptions row column)
 -> PU (NativeUIOptions row column))
-> (PU (ScreenCoordinates row column, ColourScheme)
    -> PU (NativeUIOptions row column))
-> PU (ScreenCoordinates row column, ColourScheme)
-> PU (NativeUIOptions row column)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenCoordinates row column, ColourScheme)
 -> NativeUIOptions row column,
 NativeUIOptions row column
 -> (ScreenCoordinates row column, ColourScheme))
-> PU (ScreenCoordinates row column, ColourScheme)
-> PU (NativeUIOptions row column)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		(ScreenCoordinates row column
 -> ColourScheme -> NativeUIOptions row column)
-> (ScreenCoordinates row column, ColourScheme)
-> NativeUIOptions row column
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScreenCoordinates row column
-> ColourScheme -> NativeUIOptions row column
forall column row.
(Integral column, Integral row, Show column, Show row) =>
ScreenCoordinates row column
-> ColourScheme -> NativeUIOptions row column
mkNativeUIOptions,	-- Construct.
		\MkNativeUIOptions {
			getBoardMagnification :: forall row column.
NativeUIOptions row column -> ScreenCoordinates row column
getBoardMagnification	= ScreenCoordinates row column
boardMagnification,
			getColourScheme :: forall row column. NativeUIOptions row column -> ColourScheme
getColourScheme		= ColourScheme
colourScheme
		} -> (
			ScreenCoordinates row column
boardMagnification,
			ColourScheme
colourScheme
		)
	 ) (PU (ScreenCoordinates row column, ColourScheme)
 -> PU (NativeUIOptions row column))
-> PU (ScreenCoordinates row column, ColourScheme)
-> PU (NativeUIOptions row column)
forall a b. (a -> b) -> a -> b
$ PU (ScreenCoordinates row column)
-> PU ColourScheme
-> PU (ScreenCoordinates row column, ColourScheme)
forall a b. PU a -> PU b -> PU (a, b)
HXT.xpPair (
		NativeUIOptions row column -> ScreenCoordinates row column
forall row column.
NativeUIOptions row column -> ScreenCoordinates row column
getBoardMagnification NativeUIOptions row column
def ScreenCoordinates row column
-> PU (ScreenCoordinates row column)
-> PU (ScreenCoordinates row column)
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String
-> PU (ScreenCoordinates row column)
-> PU (ScreenCoordinates row column)
forall a. String -> PU a -> PU a
HXT.xpElem String
boardMagnificationTag (
			String -> PU row -> PU row
forall a. String -> PU a -> PU a
HXT.xpAttr String
nRowsTag PU row
forall a. XmlPickler a => PU a
HXT.xpickle PU row -> PU column -> PU (ScreenCoordinates row column)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` String -> PU column -> PU column
forall a. String -> PU a -> PU a
HXT.xpAttr String
nColumnsTag PU column
forall a. XmlPickler a => PU a
HXT.xpickle
		)
	 ) (
		NativeUIOptions row column -> ColourScheme
forall row column. NativeUIOptions row column -> ColourScheme
getColourScheme NativeUIOptions row column
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
	 ) where
		def :: NativeUIOptions row column
def	= NativeUIOptions row column
forall a. Default a => a
Data.Default.def

-- | Smart constructor.
mkNativeUIOptions :: (
	Integral	column,
	Integral	row,
	Show		column,
	Show		row
 )
	=> ScreenCoordinates row column		-- ^ The factor by which the dimensions of the board are stretched when displayed.
	-> Attribute.ColourScheme.ColourScheme
	-> NativeUIOptions row column
mkNativeUIOptions :: ScreenCoordinates row column
-> ColourScheme -> NativeUIOptions row column
mkNativeUIOptions ScreenCoordinates row column
boardMagnification ColourScheme
colourScheme
	| (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ (
		(row -> row -> Bool
forall a. Ord a => a -> a -> Bool
< row
1) (row -> Bool)
-> (column -> Bool) -> ScreenCoordinates row column -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (column -> column -> Bool
forall a. Ord a => a -> a -> Bool
< column
1)
	) ScreenCoordinates row column
boardMagnification	= Exception -> NativeUIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> NativeUIOptions row column)
-> (String -> Exception) -> String -> NativeUIOptions row column
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 row column)
-> String -> NativeUIOptions row column
forall a b. (a -> b) -> a -> b
$ ScreenCoordinates row column -> ShowS
forall a. Show a => a -> ShowS
shows ScreenCoordinates row column
boardMagnification String
" must both exceed zero."
	| (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ (
		row -> Bool
forall a. Integral a => a -> Bool
even (row -> Bool)
-> (column -> Bool) -> ScreenCoordinates row column -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** column -> Bool
forall a. Integral a => a -> Bool
even
	) ScreenCoordinates row column
boardMagnification	= Exception -> NativeUIOptions row column
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> NativeUIOptions row column)
-> (String -> Exception) -> String -> NativeUIOptions row column
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 row column)
-> String -> NativeUIOptions row column
forall a b. (a -> b) -> a -> b
$ ScreenCoordinates row column -> ShowS
forall a. Show a => a -> ShowS
shows ScreenCoordinates row column
boardMagnification String
" must both be odd."
	| Bool
otherwise		= MkNativeUIOptions :: forall row column.
ScreenCoordinates row column
-> ColourScheme -> NativeUIOptions row column
MkNativeUIOptions {
		getBoardMagnification :: ScreenCoordinates row column
getBoardMagnification	= ScreenCoordinates row column
boardMagnification,
		getColourScheme :: ColourScheme
getColourScheme		= ColourScheme
colourScheme
	}