module BishBosh.Input.NativeUIOptions(
ScreenCoordinates,
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 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 row column = (row, column)
data NativeUIOptions row column = MkNativeUIOptions {
NativeUIOptions row column -> ScreenCoordinates row column
getBoardMagnification :: ScreenCoordinates row column,
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,
\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
mkNativeUIOptions :: (
Integral column,
Integral row,
Show column,
Show row
)
=> ScreenCoordinates row column
-> 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
}