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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
|
{-# LANGUAGE RankNTypes #-}
-- | Verifying, aggregating and displaying binding of keys to commands.
module Game.LambdaHack.Client.UI.KeyBindings
( keyHelp, okxsN
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Game.LambdaHack.Client.UI.Content.Input
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Client.UI.Slideshow
import qualified Game.LambdaHack.Definition.Color as Color
-- | Produce a set of help/menu screens from the key bindings.
--
-- When the intro screen mentions KP_5, this really is KP_Begin,
-- but since that is harder to understand we assume a different, non-default
-- state of NumLock in the help text than in the code that handles keys.
keyHelp :: CCUI -> FontSetup -> [(Text, OKX)]
keyHelp CCUI{ coinput=coinput@InputContent{..}
, coscreen=ScreenContent{rwidth, rheight} } FontSetup{..} =
let
movBlurb1 =
[ "Walk throughout a level with mouse or numeric keypad (right diagram below)"
, "or the Vi editor keys (middle) or the left-hand movement keys (left). Run until"
, "disturbed with Shift or Control. Go-to a position with LMB (left mouse button)."
, "In aiming mode, the same keys (and mouse) move the aiming crosshair."
]
movSchema =
[ " q w e y k u 7 8 9"
, " \\|/ \\|/ \\|/"
, " a-s-d h-.-l 4-5-6"
, " /|\\ /|\\ /|\\"
, " z x c b j n 1 2 3"
]
movBlurb2 =
[ "Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any"
, "damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`"
, "(the same key with Shift or Control) to lurk 0.1 of a turn, without bracing."
, ""
, "Displace enemies by running into them with Shift/Control or S-LMB. Search,"
, "open, descend and melee by bumping into walls, doors, stairs and enemies."
, "The best, and not on cooldown, melee weapon is automatically chosen"
, "for attack from your equipment and from among your body parts."
]
minimalBlurb =
[ "The following few commands, joined with the movement and running keys,"
, "let you accomplish almost anything in the game, though not necessarily"
, "with the fewest keystrokes. You can also play the game exclusively"
, "with a mouse, or both mouse and keyboard (e.g., mouse for go-to"
, "and terrain inspection and keyboard for everything else). Lastly,"
, "you can select a command with arrows or mouse directly from the help"
, "screen or the dashboard and execute it on the spot."
]
itemAllEnding =
[ "Note how lower case item commands (stash item, equip item) place items"
, "into a particular item store, while upper case item commands (manage Inventory,"
, "manage Outfit) open management menu for a store. Once a store menu is opened,"
, "you can switch stores with `<` and `>`, so the multiple commands only determine"
, "the starting item store. Each store is accessible from the dashboard as well."
]
mouseBasicsBlurb =
[ "Screen area and UI mode (exploration/aiming) determine mouse click"
, "effects. Here we give an overview of effects of each button over"
, "the game map area. The list includes not only left and right buttons,"
, "but also the optional middle mouse button (MMB) and the mouse wheel,"
, "which is also used over menus to move selection. For mice without RMB,"
, "one can use Control key with LMB and for mice without MMB, one can use"
, "C-RMB or C-S-LMB."
]
mouseAreasBlurb =
[ "Next we show mouse button effects per screen area, in exploration and"
, "(if different) aiming mode. Note that mouse is optional. Keyboard suffices,"
, "occasionally requiring a lookup for an obscure command key in help screens."
]
mouseAreasMini =
[ "Mouse button effects per screen area, in exploration and in aiming modes"
]
movTextEnd = "Press SPACE or PGDN to advance or ESC to see the map again."
lastHelpEnd = "Use PGUP to go back and ESC to see the map again."
seeAlso = "For more playing instructions see file PLAYING.md."
offsetCol2 = 12
pickLeaderDescription =
[ fmt offsetCol2 "0, 1 ... 9"
"pick a particular actor as the new pointman"
]
casualDescription = "Minimal cheat sheet for casual play"
fmt0 n k h = T.justifyLeft n ' ' k <> " " <> h
fmt n k h = " " <> fmt0 n k h
keyCaption = fmt offsetCol2 "keys" "command"
mouseOverviewCaption = fmt offsetCol2 "keys" "command (exploration/aiming)"
spLen = textSize monoFont " "
okxs cat headers footers = xytranslateOKX spLen 0 $
okxsN coinput monoFont propFont offsetCol2 (const False)
True cat headers footers
mergeOKX :: OKX -> OKX -> OKX
mergeOKX okx1 okx2 =
let off = 1 + maxYofFontOverlayMap (fst okx1)
in sideBySideOKX 0 off okx1 okx2
catLength cat = length $ filter (\(_, (cats, desc, _)) ->
cat `elem` cats && (desc /= "" || CmdInternal `elem` cats)) bcmdList
keyM = 13
keyB = 31
truncatem b = if T.length b > keyB
then T.take (keyB - 1) b <> "$"
else b
fmm a b c = fmt (keyM + 1) a $ fmt0 keyB (truncatem b) (truncatem c)
areaCaption t = fmm t "LMB (left mouse button)" "RMB (right mouse button)"
keySel :: (forall a. (a, a) -> a) -> K.KM
-> [(CmdArea, KeyOrSlot, Text)]
keySel sel key =
let cmd = case M.lookup key bcmdMap of
Just (_, _, cmd2) -> cmd2
Nothing -> error $ "" `showFailure` key
caCmds = case cmd of
ByAimMode AimModeCmd{exploration=ByArea lexp, aiming=ByArea laim} ->
sort $ sel (lexp, laim \\ lexp)
_ -> error $ "" `showFailure` cmd
caMakeChoice (ca, cmd2) =
let (km, desc) = case M.lookup cmd2 brevMap of
Just ks ->
let descOfKM km2 = case M.lookup km2 bcmdMap of
Just (_, "", _) -> Nothing
Just (_, desc2, _) -> Just (km2, desc2)
Nothing -> error $ "" `showFailure` km2
in case mapMaybe descOfKM ks of
[] -> error $ "" `showFailure` (ks, cmd2)
kmdesc3 : _ -> kmdesc3
Nothing -> (key, "(not described:" <+> tshow cmd2 <> ")")
in (ca, Left km, desc)
in map caMakeChoice caCmds
doubleIfSquare n | isSquareFont monoFont = 2 * n
| otherwise = n
okm :: (forall a. (a, a) -> a) -> K.KM -> K.KM -> [Text] -> OKX
okm sel key1 key2 header =
let kst1 = keySel sel key1
kst2 = keySel sel key2
f (ca1, Left km1, _) (ca2, Left km2, _) y =
assert (ca1 == ca2 `blame` (ca1, ca2, km1, km2, kst1, kst2))
[ (Left km1, ( PointUI (doubleIfSquare $ keyM + 4) y
, ButtonWidth monoFont keyB ))
, (Left km2, ( PointUI (doubleIfSquare $ keyB + keyM + 5) y
, ButtonWidth monoFont keyB )) ]
f c d e = error $ "" `showFailure` (c, d, e)
kxs = concat $ zipWith3 f kst1 kst2 [1 + length header..]
menuLeft = map (\(ca1, _, _) -> textToAL $ areaDescription ca1) kst1
menuMiddle = map (\(_, _, desc) -> textToAL desc) kst1
menuRight = map (\(_, _, desc) -> textToAL desc) kst2
y0 = 1 + length header
in ( EM.unionsWith (++)
[ typesetInMono $ "" : header
, EM.singleton monoFont
$ typesetXY (doubleIfSquare 2, y0) menuLeft
, EM.singleton propFont
$ typesetXY (doubleIfSquare $ keyM + 4, y0) menuMiddle
, EM.singleton propFont
$ typesetXY (doubleIfSquare $ keyB + keyM + 5, y0) menuRight ]
, kxs )
typesetInSquare :: [Text] -> FontOverlayMap
typesetInSquare =
EM.singleton squareFont . typesetXY (spLen, 0) . map textToAL
typesetInMono :: [Text] -> FontOverlayMap
typesetInMono =
EM.singleton monoFont . typesetXY (spLen, 0) . map textToAL
typesetInProp :: [Text] -> FontOverlayMap
typesetInProp =
EM.singleton propFont . typesetXY (spLen, 0) . map textToAL
sideBySide :: [(Text, OKX)] -> [(Text, OKX)]
sideBySide ((_t1, okx1) : (t2, okx2) : rest) | not (isSquareFont propFont) =
(t2, sideBySideOKX rwidth 0 okx1 okx2) : sideBySide rest
sideBySide l = l
in sideBySide $ concat
[ if catLength CmdMinimal
+ length movBlurb1 + length movSchema + length movBlurb2
+ length minimalBlurb
+ 6 > rheight then
[ ( movTextEnd
, mergeOKX
(mergeOKX ( typesetInMono ["", casualDescription <+> "(1/2)", ""]
, [] )
(mergeOKX (typesetInProp movBlurb1, [])
(typesetInSquare $ "" : movSchema, [])))
(typesetInProp $ "" : movBlurb2, []) )
, ( movTextEnd
, okxs CmdMinimal
( ["", casualDescription <+> "(2/2)", ""]
, minimalBlurb ++ [""]
, [keyCaption] )
([], []) ) ]
else
[ ( movTextEnd
, mergeOKX
(mergeOKX ( typesetInMono ["", casualDescription, ""]
, [] )
(mergeOKX (typesetInProp movBlurb1, [])
(typesetInSquare $ "" : movSchema, [])))
(okxs CmdMinimal
( []
, [""] ++ movBlurb2 ++ [""]
++ minimalBlurb ++ [""]
, [keyCaption] )
([], [""])) ) ]
, if 45 > rheight then
[ ( movTextEnd
, let (ls, _) = okxs CmdMouse
( ["", "Optional mouse commands", ""]
, mouseBasicsBlurb ++ [""]
, [mouseOverviewCaption] )
([], [])
in (ls, []) ) -- don't capture mouse wheel, etc.
, ( movTextEnd
, mergeOKX
(typesetInMono $ "" : mouseAreasMini, [])
(mergeOKX
(okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "Exploration"])
(okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "Aiming Mode"])) ) ]
else
[ ( movTextEnd
, let (ls, _) = okxs CmdMouse
( ["", "Optional mouse commands", ""]
, mouseBasicsBlurb ++ [""]
, [mouseOverviewCaption] )
([], [])
okx0 = (ls, []) -- don't capture mouse wheel, etc.
in mergeOKX
(mergeOKX
okx0
(typesetInProp $ "" : mouseAreasBlurb, []))
(mergeOKX
(okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "Exploration"])
(okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "Aiming Mode"] )) ) ]
, if catLength CmdItem + catLength CmdMove + 9 + 9 > rheight then
[ ( movTextEnd
, okxs CmdItem
(["", categoryDescription CmdItem], [], ["", keyCaption])
([], "" : itemAllEnding) )
, ( movTextEnd
, okxs CmdMove
(["", categoryDescription CmdMove], [], ["", keyCaption])
(pickLeaderDescription, []) ) ]
else
[ ( movTextEnd
, mergeOKX
(okxs CmdItem
(["", categoryDescription CmdItem], [], ["", keyCaption])
([], "" : itemAllEnding))
(okxs CmdMove
( ["", "", categoryDescription CmdMove]
, []
, ["", keyCaption] )
(pickLeaderDescription, [""])) ) ]
, if catLength CmdAim + catLength CmdMeta + 9 > rheight then
[ ( movTextEnd
, okxs CmdAim
(["", categoryDescription CmdAim], [], ["", keyCaption])
([], []) )
, ( lastHelpEnd
, okxs CmdMeta
(["", categoryDescription CmdMeta], [], ["", keyCaption])
([], ["", seeAlso]) ) ]
else
[ ( lastHelpEnd
, mergeOKX
(okxs CmdAim
(["", categoryDescription CmdAim], [], ["", keyCaption])
([], []))
(okxs CmdMeta
( ["", "", categoryDescription CmdMeta]
, []
, ["", keyCaption] )
([], ["", seeAlso, ""])) ) ]
]
-- | Turn the specified portion of bindings into a menu.
--
-- The length of the button may be wrong if the two supplied fonts
-- have very different widths.
okxsN :: InputContent -> DisplayFont -> DisplayFont -> Int -> (HumanCmd -> Bool)
-> Bool -> CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text])
-> OKX
okxsN InputContent{..} labFont descFont offsetCol2 greyedOut
showManyKeys cat (headerMono1, headerProp, headerMono2)
(footerMono, footerProp) =
let fmt k h = (T.singleton '\x00a0' <> k, h)
coImage :: HumanCmd -> [K.KM]
coImage cmd = M.findWithDefault (error $ "" `showFailure` cmd) cmd brevMap
disp = T.intercalate " or " . map (T.pack . K.showKM)
keyKnown km = case K.key km of
K.Unknown{} -> False
_ -> True
keys :: [(KeyOrSlot, (Bool, (Text, Text)))]
keys = [ (Left km, (greyedOut cmd, fmt keyNames desc))
| (_, (cats, desc, cmd)) <- bcmdList
, let kms = coImage cmd
knownKeys = filter keyKnown kms
keyNames =
disp $ (if showManyKeys then id else take 1) knownKeys
kmsRes = if desc == "" then knownKeys else kms
km = case kmsRes of
[] -> K.escKM
km1 : _ -> km1
, cat `elem` cats
, desc /= "" || CmdInternal `elem` cats]
spLen = textSize labFont " "
f (ks, (_, (_, t2))) y =
(ks, ( PointUI spLen y
, ButtonWidth labFont (offsetCol2 + 2 + T.length t2 - 1)))
kxs = zipWith f keys
[length headerMono1 + length headerProp + length headerMono2 ..]
ts = map (\t -> (False, (t, ""))) headerMono1
++ map (\t -> (False, ("", t))) headerProp
++ map (\t -> (False, (t, ""))) headerMono2
++ map snd keys
++ map (\t -> (False, (t, ""))) footerMono
++ map (\t -> (False, ("", t))) footerProp
greyToAL (b, (t1, t2)) =
if b
then let al1 = textFgToAL Color.BrBlack t1
in (al1, ( if T.null t1 then 0 else spLen * (offsetCol2 + 2)
, textFgToAL Color.BrBlack t2 ))
else let al1 = textToAL t1
in (al1, ( if T.null t1 then 0 else spLen * (offsetCol2 + 2)
, textToAL t2 ))
(greyLab, greyDesc) = unzip $ map greyToAL ts
in ( EM.insertWith (++) descFont (offsetOverlayX greyDesc)
$ EM.singleton labFont (offsetOverlay greyLab)
, kxs )
|
