{-
	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,
-- ** 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	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.
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)

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

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

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

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

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) -> PU NativeUIOptions)
-> PU (ScreenCoordinates, ColourScheme)
-> PU NativeUIOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenCoordinates, ColourScheme) -> NativeUIOptions,
 NativeUIOptions -> (ScreenCoordinates, ColourScheme))
-> PU (ScreenCoordinates, ColourScheme) -> PU NativeUIOptions
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		(ScreenCoordinates -> ColourScheme -> NativeUIOptions)
-> (ScreenCoordinates, ColourScheme) -> NativeUIOptions
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScreenCoordinates -> ColourScheme -> NativeUIOptions
mkNativeUIOptions,	-- Construct.
		\MkNativeUIOptions {
			getBoardMagnification :: NativeUIOptions -> ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
			getColourScheme :: NativeUIOptions -> ColourScheme
getColourScheme		= ColourScheme
colourScheme
		} -> (
			ScreenCoordinates
boardMagnification,
			ColourScheme
colourScheme
		)
	 ) (PU (ScreenCoordinates, ColourScheme) -> PU NativeUIOptions)
-> PU (ScreenCoordinates, ColourScheme) -> PU NativeUIOptions
forall a b. (a -> b) -> a -> b
$ PU ScreenCoordinates
-> PU ColourScheme -> PU (ScreenCoordinates, ColourScheme)
forall a b. PU a -> PU b -> PU (a, b)
HXT.xpPair (
		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
	 ) 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.
	-> Attribute.ColourScheme.ColourScheme
	-> NativeUIOptions
mkNativeUIOptions :: ScreenCoordinates -> ColourScheme -> NativeUIOptions
mkNativeUIOptions ScreenCoordinates
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
$ (
		(Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (Int -> Bool) -> (Int -> Bool) -> ScreenCoordinates -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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."
	| (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
$ (
		Int -> Bool
forall a. Integral a => a -> Bool
even (Int -> Bool) -> (Int -> Bool) -> ScreenCoordinates -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> Bool
forall a. Integral a => a -> Bool
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."
	| Bool
otherwise		= MkNativeUIOptions :: ScreenCoordinates -> ColourScheme -> NativeUIOptions
MkNativeUIOptions {
		getBoardMagnification :: ScreenCoordinates
getBoardMagnification	= ScreenCoordinates
boardMagnification,
		getColourScheme :: ColourScheme
getColourScheme		= ColourScheme
colourScheme
	}