-- | The type of definitions of key-command mappings to be used for the UI -- and shorthands for specifying command triples in the content files. module Game.LambdaHack.Client.UI.Content.Input ( InputContentRaw(..), InputContent(..), makeData , evalKeyDef , addCmdCategory, replaceDesc, moveItemTriple, repeatTriple, repeatLastTriple , mouseLMB, mouseMMB, mouseMMBMute, mouseRMB , goToCmd, runToAllCmd, autoexploreCmd, autoexplore25Cmd , aimFlingCmd, projectI, projectA, flingTs, applyIK, applyI , grabItems, dropItems, descIs, defaultHeroSelect, macroRun25 , memberCycle, memberCycleLevel #ifdef EXPOSE_INTERNAL -- * Internal operations , replaceCmd, projectICmd, grabCmd, dropCmd #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import qualified Data.Map.Strict as M import qualified NLP.Miniutter.English as MU 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.Misc import Game.LambdaHack.Definition.Defs -- | Key-command mappings to be specified in content and used for the UI. newtype InputContentRaw = InputContentRaw [(K.KM, CmdTriple)] -- | Bindings and other information about human player commands. data InputContent = InputContent { bcmdMap :: M.Map K.KM CmdTriple -- ^ binding of keys to commands , bcmdList :: [(K.KM, CmdTriple)] -- ^ the properly ordered list -- of commands for the help menu , brevMap :: M.Map HumanCmd [K.KM] -- ^ and from commands to their keys } -- | Create binding of keys to movement and other standard commands, -- as well as commands defined in the config file. makeData :: Maybe UIOptions -- ^ UI client options -> InputContentRaw -- ^ default key bindings from the content -> InputContent -- ^ concrete binding makeData muiOptions (InputContentRaw copsClient) = let (uCommands0, uVi0, uLeftHand0) = case muiOptions of Just UIOptions{uCommands, uVi, uLeftHand} -> (uCommands, uVi, uLeftHand) Nothing -> ([], True, True) waitTriple = ([CmdMove], "", Wait) wait10Triple = ([CmdMove], "", Wait10) moveXhairOr n cmd v = ByAimMode $ AimModeCmd { exploration = cmd v , aiming = MoveXhair v n } rawContent = copsClient ++ uCommands0 movementDefinitions = K.moveBinding uVi0 uLeftHand0 (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v)) (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v)) ++ [ (K.mkKM "KP_Begin", waitTriple) , (K.mkKM "C-KP_Begin", wait10Triple) , (K.mkKM "KP_5", wait10Triple) , (K.mkKM "S-KP_5", wait10Triple) -- rxvt , (K.mkKM "C-KP_5", wait10Triple) ] ++ [(K.mkKM "period", waitTriple) | uVi0] ++ [(K.mkKM "C-period", wait10Triple) | uVi0] ++ [(K.mkKM "s", waitTriple) | uLeftHand0] ++ [(K.mkKM "S", wait10Triple) | uLeftHand0] -- This is the most common case of duplicate keys and it usually -- has an easy solution, so it's tested for first. !_A = flip assert () $ let movementKeys = map fst movementDefinitions filteredNoMovement = filter (\(k, _) -> k `notElem` movementKeys) rawContent in rawContent == filteredNoMovement `blame` "commands overwrite the enabled movement keys (you can disable some in config file and try again)" `swith` rawContent \\ filteredNoMovement bcmdList = rawContent ++ movementDefinitions -- This catches repetitions (usually) not involving movement keys. rejectRepetitions _ t1 (_, "", _) = t1 rejectRepetitions _ (_, "", _) t2 = t2 rejectRepetitions k t1 t2 = error $ "duplicate key among command definitions (you can instead disable some movement key sets in config file and overwrite the freed keys)" `showFailure` (k, t1, t2) in InputContent { bcmdMap = M.fromListWithKey rejectRepetitions bcmdList , bcmdList , brevMap = M.fromListWith (flip (++)) $ concat [ [(cmd, [k])] | (k, (cats, _desc, cmd)) <- bcmdList , not (null cats) && CmdDebug `notElem` cats ] } evalKeyDef :: (String, CmdTriple) -> (K.KM, CmdTriple) evalKeyDef (t, triple@(cats, _, _)) = let km = if CmdInternal `elem` cats then K.KM K.NoModifier $ K.Unknown t else K.mkKM t in (km, triple) addCmdCategory :: CmdCategory -> CmdTriple -> CmdTriple addCmdCategory cat (cats, desc, cmd) = (cat : cats, desc, cmd) replaceDesc :: Text -> CmdTriple -> CmdTriple replaceDesc desc (cats, _, cmd) = (cats, desc, cmd) replaceCmd :: HumanCmd -> CmdTriple -> CmdTriple replaceCmd cmd (cats, desc, _) = (cats, desc, cmd) moveItemTriple :: [CStore] -> CStore -> MU.Part -> Bool -> CmdTriple moveItemTriple stores1 store2 object auto = let verb = MU.Text $ verbCStore store2 desc = makePhrase [verb, object] in ([CmdItemMenu, CmdItem], desc, MoveItem stores1 store2 Nothing auto) repeatTriple :: Int -> [CmdCategory] -> CmdTriple repeatTriple n cats = ( cats , if n == 1 then "voice recorded macro again" else "voice recorded macro" <+> tshow n <+> "times" , Repeat n ) repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple repeatLastTriple n cats = ( cats , if n == 1 then "voice last action again" else "voice last action" <+> tshow n <+> "times in a row" , RepeatLast n ) -- @AimFloor@ is not there, but @AimEnemy@ and @AimItem@ almost make up for it. mouseLMB :: HumanCmd -> Text -> CmdTriple mouseLMB goToOrRunTo desc = ([CmdMouse], desc, ByAimMode aimMode) where aimMode = AimModeCmd { exploration = ByArea $ common ++ -- exploration mode [ (CaMapLeader, grabCmd) , (CaMapParty, PickLeaderWithPointer) , (CaMap, goToOrRunTo) , (CaArenaName, Dashboard) , (CaPercentSeen, autoexploreCmd) ] , aiming = ByArea $ common ++ -- aiming mode [ (CaMap, aimFlingCmd) , (CaArenaName, Accept) , (CaPercentSeen, XhairStair True) ] } common = [ (CaMessage, AllHistory) , (CaLevelNumber, AimAscend 1) , (CaXhairDesc, AimEnemy) -- inits aiming and then cycles enemies , (CaSelected, PickLeaderWithPointer) -- , (CaCalmGauge, Macro ["KP_Begin", "C-v"]) , (CaCalmValue, Yell) , (CaHPGauge, Macro ["KP_Begin", "C-v"]) , (CaHPValue, Wait) , (CaLeaderDesc, projectICmd flingTs) ] mouseMMB :: CmdTriple mouseMMB = ( [CmdMouse] , "snap crosshair to floor under pointer/cycle detail level" , XhairPointerFloor ) mouseMMBMute :: CmdTriple mouseMMBMute = ([CmdMouse], "", XhairPointerMute) mouseRMB :: CmdTriple mouseRMB = ( [CmdMouse] , "start aiming at enemy under pointer/cycle detail level" , ByAimMode aimMode ) where aimMode = AimModeCmd { exploration = ByArea $ common ++ [ (CaMapLeader, dropCmd) , (CaMapParty, SelectWithPointer) , (CaMap, AimPointerEnemy) , (CaArenaName, ExecuteIfClear MainMenuAutoOff) , (CaPercentSeen, autoexplore25Cmd) ] , aiming = ByArea $ common ++ [ (CaMap, XhairPointerEnemy) -- hack; same effect, but matches LMB , (CaArenaName, Cancel) , (CaPercentSeen, XhairStair False) ] } common = [ (CaMessage, Hint) , (CaLevelNumber, AimAscend (-1)) , (CaXhairDesc, AimItem) , (CaSelected, SelectWithPointer) -- , (CaCalmGauge, Macro ["C-KP_Begin", "A-v"]) , (CaCalmValue, Yell) , (CaHPGauge, Macro ["C-KP_Begin", "A-v"]) , (CaHPValue, Wait10) , (CaLeaderDesc, ComposeUnlessError ClearTargetIfItemClear ItemClear) ] -- This is duplicated wrt content, instead of included via @semicolon@, -- because the C- commands are less likely to be modified by the player -- and so more dependable than @semicolon@, @colon@, etc. goToCmd :: HumanCmd goToCmd = Macro ["A-MiddleButtonRelease", "C-semicolon", "C-quotedbl", "C-v"] -- This is duplicated wrt content, instead of included via @colon@, -- because the C- commands are less likely to be modified by the player -- and so more dependable than @semicolon@, @colon@, etc. runToAllCmd :: HumanCmd runToAllCmd = Macro ["A-MiddleButtonRelease", "C-colon", "C-quotedbl", "C-v"] autoexploreCmd :: HumanCmd autoexploreCmd = Macro ["C-?", "C-quotedbl", "C-v"] autoexplore25Cmd :: HumanCmd autoexplore25Cmd = Macro ["'", "C-?", "C-quotedbl", "'", "C-V"] aimFlingCmd :: HumanCmd aimFlingCmd = ComposeIfLocal AimPointerEnemy (projectICmd flingTs) projectICmd :: [TriggerItem] -> HumanCmd projectICmd ts = ComposeUnlessError (ChooseItemProject ts) Project projectI :: [TriggerItem] -> CmdTriple projectI ts = ([CmdItem], descIs ts, projectICmd ts) projectA :: [TriggerItem] -> CmdTriple projectA ts = let fling = Compose2ndLocal Project ItemClear flingICmd = ComposeUnlessError (ChooseItemProject ts) fling in replaceCmd (ByAimMode AimModeCmd { exploration = AimTgt , aiming = flingICmd }) (projectI ts) -- | flingTs - list containing one flingable projectile -- >>> flingTs -- [TriggerItem {tiverb = Text "fling", tiobject = Text "in-range projectile", tisymbols = ""}] -- -- I question the value of that test. But would Bob Martin like it -- on the grounds it's like double-bookkeeping? flingTs :: [TriggerItem] flingTs = [TriggerItem { tiverb = "fling" , tiobject = "in-range projectile" , tisymbols = [] }] applyIK :: [TriggerItem] -> CmdTriple applyIK ts = ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) Apply) applyI :: [TriggerItem] -> CmdTriple applyI ts = let apply = Compose2ndLocal Apply ItemClear in ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) apply) grabCmd :: HumanCmd grabCmd = MoveItem [CGround] CStash (Just "grab") True -- @CStash@ is the implicit default; refined in HandleHumanGlobalM grabItems :: Text -> CmdTriple grabItems t = ([CmdItemMenu, CmdItem], t, grabCmd) dropCmd :: HumanCmd dropCmd = MoveItem [CStash, CEqp] CGround Nothing False dropItems :: Text -> CmdTriple dropItems t = ([CmdItemMenu, CmdItem], t, dropCmd) descIs :: [TriggerItem] -> Text descIs [] = "trigger an item" descIs (t : _) = makePhrase [tiverb t, tiobject t] defaultHeroSelect :: Int -> (String, CmdTriple) defaultHeroSelect k = ([Char.intToDigit k], ([CmdMeta], "", PickLeader k)) macroRun25 :: [String] macroRun25 = ["C-comma", "C-v"] memberCycle :: Direction -> [CmdCategory] -> CmdTriple memberCycle d cats = ( cats , "cycle" <+> (if d == Backward then "backwards" else "") <+> "among all party members" , PointmanCycle d ) memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple memberCycleLevel d cats = ( cats , "cycle" <+> (if d == Backward then "backwards" else "") <+> " among party members on the level" , PointmanCycleLevel d )