{-# LANGUAGE RankNTypes, TupleSections #-}
module Game.LambdaHack.Client.UI.KeyBindings
( keyHelp, okxsN
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
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 Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Color as Color
keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)]
keyHelp COps{corule}
CCUI{ coinput=coinput@InputContent{..}
, coscreen=ScreenContent{rheight, rintroScreen, rmoveKeysScreen} }
offset = assert (offset > 0) $
let
introBlurb =
""
: map T.pack rintroScreen
++
[ ""
, "Press SPACE for help or ESC to see the map again."
]
movBlurb = map T.pack rmoveKeysScreen
movBlurbEnd =
[ "Press SPACE or scroll the mouse wheel to see the minimal command set."
]
minimalBlurb =
[ "The following commands, joined with the basic set above,"
, "let you accomplish 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. (See the ending help screens for mouse commands.)"
, "Lastly, you can select a command with arrows or mouse directly"
, "from the help screen or the dashboard and execute it on the spot."
, ""
]
casualEnding =
[ ""
, "Press SPACE to see the detailed descriptions of all commands."
]
categoryEnding =
[ ""
, "Press SPACE to see the next page of command descriptions."
]
itemMenuEnding =
[ ""
, "Note how lower case item commands (pack an item, equip, stash)"
, "let you move items into a particular item store."
, ""
, "Press SPACE to see the detailed descriptions of other item-related commands."
]
itemRemainingEnding =
[ ""
, "Note how upper case item commands (manage Pack, Equipment,"
, "Stash, etc.) let you view and organize items within"
, "a particular item store. Once a menu is opened, you can"
, "switch stores at will, so each of the commands only"
, "determines the starting item store. Each store"
, "is accessible from the dashboard, as well."
, ""
, "Press SPACE to see the next page of command descriptions."
]
itemAllEnding =
[ ""
, "Note how lower case item commands (pack an item, equip, stash)"
, "let you move items into a particular item store, while"
, "upper case item commands (manage Pack, Equipment, Stash, etc.)"
, "let you view and organize items within an item store."
, "Once a store management menu is opened, you can switch"
, "stores at will, so the multiple commands only determine"
, "the starting item store. Each store is accessible"
, "from the dashboard as well."
, ""
, "Press SPACE to see the next page of command descriptions."
]
mouseBasicsBlurb =
[ "Screen area and UI mode (exploration/aiming) determine"
, "mouse click effects. First, 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 page-scroll them."
, "(For mice without RMB, one can use Control key with LMB.)"
, "Next we show mouse button effects per screen area,"
, "in exploration mode and (if different) in aiming mode."
, ""
]
mouseBasicsEnding =
[ ""
, "Press SPACE to see mouse commands in exploration and aiming modes."
]
lastHelpEnding =
[ ""
, "For more playing instructions see file PLAYING.md."
, "Press PGUP or scroll the mouse wheel to return to previous pages"
, "and press SPACE or ESC to see the map again."
]
keyL = 12
pickLeaderDescription =
[ fmt keyL "0, 1 ... 6" "pick a particular actor as the new leader"
]
casualDescription = "Minimal cheat sheet for casual play"
fmt n k h = " " <> T.justifyLeft n ' ' k <+> h
fmts s = " " <> s
introText = map fmts introBlurb
movText = map fmts movBlurb
movTextEnd = map fmts movBlurbEnd
minimalText = map fmts minimalBlurb
casualEnd = map fmts casualEnding
categoryEnd = map fmts categoryEnding
itemMenuEnd = map fmts itemMenuEnding
itemRemainingEnd = map fmts itemRemainingEnding
itemAllEnd = map fmts itemAllEnding
mouseBasicsText = map fmts mouseBasicsBlurb
mouseBasicsEnd = map fmts mouseBasicsEnding
lastHelpEnd = map fmts lastHelpEnding
keyCaptionN n = fmt n "keys" "command"
keyCaption = keyCaptionN keyL
okxs = okxsN coinput offset keyL (const False) True
renumber y (km, (y0, x1, x2)) = (km, (y0 + y, x1, x2))
mergeOKX :: OKX -> OKX -> OKX
mergeOKX (ov1, ks1) (ov2, ks2) =
(ov1 ++ ov2, ks1 ++ map (renumber $ length ov1) ks2)
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 a $ fmt 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, Either K.KM SlotChar, 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
okm :: (forall a. (a, a) -> a)
-> K.KM -> K.KM -> [Text] -> [Text]
-> OKX
okm sel key1 key2 header footer =
let kst1 = keySel sel key1
kst2 = keySel sel key2
f (ca1, Left km1, _) (ca2, Left km2, _) y =
assert (ca1 == ca2 `blame` (kst1, kst2))
[ (Left [km1], (y, keyM + 3, keyB + keyM + 3))
, (Left [km2], (y, keyB + keyM + 5, 2 * keyB + keyM + 5)) ]
f c d e = error $ "" `showFailure` (c, d, e)
kxs = concat $ zipWith3 f kst1 kst2 [offset + length header..]
render (ca1, _, desc1) (_, _, desc2) =
fmm (areaDescription ca1) desc1 desc2
menu = zipWith render kst1 kst2
in (map textToAL $ "" : header ++ menu ++ footer, kxs)
in concat
[ [ ( rtitle corule <+> "- backstory"
, (map textToAL introText, []) ) ]
, if catLength CmdMinimal
+ length movText + length minimalText + length casualEnd
+ 5 > rheight then
[ ( casualDescription <+> "(1/2)."
, (map textToAL ([""] ++ movText ++ [""] ++ movTextEnd), []) )
, ( casualDescription <+> "(2/2)."
, okxs CmdMinimal (minimalText ++ [keyCaption]) casualEnd ) ]
else
[ ( casualDescription <> "."
, okxs CmdMinimal
(movText ++ ["", ""] ++ minimalText ++ [keyCaption])
casualEnd ) ]
, if catLength CmdItemMenu + catLength CmdItem
+ 9 > rheight then
[ ( categoryDescription CmdItemMenu <> "."
, okxs CmdItemMenu [keyCaption] itemMenuEnd )
, ( categoryDescription CmdItem <> "."
, okxs CmdItem [keyCaption] itemRemainingEnd ) ]
else
[ ( categoryDescription CmdItemMenu <> "."
, mergeOKX
(okxs CmdItemMenu [keyCaption] [""])
(okxs CmdItem
[categoryDescription CmdItem <> ".", "", keyCaption]
itemAllEnd) ) ]
, if catLength CmdMove + catLength CmdAim
+ 9 > rheight then
[ ( "All terrain exploration and alteration commands."
, okxs CmdMove [keyCaption] (pickLeaderDescription ++ categoryEnd) )
, ( categoryDescription CmdAim <> "."
, okxs CmdAim [keyCaption] categoryEnd ) ]
else
[ ( "All terrain exploration and alteration commands."
, mergeOKX
(okxs CmdMove [keyCaption] (pickLeaderDescription ++ [""]))
(okxs CmdAim
[categoryDescription CmdAim <> ".", "", keyCaption]
categoryEnd) ) ]
, if 45 > rheight then
[ ( "Mouse overview."
, let (ls, _) = okxs CmdMouse
(mouseBasicsText ++ [keyCaption])
mouseBasicsEnd
in (ls, []) )
, ( "Mouse in exploration and aiming modes."
, mergeOKX
(okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "exploration"] [])
(okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "aiming mode"] categoryEnd) ) ]
else
[ ( "Mouse commands."
, let (ls, _) = okxs CmdMouse
(mouseBasicsText ++ [keyCaption])
[]
okx0 = (ls, [])
in mergeOKX
(mergeOKX
okx0
(okm fst K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "exploration"] []))
(okm snd K.leftButtonReleaseKM K.rightButtonReleaseKM
[areaCaption "aiming mode"] categoryEnd) ) ]
, [ ( categoryDescription CmdMeta <> "."
, okxs CmdMeta [keyCaption] lastHelpEnd ) ]
]
okxsN :: InputContent -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory
-> [Text] -> [Text] -> OKX
okxsN InputContent{..} offset n greyedOut showManyKeys cat header footer =
let fmt k h = " " <> T.justifyLeft n ' ' 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 :: [(Either [K.KM] SlotChar, (Bool, Text))]
keys = [ (Left kmsRes, (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
, cat `elem` cats
, desc /= "" || CmdInternal `elem` cats]
f (ks, (_, tkey)) y = (ks, (y, 1, T.length tkey))
kxs = zipWith f keys [offset + length header..]
ts = map (False,) ("" : header) ++ map snd keys ++ map (False,) footer
greyToAL (b, t) = if b then textFgToAL Color.BrBlack t else textToAL t
in (map greyToAL ts, kxs)