1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
-- | UI client options.
module Game.LambdaHack.Client.UI.UIOptionsParse
( mkUIOptions, applyUIOptions
#ifdef EXPOSE_INTERNAL
-- * Internal operations
, configError, readError, parseConfig
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Control.DeepSeq
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 Data.Version
import System.FilePath
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.Read
import Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.UIOptions
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.File
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Save (compatibleVersion, delayPrint)
import qualified Game.LambdaHack.Common.Save as Save
import Game.LambdaHack.Content.RuleKind
configError :: String -> a
configError err = error $ "Error when parsing configuration file. Please fix config.ui.ini or remove it altogether. The details:\n" ++ err
readError :: Read a => String -> a
readError s = either (configError . ("when reading:\n" ++ s `showFailure`)) id
$ readEither s
parseConfig :: Ini.Config -> UIOptions
parseConfig cfg =
let uCommands =
let mkCommand (ident, keydef) =
case stripPrefix "Cmd_" ident of
Just _ ->
let (key, def) = readError keydef
in (K.mkKM key, def :: CmdTriple)
Nothing ->
configError
$ "macro id should start with Cmd_ and it does not:"
`showFailure` ident
section = Ini.allItems "additional_commands" cfg
in map mkCommand section
uHeroNames =
let toNumber (ident, nameAndPronoun) =
case stripPrefix "HeroName_" ident of
Just n -> (readError n, readError nameAndPronoun)
Nothing -> configError
$ "wrong hero name id" `showFailure` ident
section = Ini.allItems "hero_names" cfg
in map toNumber section
lookupFail :: forall b. String -> String -> b
lookupFail optionName err =
configError $ "config file access failed"
`showFailure` (err, optionName, cfg)
_getOptionMaybe :: forall a. Read a => String -> Maybe a
_getOptionMaybe optionName =
let ms = Ini.getOption "ui" optionName cfg
in either (lookupFail optionName) id . readEither <$> ms
getOption :: forall a. Read a => String -> a
getOption optionName =
let s = fromMaybe (lookupFail optionName "")
$ Ini.getOption "ui" optionName cfg
in either (lookupFail optionName) id $ readEither s
uVi = getOption "movementViKeys_hjklyubn"
uLeftHand = getOption "movementLeftHandKeys_axwdqezc"
uChosenFontset = getOption "chosenFontset"
uAllFontsScale = getOption "allFontsScale"
uFullscreenMode = getOption "fullscreenMode"
uhpWarningPercent = getOption "hpWarningPercent"
uMsgWrapColumn = getOption "msgWrapColumn"
uHistoryMax = getOption "historyMax"
uMaxFps = max 1 $ getOption "maxFps"
uNoAnim = getOption "noAnim"
uOverrideCmdline = glueSeed $ words $ getOption "overrideCmdline"
uFonts =
let toFont (ident, fontString) = (T.pack ident, readError fontString)
section = Ini.allItems "fonts" cfg
in map toFont section
uFontsets =
let toFontSet (ident, fontSetString) =
(T.pack ident, readError fontSetString)
section = Ini.allItems "fontsets" cfg
in map toFontSet section
uMessageColors =
map (second readError) $ Ini.allItems "message_colors" cfg
in UIOptions{..}
glueSeed :: [String] -> [String]
glueSeed [] = []
glueSeed ("SMGen" : s1 : s2 : rest) =
("SMGen" ++ " " ++ s1 ++ " " ++ s2) : glueSeed rest
glueSeed (s : rest) = s : glueSeed rest
-- | Read and parse UI config file.
mkUIOptions :: RuleContent -> ClientOptions -> IO UIOptions
mkUIOptions corule clientOptions = do
let benchmark = sbenchmark clientOptions
cfgUIName = rcfgUIName corule
(configText, cfgUIDefault) = rcfgUIDefault corule
dataDir <- appDataDir
let path bkp = dataDir </> bkp <> cfgUIName
cfgUser <- if benchmark then return Ini.emptyConfig else do
cpExists <- doesFileExist (path "")
if not cpExists
then return Ini.emptyConfig
else do
sUser <- readFile (path "")
return $! either (configError . ("Ini.parse sUser" `showFailure`)) id
$ Ini.parse sUser
let cfgUI = M.unionWith M.union cfgUser cfgUIDefault -- user cfg preferred
vExe1 = rexeVersion corule
vExe2 =
let optionName = "version"
-- Lenient to parse, and reject, old config files:
s = fromMaybe "" $ Ini.getOption "version" optionName cfgUser
dummyVersion = makeVersion []
in case find ((== "") . snd) $ readP_to_S parseVersion s of
Just (ver, "") -> ver
_ -> dummyVersion
if benchmark || compatibleVersion vExe1 vExe2 then do
let conf = parseConfig cfgUI
-- Catch syntax errors in complex expressions ASAP.
return $! deepseq conf conf
else do
cpExists <- doesFileExist (path "")
when cpExists $ do
renameFile (path "") (path "bkp.")
moveAside <- Save.bkpAllSaves corule clientOptions
let msg = "Config file" <+> T.pack (path "")
<+> "from an incompatible version '"
<> T.pack (showVersion vExe2)
<> "' detected while starting"
<+> T.pack (showVersion vExe1)
<+> "game."
<+> if moveAside
then "The config file and savefiles have been moved aside."
else "The config file has been moved aside."
delayPrint msg
dataDirExists <- doesFileExist dataDir
when dataDirExists $ -- may not exist, e.g., when testing
tryWriteFile (path "") configText
let confDefault = parseConfig cfgUIDefault
return confDefault
-- | Modify client options with UI options.
applyUIOptions :: COps -> UIOptions -> ClientOptions -> ClientOptions
applyUIOptions COps{corule} uioptions =
(\opts -> opts {schosenFontset =
schosenFontset opts `mplus` Just (uChosenFontset uioptions)}) .
(\opts -> opts {sallFontsScale =
sallFontsScale opts `mplus` Just (uAllFontsScale uioptions)}) .
(\opts -> opts {sfullscreenMode =
sfullscreenMode opts `mplus` Just (uFullscreenMode 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 corule)}) .
(\opts -> opts {sfonts = uFonts uioptions}) .
(\opts -> opts {sfontsets = uFontsets uioptions})
|
