{-# LANGUAGE DeriveGeneric #-}
-- | UI client options specified in the config file.
module Game.LambdaHack.Client.UI.UIOptions
  ( UIOptions(..)
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Control.DeepSeq
import Data.Binary
import GHC.Generics (Generic)

import           Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Common.ClientOptions (FullscreenMode)
import           Game.LambdaHack.Common.Misc
import qualified Game.LambdaHack.Definition.Color as Color

-- | Options that affect the UI of the client, specified in the config file. More documentation is in the default config file.
data UIOptions = UIOptions
  { -- commands
    UIOptions -> [(KM, CmdTriple)]
uCommands         :: [(K.KM, CmdTriple)]
    -- hero names
  , UIOptions -> [(Int, (Text, Text))]
uHeroNames        :: [(Int, (Text, Text))]
    -- ui
  , UIOptions -> Bool
uVi               :: Bool
  , UIOptions -> Bool
uLeftHand         :: Bool
  , UIOptions -> Text
uChosenFontset    :: Text
  , UIOptions -> Double
uAllFontsScale    :: Double
  , UIOptions -> Bool
uScreen1PerLine   :: Bool
  , UIOptions -> Bool
uHistory1PerLine  :: Bool
  , UIOptions -> Int
uHistoryMax       :: Int
  , UIOptions -> Double
uMaxFps           :: Double
  , UIOptions -> Bool
uNoAnim           :: Bool
  , UIOptions -> Int
uhpWarningPercent :: Int
      -- ^ HP percent at which warning is emitted.
  , UIOptions -> [(String, Color)]
uMessageColors    :: [(String, Color.Color)]
      -- ^ Prefixes of message class constructor names paired with colors.
      --   The first prefix that matches, wins.
  , UIOptions -> [String]
uCmdline          :: [String]
      -- ^ Hardwired commandline arguments to process.
  , UIOptions -> [(Text, FontDefinition)]
uFonts            :: [(Text, FontDefinition)]
  , UIOptions -> [(Text, FontSet)]
uFontsets         :: [(Text, FontSet)]
  , UIOptions -> FullscreenMode
uFullscreenMode   :: FullscreenMode
  }
  deriving (Int -> UIOptions -> ShowS
[UIOptions] -> ShowS
UIOptions -> String
(Int -> UIOptions -> ShowS)
-> (UIOptions -> String)
-> ([UIOptions] -> ShowS)
-> Show UIOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UIOptions] -> ShowS
$cshowList :: [UIOptions] -> ShowS
show :: UIOptions -> String
$cshow :: UIOptions -> String
showsPrec :: Int -> UIOptions -> ShowS
$cshowsPrec :: Int -> UIOptions -> ShowS
Show, (forall x. UIOptions -> Rep UIOptions x)
-> (forall x. Rep UIOptions x -> UIOptions) -> Generic UIOptions
forall x. Rep UIOptions x -> UIOptions
forall x. UIOptions -> Rep UIOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UIOptions x -> UIOptions
$cfrom :: forall x. UIOptions -> Rep UIOptions x
Generic)

instance NFData UIOptions

instance Binary UIOptions