module Game.LambdaHack.Client.UI.KeyBindings
( Binding(..), stdBinding, keyHelp
) where
import Control.Arrow (second)
import qualified Data.Char as Char
import Data.List
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple (swap)
import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Client.UI.Config
import Game.LambdaHack.Client.UI.Content.KeyKind
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Common.Msg
data Binding = Binding
{ bcmdMap :: !(M.Map K.KM (Text, [CmdCategory], HumanCmd))
, bcmdList :: ![(K.KM, (Text, [CmdCategory], HumanCmd))]
, brevMap :: !(M.Map HumanCmd K.KM)
}
stdBinding :: KeyKind
-> Config
-> Binding
stdBinding copsClient !Config{configCommands, configVi, configLaptop} =
let heroSelect k = ( K.toKM K.NoModifier (K.Char (Char.intToDigit k))
, ([CmdMeta], PickLeader k) )
cmdWithHelp = rhumanCommands copsClient ++ configCommands
cmdAll =
cmdWithHelp
++ [ (K.mkKM "KP_Begin", ([CmdMove], Wait))
, (K.mkKM "CTRL-KP_Begin", ([CmdMove], Macro "" ["KP_Begin"]))
, (K.mkKM "KP_5", ([CmdMove], Macro "" ["KP_Begin"]))
, (K.mkKM "CTRL-KP_5", ([CmdMove], Macro "" ["KP_Begin"])) ]
++ (if configVi
then [ (K.mkKM "period", ([CmdMove], Macro "" ["KP_Begin"])) ]
else if configLaptop
then [ (K.mkKM "i", ([CmdMove], Macro "" ["KP_Begin"]))
, (K.mkKM "I", ([CmdMove], Macro "" ["KP_Begin"])) ]
else [])
++ K.moveBinding configVi configLaptop (\v -> ([CmdMove], Move v))
(\v -> ([CmdMove], Run v))
++ fmap heroSelect [0..6]
mkDescribed (cats, cmd) = (cmdDescription cmd, cats, cmd)
in Binding
{ bcmdMap = M.fromList $ map (second mkDescribed) cmdAll
, bcmdList = map (second mkDescribed) cmdWithHelp
, brevMap = M.fromList $ map (swap . second snd) cmdAll
}
keyHelp :: Binding -> Slideshow
keyHelp Binding{bcmdList} =
let
movBlurb =
[ "Walk throughout a level with mouse or numeric keypad (left diagram)"
, "or its compact laptop replacement (middle) or the Vi text editor keys"
, "(right, also known as \"Rogue-like keys\"; can be enabled in config.ui.ini)."
, "Run, until disturbed, with left mouse button or SHIFT (or CTRL) and a key."
, ""
, " 7 8 9 7 8 9 y k u"
, " \\|/ \\|/ \\|/"
, " 4-5-6 u-i-o h-.-l"
, " /|\\ /|\\ /|\\"
, " 1 2 3 j k l b j n"
, ""
, "In aiming mode (KEYPAD_* or \\) the same keys (or mouse) move the crosshair."
, "Press 'KEYPAD_5' (or 'i' or '.') to wait, bracing for blows, which reduces"
, "any damage taken and makes it impossible for foes to displace you."
, "You displace enemies or friends by bumping into them with SHIFT (or CTRL)."
, ""
, "Search, loot, open and attack by bumping into walls, doors and enemies."
, "The best item to attack with is automatically chosen from among"
, "weapons in your personal equipment and your unwounded organs."
, ""
, "Press SPACE to see the minimal command set."
]
minimalBlurb =
[ "The following minimal command set lets you accomplish anything in the game,"
, "though not necessarily with the fewest number of keystrokes."
, "Most of the other commands are shorthands, defined as macros"
, "(with the exception of the advanced commands for assigning non-default"
, "tactics and targets to your autonomous henchmen, if you have any)."
, ""
]
casualEndBlurb =
[ ""
, "Press SPACE to see the detailed descriptions of all commands."
]
categoryBlurb =
[ ""
, "Press SPACE to see the next page of command descriptions."
]
lastBlurb =
[ ""
, "For more playing instructions see file PLAYING.md."
, "Press PGUP to return to previous pages or ESC to see the map again."
]
pickLeaderDescription =
[ fmt 16 "0, 1 ... 6" "pick a particular actor as the new leader"
]
casualDescription = "Minimal cheat sheet for casual play"
fmt n k h = T.justifyRight 72 ' '
$ T.justifyLeft n ' ' k
<> T.justifyLeft 48 ' ' h
fmts s = " " <> T.justifyLeft 71 ' ' s
movText = map fmts movBlurb
minimalText = map fmts minimalBlurb
casualEndText = map fmts casualEndBlurb
categoryText = map fmts categoryBlurb
lastText = map fmts lastBlurb
coImage :: K.KM -> [K.KM]
coImage k = k : sort [ from
| (from, (_, cats, Macro _ [to])) <- bcmdList
, K.mkKM to == k
, any (`notElem` [CmdDebug, CmdInternal]) cats ]
disp k = T.concat $ intersperse " or " $ map K.showKM $ coImage k
keysN n cat = [ fmt n (disp k) h
| (k, (h, cats, _)) <- bcmdList, cat `elem` cats, h /= "" ]
keyCaptionN n = fmt n "keys" "command"
keys = keysN 16
keyCaption = keyCaptionN 16
in toSlideshow (Just True)
[ [casualDescription <+> "(1/2). [press SPACE to see more]"] ++ [""]
++ movText ++ [moreMsg]
, [casualDescription <+> "(2/2). [press SPACE to see all commands]"] ++ [""]
++ minimalText
++ [keyCaption] ++ keys CmdMinimal ++ casualEndText ++ [moreMsg]
, ["All terrain exploration and alteration commands"
<> ". [press SPACE to advance]"] ++ [""]
++ [keyCaptionN 10] ++ keysN 10 CmdMove ++ categoryText ++ [moreMsg]
, [categoryDescription CmdItem <> ". [press SPACE to advance]"] ++ [""]
++ [keyCaptionN 10] ++ keysN 10 CmdItem ++ categoryText ++ [moreMsg]
, [categoryDescription CmdTgt <> ". [press SPACE to advance]"] ++ [""]
++ [keyCaption] ++ keys CmdTgt ++ categoryText ++ [moreMsg]
, [categoryDescription CmdAuto <> ". [press SPACE to advance]"] ++ [""]
++ [keyCaption] ++ keys CmdAuto ++ categoryText ++ [moreMsg]
, [categoryDescription CmdMeta <> ". [press SPACE to advance]"] ++ [""]
++ [keyCaption] ++ keys CmdMeta ++ pickLeaderDescription
++ categoryText ++ [moreMsg]
, [categoryDescription CmdMouse
<> ". [press PGUP to see previous, ESC to cancel]"] ++ [""]
++ [keyCaptionN 21] ++ keysN 21 CmdMouse ++ lastText ++ [endMsg]
]