{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Client.UI.UIOptions
( UIOptions(..), mkUIOptions, applyUIOptions
#ifdef EXPOSE_INTERNAL
, parseConfig
#endif
) 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.Client.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 Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.RuleKind
data UIOptions = UIOptions
{
uCommands :: [(K.KM, CmdTriple)]
, uHeroNames :: [(Int, (Text, Text))]
, uVi :: Bool
, uLaptop :: Bool
, uGtkFontFamily :: Text
, uSdlFontFile :: Text
, uSdlTtfSizeAdd :: Int
, uSdlFonSizeAdd :: Int
, uFontSize :: Int
, uColorIsBold :: Bool
, uHistoryMax :: Int
, uMaxFps :: Int
, uNoAnim :: Bool
, uRunStopMsgs :: Bool
, uhpWarningPercent :: Int
, uCmdline :: [String]
}
deriving (Show, Generic)
instance NFData UIOptions
instance Binary UIOptions
parseConfig :: Ini.Config -> UIOptions
parseConfig cfg =
let uCommands =
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
uHeroNames =
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
uVi = getOption "movementViKeys_hjklyubn"
uLaptop = not uVi && getOption "movementLaptopKeys_uk8o79jl"
uGtkFontFamily = getOption "gtkFontFamily"
uSdlFontFile = getOption "sdlFontFile"
uSdlTtfSizeAdd = getOption "sdlTtfSizeAdd"
uSdlFonSizeAdd = getOption "sdlFonSizeAdd"
uFontSize = getOption "fontSize"
uColorIsBold = getOption "colorIsBold"
uHistoryMax = getOption "historyMax"
uMaxFps = max 1 $ getOption "maxFps"
uNoAnim = getOption "noAnim"
uRunStopMsgs = getOption "runStopMsgs"
uhpWarningPercent = getOption "hpWarningPercent"
uCmdline = words $ getOption "overrideCmdline"
in UIOptions{..}
mkUIOptions :: COps -> Bool -> IO UIOptions
mkUIOptions cops benchmark = do
let stdRuleset = getStdRuleset cops
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
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions cops uioptions soptions =
let stdRuleset = getStdRuleset cops
in (\opts -> opts {sgtkFontFamily =
sgtkFontFamily opts `mplus` Just (uGtkFontFamily uioptions)}) .
(\opts -> opts {sdlFontFile =
sdlFontFile opts `mplus` Just (uSdlFontFile uioptions)}) .
(\opts -> opts {sdlTtfSizeAdd =
sdlTtfSizeAdd opts `mplus` Just (uSdlTtfSizeAdd uioptions)}) .
(\opts -> opts {sdlFonSizeAdd =
sdlFonSizeAdd opts `mplus` Just (uSdlFonSizeAdd uioptions)}) .
(\opts -> opts {sfontSize =
sfontSize opts `mplus` Just (uFontSize uioptions)}) .
(\opts -> opts {scolorIsBold =
scolorIsBold opts `mplus` Just (uColorIsBold uioptions)}) .
(\opts -> opts {smaxFps =
smaxFps opts `mplus` Just (uMaxFps uioptions)}) .
(\opts -> opts {snoAnim =
snoAnim opts `mplus` Just (uNoAnim uioptions)}) .
(\opts -> opts {stitle =
stitle opts `mplus` Just (rtitle stdRuleset)}) .
(\opts -> opts {sfontDir =
sfontDir opts `mplus` Just (rfontDir stdRuleset)})
$ soptions