{-# 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 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 -> error $ "wrong macro id" `showFailure` 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 -> error $ "wrong hero name id" `showFailure` 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 =
error $ "config file access failed"
`showFailure` (err, 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 (error . ("" `showFailure`)) 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 (error . ("" `showFailure`)) 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)}) .
(\dbg -> dbg {sfontDir =
sfontDir dbg `mplus` Just (rfontDir stdRuleset)})
$ sdebugCli