module BishBosh.Input.NativeUIOptions(
NativeUIOptions(
getBoardMagnification,
getColourScheme
),
tag,
boardMagnificationTag,
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
tag :: String
tag :: String
tag = String
"nativeUIOptions"
boardMagnificationTag :: String
boardMagnificationTag :: String
boardMagnificationTag = String
"boardMagnification"
nRowsTag :: String
nRowsTag :: String
nRowsTag = String
"nRows"
nColumnsTag :: String
nColumnsTag :: String
nColumnsTag = String
"nColumns"
type ScreenCoordinates = (Type.Length.Row, Type.Length.Column)
data NativeUIOptions = MkNativeUIOptions {
NativeUIOptions -> ScreenCoordinates
getBoardMagnification :: ScreenCoordinates,
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,
\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
mkNativeUIOptions
:: ScreenCoordinates
-> 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
}