module Game.LambdaHack.Client.Binding
( Binding(..), stdBinding, keyHelp,
) where
import Control.Arrow (second)
import qualified Data.Char as Char
import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple (swap)
import Game.LambdaHack.Client.Config
import Game.LambdaHack.Client.HumanCmd
import qualified Game.LambdaHack.Common.Key as K
import Game.LambdaHack.Common.Msg
data Binding = Binding
{ kcmd :: !(M.Map K.KM (Text, Bool, HumanCmd))
, kmacro :: !(M.Map K.KM K.KM)
, kmajor :: ![K.KM]
, kminor :: ![K.KM]
, krevMap :: !(M.Map HumanCmd K.KM)
}
stdBinding :: ConfigUI
-> Binding
stdBinding !config@ConfigUI{configMacros} =
let kmacro = M.fromList configMacros
heroSelect k = ( K.KM { key=K.Char (Char.intToDigit k)
, modifier=K.NoModifier }
, SelectHero k )
cmdList =
configCommands config
++ K.moveBinding Move Run
++ fmap heroSelect [0..9]
mkDescribed cmd = (cmdDescription cmd, noRemoteHumanCmd cmd, cmd)
mkCommand = second mkDescribed
semList = L.map mkCommand cmdList
in Binding
{ kcmd = M.fromList semList
, kmacro
, kmajor = L.map fst $ L.filter (majorHumanCmd . snd) cmdList
, kminor = L.map fst $ L.filter (minorHumanCmd . snd) cmdList
, krevMap = M.fromList $ map swap cmdList
}
coImage :: M.Map K.KM K.KM -> K.KM -> [K.KM]
coImage kmacro k =
let domain = M.keysSet kmacro
in if k `S.member` domain
then []
else k : [ from | (from, to) <- M.assocs kmacro, to == k ]
keyHelp :: Binding -> Slideshow
keyHelp Binding{kcmd, kmacro, kmajor, kminor} =
let
movBlurb =
[ "Move throughout the level with numerical keypad or"
, "the Vi text editor keys (also known as \"Rogue-like keys\"):"
, ""
, " 7 8 9 y k u"
, " \\|/ \\|/"
, " 4-5-6 h-.-l"
, " /|\\ /|\\"
, " 1 2 3 b j n"
, ""
,"Run ahead until anything disturbs you, with SHIFT (or CTRL) and a key."
, "Press keypad '5' or '.' to wait a turn, bracing for blows next turn."
, "In targeting mode the same keys move the targeting cursor."
, ""
, "Search, open and attack, by bumping into walls, doors and enemies."
, ""
, "Press SPACE to see the next page, with the list of major commands."
]
majorBlurb =
[ ""
, "Commands marked with * take time and are blocked on remote levels."
, "Press SPACE to see the next page, with the list of minor commands."
]
minorBlurb =
[ ""
, "For more playing instructions see file PLAYING.md."
, "Press SPACE to clear the messages and see the map again."
]
fmt k h = T.replicate 16 " "
<> T.justifyLeft 15 ' ' k
<> T.justifyLeft 41 ' ' h
fmts s = " " <> T.justifyLeft 71 ' ' s
blank = fmt "" ""
mov = map fmts movBlurb
major = map fmts majorBlurb
minor = map fmts minorBlurb
keyCaption = fmt "keys" "command"
disp k = T.concat $ map K.showKM $ coImage kmacro k
keys l = [ fmt (disp k) (h <> if timed then "*" else "")
| (k, (h, timed, _)) <- l, h /= "" ]
(kcMajor, kcRest) =
L.partition ((`elem` kmajor) . fst) (M.toAscList kcmd)
(kcMinor, _) =
L.partition ((`elem` kminor) . fst) kcRest
in toSlideshow
[ ["Basic keys. [press SPACE to advance]"] ++ [blank]
++ mov ++ [moreMsg]
, ["Basic keys. [press SPACE to advance]"] ++ [blank]
++ [keyCaption] ++ keys kcMajor ++ major ++ [moreMsg]
, ["Basic keys."] ++ [blank]
++ [keyCaption] ++ keys kcMinor ++ minor
]