{-# LANGUAGE DeriveGeneric, FlexibleContexts #-}
module Game.LambdaHack.Client.UI.Config
( Config(..), mkConfig, applyConfigToDebug
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Control.DeepSeq
import Data.Binary
import qualified Data.Ini as Ini
import qualified Data.Ini.Reader as Ini
import qualified Data.Ini.Types as Ini
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Game.LambdaHack.Common.ClientOptions
import GHC.Generics (Generic)
import System.FilePath
import Text.Read
import Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Common.File
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.RuleKind
data Config = Config
{
configCommands :: ![(K.KM, CmdTriple)]
, configHeroNames :: ![(Int, (Text, Text))]
, configVi :: !Bool
, configLaptop :: !Bool
, configGtkFontFamily :: !Text
, configSdlFontFile :: !Text
, configSdlTtfSizeAdd :: !Int
, configSdlFonSizeAdd :: !Int
, configFontSize :: !Int
, configColorIsBold :: !Bool
, configHistoryMax :: !Int
, configMaxFps :: !Int
, configNoAnim :: !Bool
, configRunStopMsgs :: !Bool
, configCmdline :: ![String]
}
deriving (Show, Generic)
instance NFData Config
instance Binary Config
parseConfig :: Ini.Config -> Config
parseConfig cfg =
let configCommands =
let mkCommand (ident, keydef) =
case stripPrefix "Cmd_" ident of
Just _ ->
let (key, def) = read keydef
in (K.mkKM key, def :: CmdTriple)
Nothing -> assert `failure` "wrong macro id" `twith` ident
section = Ini.allItems "extra_commands" cfg
in map mkCommand section
configHeroNames =
let toNumber (ident, nameAndPronoun) =
case stripPrefix "HeroName_" ident of
Just n -> (read n, read nameAndPronoun)
Nothing -> assert `failure` "wrong hero name id" `twith` ident
section = Ini.allItems "hero_names" cfg
in map toNumber section
getOption :: forall a. Read a => String -> a
getOption optionName =
let lookupFail :: forall b. String -> b
lookupFail err =
assert `failure` ("config file access failed:" <+> T.pack err)
`twith` (optionName, cfg)
s = fromMaybe (lookupFail "") $ Ini.getOption "ui" optionName cfg
in either lookupFail id $ readEither s
configVi = getOption "movementViKeys_hjklyubn"
configLaptop = not configVi && getOption "movementLaptopKeys_uk8o79jl"
configGtkFontFamily = getOption "gtkFontFamily"
configSdlFontFile = getOption "sdlFontFile"
configSdlTtfSizeAdd = getOption "sdlTtfSizeAdd"
configSdlFonSizeAdd = getOption "sdlFonSizeAdd"
configFontSize = getOption "fontSize"
configColorIsBold = getOption "colorIsBold"
configHistoryMax = getOption "historyMax"
configMaxFps = max 1 $ getOption "maxFps"
configNoAnim = getOption "noAnim"
configRunStopMsgs = getOption "runStopMsgs"
configCmdline = words $ getOption "overrideCmdline"
in Config{..}
mkConfig :: Kind.COps -> Bool -> IO Config
mkConfig Kind.COps{corule} benchmark = do
let stdRuleset = Kind.stdRuleset corule
cfgUIName = rcfgUIName stdRuleset
sUIDefault = rcfgUIDefault stdRuleset
cfgUIDefault = either (assert `failure`) id $ Ini.parse sUIDefault
dataDir <- appDataDir
let userPath = dataDir </> cfgUIName
cfgUser <- if benchmark then return Ini.emptyConfig else do
cpExists <- doesFileExist userPath
if not cpExists
then return Ini.emptyConfig
else do
sUser <- readFile userPath
return $! either (assert `failure`) id $ Ini.parse sUser
let cfgUI = M.unionWith M.union cfgUser cfgUIDefault
conf = parseConfig cfgUI
return $! deepseq conf conf
applyConfigToDebug :: Kind.COps -> Config -> DebugModeCli -> DebugModeCli
applyConfigToDebug Kind.COps{corule} sconfig sdebugCli =
let stdRuleset = Kind.stdRuleset corule
in (\dbg -> dbg {sgtkFontFamily =
sgtkFontFamily dbg `mplus` Just (configGtkFontFamily sconfig)}) .
(\dbg -> dbg {sdlFontFile =
sdlFontFile dbg `mplus` Just (configSdlFontFile sconfig)}) .
(\dbg -> dbg {sdlTtfSizeAdd =
sdlTtfSizeAdd dbg `mplus` Just (configSdlTtfSizeAdd sconfig)}) .
(\dbg -> dbg {sdlFonSizeAdd =
sdlFonSizeAdd dbg `mplus` Just (configSdlFonSizeAdd sconfig)}) .
(\dbg -> dbg {sfontSize =
sfontSize dbg `mplus` Just (configFontSize sconfig)}) .
(\dbg -> dbg {scolorIsBold =
scolorIsBold dbg `mplus` Just (configColorIsBold sconfig)}) .
(\dbg -> dbg {smaxFps =
smaxFps dbg `mplus` Just (configMaxFps sconfig)}) .
(\dbg -> dbg {snoAnim =
snoAnim dbg `mplus` Just (configNoAnim sconfig)}) .
(\dbg -> dbg {stitle =
stitle dbg `mplus` Just (rtitle stdRuleset)})
$ sdebugCli