-- | 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
  { InputContent -> Map KM CmdTriple
bcmdMap  :: M.Map K.KM CmdTriple   -- ^ binding of keys to commands
  , InputContent -> [(KM, CmdTriple)]
bcmdList :: [(K.KM, CmdTriple)]    -- ^ the properly ordered list
                                       --   of commands for the help menu
  , InputContent -> Map HumanCmd [KM]
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 :: Maybe UIOptions -> InputContentRaw -> InputContent
makeData Maybe UIOptions
muiOptions (InputContentRaw [(KM, CmdTriple)]
copsClient) =
  let ([(KM, CmdTriple)]
uCommands0, Bool
uVi0, Bool
uLeftHand0) = case Maybe UIOptions
muiOptions of
        Just UIOptions{[(KM, CmdTriple)]
uCommands :: UIOptions -> [(KM, CmdTriple)]
uCommands :: [(KM, CmdTriple)]
uCommands, Bool
uVi :: UIOptions -> Bool
uVi :: Bool
uVi, Bool
uLeftHand :: UIOptions -> Bool
uLeftHand :: Bool
uLeftHand} -> ([(KM, CmdTriple)]
uCommands, Bool
uVi, Bool
uLeftHand)
        Maybe UIOptions
Nothing -> ([], Bool
True, Bool
True)
      waitTriple :: CmdTriple
waitTriple = ([CmdCategory
CmdMove], Text
"", HumanCmd
Wait)
      wait10Triple :: CmdTriple
wait10Triple = ([CmdCategory
CmdMove], Text
"", HumanCmd
Wait10)
      moveXhairOr :: Int -> (Vector -> HumanCmd) -> Vector -> HumanCmd
moveXhairOr Int
n Vector -> HumanCmd
cmd Vector
v = AimModeCmd -> HumanCmd
ByAimMode (AimModeCmd -> HumanCmd) -> AimModeCmd -> HumanCmd
forall a b. (a -> b) -> a -> b
$ AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd { exploration :: HumanCmd
exploration = Vector -> HumanCmd
cmd Vector
v
                                                   , aiming :: HumanCmd
aiming = Vector -> Int -> HumanCmd
MoveXhair Vector
v Int
n }
      rawContent :: [(KM, CmdTriple)]
rawContent = [(KM, CmdTriple)]
copsClient [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(KM, CmdTriple)]
uCommands0
      movementDefinitions :: [(KM, CmdTriple)]
movementDefinitions =
        Bool
-> Bool
-> (Vector -> CmdTriple)
-> (Vector -> CmdTriple)
-> [(KM, CmdTriple)]
forall a.
Bool -> Bool -> (Vector -> a) -> (Vector -> a) -> [(KM, a)]
K.moveBinding Bool
uVi0 Bool
uLeftHand0
          (\Vector
v -> ([CmdCategory
CmdMove], Text
"", Int -> (Vector -> HumanCmd) -> Vector -> HumanCmd
moveXhairOr Int
1 Vector -> HumanCmd
MoveDir Vector
v))
          (\Vector
v -> ([CmdCategory
CmdMove], Text
"", Int -> (Vector -> HumanCmd) -> Vector -> HumanCmd
moveXhairOr Int
10 Vector -> HumanCmd
RunDir Vector
v))
        [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [ (String -> KM
K.mkKM String
"KP_Begin", CmdTriple
waitTriple)
           , (String -> KM
K.mkKM String
"C-KP_Begin", CmdTriple
wait10Triple)
           , (String -> KM
K.mkKM String
"KP_5", CmdTriple
wait10Triple)
           , (String -> KM
K.mkKM String
"S-KP_5", CmdTriple
wait10Triple)  -- rxvt
           , (String -> KM
K.mkKM String
"C-KP_5", CmdTriple
wait10Triple) ]
        [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(String -> KM
K.mkKM String
"period", CmdTriple
waitTriple) | Bool
uVi0]
        [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(String -> KM
K.mkKM String
"C-period", CmdTriple
wait10Triple) | Bool
uVi0]
        [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(String -> KM
K.mkKM String
"s", CmdTriple
waitTriple) | Bool
uLeftHand0]
        [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(String -> KM
K.mkKM String
"S", CmdTriple
wait10Triple) | Bool
uLeftHand0]
      -- This is the most common case of duplicate keys and it usually
      -- has an easy solution, so it's tested for first.
      !_A :: ()
_A = (Bool -> () -> ()) -> () -> Bool -> ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert () (Bool -> ()) -> Bool -> ()
forall a b. (a -> b) -> a -> b
$
        let movementKeys :: [KM]
movementKeys = ((KM, CmdTriple) -> KM) -> [(KM, CmdTriple)] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (KM, CmdTriple) -> KM
forall a b. (a, b) -> a
fst [(KM, CmdTriple)]
movementDefinitions
            filteredNoMovement :: [(KM, CmdTriple)]
filteredNoMovement = ((KM, CmdTriple) -> Bool) -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(KM
k, CmdTriple
_) -> KM
k KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [KM]
movementKeys)
                                        [(KM, CmdTriple)]
rawContent
        in [(KM, CmdTriple)]
rawContent [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(KM, CmdTriple)]
filteredNoMovement
           Bool -> (String, [(KM, CmdTriple)]) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"commands overwrite the enabled movement keys (you can disable some in config file and try again)"
           String -> [(KM, CmdTriple)] -> (String, [(KM, CmdTriple)])
forall v. String -> v -> (String, v)
`swith` [(KM, CmdTriple)]
rawContent [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(KM, CmdTriple)]
filteredNoMovement
      bcmdList :: [(KM, CmdTriple)]
bcmdList = [(KM, CmdTriple)]
rawContent [(KM, CmdTriple)] -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ [(KM, CmdTriple)]
movementDefinitions
      -- This catches repetitions (usually) not involving movement keys.
      rejectRepetitions :: a -> (a, a, c) -> (a, a, c) -> (a, a, c)
rejectRepetitions a
_ (a, a, c)
t1 (a
_, a
"", c
_) = (a, a, c)
t1
      rejectRepetitions a
_ (a
_, a
"", c
_) (a, a, c)
t2 = (a, a, c)
t2
      rejectRepetitions a
k (a, a, c)
t1 (a, a, c)
t2 =
        String -> (a, a, c)
forall a. (?callStack::CallStack) => String -> a
error (String -> (a, a, c)) -> String -> (a, a, c)
forall a b. (a -> b) -> a -> b
$ String
"duplicate key among command definitions (you can instead disable some movement key sets in config file and overwrite the freed keys)" String -> (a, (a, a, c), (a, a, c)) -> String
forall v. Show v => String -> v -> String
`showFailure` (a
k, (a, a, c)
t1, (a, a, c)
t2)
  in InputContent :: Map KM CmdTriple
-> [(KM, CmdTriple)] -> Map HumanCmd [KM] -> InputContent
InputContent
  { bcmdMap :: Map KM CmdTriple
bcmdMap = (KM -> CmdTriple -> CmdTriple -> CmdTriple)
-> [(KM, CmdTriple)] -> Map KM CmdTriple
forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWithKey KM -> CmdTriple -> CmdTriple -> CmdTriple
forall a a a c.
(Eq a, IsString a, Show a, Show a, Show a, Show c) =>
a -> (a, a, c) -> (a, a, c) -> (a, a, c)
rejectRepetitions [(KM, CmdTriple)]
bcmdList
  , [(KM, CmdTriple)]
bcmdList :: [(KM, CmdTriple)]
bcmdList :: [(KM, CmdTriple)]
bcmdList
  , brevMap :: Map HumanCmd [KM]
brevMap = ([KM] -> [KM] -> [KM]) -> [(HumanCmd, [KM])] -> Map HumanCmd [KM]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (([KM] -> [KM] -> [KM]) -> [KM] -> [KM] -> [KM]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
(++)) ([(HumanCmd, [KM])] -> Map HumanCmd [KM])
-> [(HumanCmd, [KM])] -> Map HumanCmd [KM]
forall a b. (a -> b) -> a -> b
$ [[(HumanCmd, [KM])]] -> [(HumanCmd, [KM])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [(HumanCmd
cmd, [KM
k])]
      | (KM
k, ([CmdCategory]
cats, Text
_desc, HumanCmd
cmd)) <- [(KM, CmdTriple)]
bcmdList
      , Bool -> Bool
not ([CmdCategory] -> Bool
forall a. [a] -> Bool
null [CmdCategory]
cats)
        Bool -> Bool -> Bool
&& CmdCategory
CmdDebug CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CmdCategory]
cats
      ]
  }

evalKeyDef :: (String, CmdTriple) -> (K.KM, CmdTriple)
evalKeyDef :: (String, CmdTriple) -> (KM, CmdTriple)
evalKeyDef (String
t, triple :: CmdTriple
triple@([CmdCategory]
cats, Text
_, HumanCmd
_)) =
  let km :: KM
km = if CmdCategory
CmdInternal CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdCategory]
cats
           then Modifier -> Key -> KM
K.KM Modifier
K.NoModifier (Key -> KM) -> Key -> KM
forall a b. (a -> b) -> a -> b
$ String -> Key
K.Unknown String
t
           else String -> KM
K.mkKM String
t
  in (KM
km, CmdTriple
triple)

addCmdCategory :: CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory :: CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
cat ([CmdCategory]
cats, Text
desc, HumanCmd
cmd) = (CmdCategory
cat CmdCategory -> [CmdCategory] -> [CmdCategory]
forall a. a -> [a] -> [a]
: [CmdCategory]
cats, Text
desc, HumanCmd
cmd)

replaceDesc :: Text -> CmdTriple -> CmdTriple
replaceDesc :: Text -> CmdTriple -> CmdTriple
replaceDesc Text
desc ([CmdCategory]
cats, Text
_, HumanCmd
cmd) = ([CmdCategory]
cats, Text
desc, HumanCmd
cmd)

replaceCmd :: HumanCmd -> CmdTriple -> CmdTriple
replaceCmd :: HumanCmd -> CmdTriple -> CmdTriple
replaceCmd HumanCmd
cmd ([CmdCategory]
cats, Text
desc, HumanCmd
_) = ([CmdCategory]
cats, Text
desc, HumanCmd
cmd)

moveItemTriple :: [CStore] -> CStore -> MU.Part -> Bool -> CmdTriple
moveItemTriple :: [CStore] -> CStore -> Part -> Bool -> CmdTriple
moveItemTriple [CStore]
stores1 CStore
store2 Part
object Bool
auto =
  let verb :: Part
verb = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
store2
      desc :: Text
desc = [Part] -> Text
makePhrase [Part
verb, Part
object]
  in ([CmdCategory
CmdItemMenu, CmdCategory
CmdItem], Text
desc, [CStore] -> CStore -> Maybe Text -> Bool -> HumanCmd
MoveItem [CStore]
stores1 CStore
store2 Maybe Text
forall a. Maybe a
Nothing Bool
auto)

repeatTriple :: Int -> [CmdCategory] -> CmdTriple
repeatTriple :: Int -> [CmdCategory] -> CmdTriple
repeatTriple Int
n [CmdCategory]
cats =
  ( [CmdCategory]
cats
  , if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    then Text
"voice recorded macro again"
    else Text
"voice recorded macro" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> Text
"times"
  , Int -> HumanCmd
Repeat Int
n )

repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple
repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple
repeatLastTriple Int
n [CmdCategory]
cats =
  ( [CmdCategory]
cats
  , if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    then Text
"voice last action again"
    else Text
"voice last action" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> Text
"times in a row"
  , Int -> HumanCmd
RepeatLast Int
n )

-- @AimFloor@ is not there, but @AimEnemy@ and @AimItem@ almost make up for it.
mouseLMB :: HumanCmd -> Text -> CmdTriple
mouseLMB :: HumanCmd -> Text -> CmdTriple
mouseLMB HumanCmd
goToOrRunTo Text
desc =
  ([CmdCategory
CmdMouse], Text
desc, AimModeCmd -> HumanCmd
ByAimMode AimModeCmd
aimMode)
 where
  aimMode :: AimModeCmd
aimMode = AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd
    { exploration :: HumanCmd
exploration = [(CmdArea, HumanCmd)] -> HumanCmd
ByArea ([(CmdArea, HumanCmd)] -> HumanCmd)
-> [(CmdArea, HumanCmd)] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ [(CmdArea, HumanCmd)]
common [(CmdArea, HumanCmd)]
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. [a] -> [a] -> [a]
++  -- exploration mode
        [ (CmdArea
CaMapLeader, HumanCmd
grabCmd)
        , (CmdArea
CaMapParty, HumanCmd
PickLeaderWithPointer)
        , (CmdArea
CaMap, HumanCmd
goToOrRunTo)
        , (CmdArea
CaArenaName, HumanCmd
Dashboard)
        , (CmdArea
CaPercentSeen, HumanCmd
autoexploreCmd) ]
    , aiming :: HumanCmd
aiming = [(CmdArea, HumanCmd)] -> HumanCmd
ByArea ([(CmdArea, HumanCmd)] -> HumanCmd)
-> [(CmdArea, HumanCmd)] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ [(CmdArea, HumanCmd)]
common [(CmdArea, HumanCmd)]
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. [a] -> [a] -> [a]
++  -- aiming mode
        [ (CmdArea
CaMap, HumanCmd
aimFlingCmd)
        , (CmdArea
CaArenaName, HumanCmd
Accept)
        , (CmdArea
CaPercentSeen, Bool -> HumanCmd
XhairStair Bool
True) ] }
  common :: [(CmdArea, HumanCmd)]
common =
    [ (CmdArea
CaMessage, HumanCmd
AllHistory)
    , (CmdArea
CaLevelNumber, Int -> HumanCmd
AimAscend Int
1)
    , (CmdArea
CaXhairDesc, HumanCmd
AimEnemy)  -- inits aiming and then cycles enemies
    , (CmdArea
CaSelected, HumanCmd
PickLeaderWithPointer)
--    , (CaCalmGauge, Macro ["KP_Begin", "C-v"])
    , (CmdArea
CaCalmValue, HumanCmd
Yell)
    , (CmdArea
CaHPGauge, [String] -> HumanCmd
Macro [String
"KP_Begin", String
"C-v"])
    , (CmdArea
CaHPValue, HumanCmd
Wait)
    , (CmdArea
CaLeaderDesc, [TriggerItem] -> HumanCmd
projectICmd [TriggerItem]
flingTs) ]

mouseMMB :: CmdTriple
mouseMMB :: CmdTriple
mouseMMB = ( [CmdCategory
CmdMouse]
           , Text
"snap crosshair to floor under pointer/cycle detail level"
           , HumanCmd
XhairPointerFloor )

mouseMMBMute :: CmdTriple
mouseMMBMute :: CmdTriple
mouseMMBMute = ([CmdCategory
CmdMouse], Text
"", HumanCmd
XhairPointerMute)

mouseRMB :: CmdTriple
mouseRMB :: CmdTriple
mouseRMB = ( [CmdCategory
CmdMouse]
           , Text
"start aiming at enemy under pointer/cycle detail level"
           , AimModeCmd -> HumanCmd
ByAimMode AimModeCmd
aimMode )
 where
  aimMode :: AimModeCmd
aimMode = AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd
    { exploration :: HumanCmd
exploration = [(CmdArea, HumanCmd)] -> HumanCmd
ByArea ([(CmdArea, HumanCmd)] -> HumanCmd)
-> [(CmdArea, HumanCmd)] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ [(CmdArea, HumanCmd)]
common [(CmdArea, HumanCmd)]
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. [a] -> [a] -> [a]
++
        [ (CmdArea
CaMapLeader, HumanCmd
dropCmd)
        , (CmdArea
CaMapParty, HumanCmd
SelectWithPointer)
        , (CmdArea
CaMap, HumanCmd
AimPointerEnemy)
        , (CmdArea
CaArenaName, HumanCmd -> HumanCmd
ExecuteIfClear HumanCmd
MainMenuAutoOff)
        , (CmdArea
CaPercentSeen, HumanCmd
autoexplore25Cmd) ]
    , aiming :: HumanCmd
aiming = [(CmdArea, HumanCmd)] -> HumanCmd
ByArea ([(CmdArea, HumanCmd)] -> HumanCmd)
-> [(CmdArea, HumanCmd)] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ [(CmdArea, HumanCmd)]
common [(CmdArea, HumanCmd)]
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. [a] -> [a] -> [a]
++
        [ (CmdArea
CaMap, HumanCmd
XhairPointerEnemy)  -- hack; same effect, but matches LMB
        , (CmdArea
CaArenaName, HumanCmd
Cancel)
        , (CmdArea
CaPercentSeen, Bool -> HumanCmd
XhairStair Bool
False) ] }
  common :: [(CmdArea, HumanCmd)]
common =
    [ (CmdArea
CaMessage, HumanCmd
Hint)
    , (CmdArea
CaLevelNumber, Int -> HumanCmd
AimAscend (-Int
1))
    , (CmdArea
CaXhairDesc, HumanCmd
AimItem)
    , (CmdArea
CaSelected, HumanCmd
SelectWithPointer)
--    , (CaCalmGauge, Macro ["C-KP_Begin", "A-v"])
    , (CmdArea
CaCalmValue, HumanCmd
Yell)
    , (CmdArea
CaHPGauge, [String] -> HumanCmd
Macro [String
"C-KP_Begin", String
"A-v"])
    , (CmdArea
CaHPValue, HumanCmd
Wait10)
    , (CmdArea
CaLeaderDesc, HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError HumanCmd
ClearTargetIfItemClear HumanCmd
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 :: HumanCmd
goToCmd = [String] -> HumanCmd
Macro [String
"A-MiddleButtonRelease", String
"C-semicolon", String
"C-quotedbl", String
"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 :: HumanCmd
runToAllCmd = [String] -> HumanCmd
Macro [String
"A-MiddleButtonRelease", String
"C-colon", String
"C-quotedbl", String
"C-v"]

autoexploreCmd :: HumanCmd
autoexploreCmd :: HumanCmd
autoexploreCmd = [String] -> HumanCmd
Macro [String
"C-?", String
"C-quotedbl", String
"C-v"]

autoexplore25Cmd :: HumanCmd
autoexplore25Cmd :: HumanCmd
autoexplore25Cmd = [String] -> HumanCmd
Macro [String
"'", String
"C-?", String
"C-quotedbl", String
"'", String
"C-V"]

aimFlingCmd :: HumanCmd
aimFlingCmd :: HumanCmd
aimFlingCmd = HumanCmd -> HumanCmd -> HumanCmd
ComposeIfLocal HumanCmd
AimPointerEnemy ([TriggerItem] -> HumanCmd
projectICmd [TriggerItem]
flingTs)

projectICmd :: [TriggerItem] -> HumanCmd
projectICmd :: [TriggerItem] -> HumanCmd
projectICmd [TriggerItem]
ts = HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError ([TriggerItem] -> HumanCmd
ChooseItemProject [TriggerItem]
ts) HumanCmd
Project

projectI :: [TriggerItem] -> CmdTriple
projectI :: [TriggerItem] -> CmdTriple
projectI [TriggerItem]
ts = ([CmdCategory
CmdItem], [TriggerItem] -> Text
descIs [TriggerItem]
ts, [TriggerItem] -> HumanCmd
projectICmd [TriggerItem]
ts)

projectA :: [TriggerItem] -> CmdTriple
projectA :: [TriggerItem] -> CmdTriple
projectA [TriggerItem]
ts =
  let fling :: HumanCmd
fling = HumanCmd -> HumanCmd -> HumanCmd
Compose2ndLocal HumanCmd
Project HumanCmd
ItemClear
      flingICmd :: HumanCmd
flingICmd = HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError ([TriggerItem] -> HumanCmd
ChooseItemProject [TriggerItem]
ts) HumanCmd
fling
  in HumanCmd -> CmdTriple -> CmdTriple
replaceCmd (AimModeCmd -> HumanCmd
ByAimMode AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd { exploration :: HumanCmd
exploration = HumanCmd
AimTgt
                                      , aiming :: HumanCmd
aiming = HumanCmd
flingICmd })
                ([TriggerItem] -> CmdTriple
projectI [TriggerItem]
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]
flingTs = [TriggerItem :: Part -> Part -> String -> TriggerItem
TriggerItem { tiverb :: Part
tiverb = Part
"fling"
                       , tiobject :: Part
tiobject = Part
"in-range projectile"
                       , tisymbols :: String
tisymbols = [] }]

applyIK :: [TriggerItem] -> CmdTriple
applyIK :: [TriggerItem] -> CmdTriple
applyIK [TriggerItem]
ts =
  ([CmdCategory
CmdItem], [TriggerItem] -> Text
descIs [TriggerItem]
ts, HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError ([TriggerItem] -> HumanCmd
ChooseItemApply [TriggerItem]
ts) HumanCmd
Apply)

applyI :: [TriggerItem] -> CmdTriple
applyI :: [TriggerItem] -> CmdTriple
applyI [TriggerItem]
ts =
  let apply :: HumanCmd
apply = HumanCmd -> HumanCmd -> HumanCmd
Compose2ndLocal HumanCmd
Apply HumanCmd
ItemClear
  in ([CmdCategory
CmdItem], [TriggerItem] -> Text
descIs [TriggerItem]
ts, HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError ([TriggerItem] -> HumanCmd
ChooseItemApply [TriggerItem]
ts) HumanCmd
apply)

grabCmd :: HumanCmd
grabCmd :: HumanCmd
grabCmd = [CStore] -> CStore -> Maybe Text -> Bool -> HumanCmd
MoveItem [CStore
CGround] CStore
CStash (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"grab") Bool
True
            -- @CStash@ is the implicit default; refined in HandleHumanGlobalM

grabItems :: Text -> CmdTriple
grabItems :: Text -> CmdTriple
grabItems Text
t = ([CmdCategory
CmdItemMenu, CmdCategory
CmdItem], Text
t, HumanCmd
grabCmd)

dropCmd :: HumanCmd
dropCmd :: HumanCmd
dropCmd = [CStore] -> CStore -> Maybe Text -> Bool -> HumanCmd
MoveItem [CStore
CStash, CStore
CEqp] CStore
CGround Maybe Text
forall a. Maybe a
Nothing Bool
False

dropItems :: Text -> CmdTriple
dropItems :: Text -> CmdTriple
dropItems Text
t = ([CmdCategory
CmdItemMenu, CmdCategory
CmdItem], Text
t, HumanCmd
dropCmd)

descIs :: [TriggerItem] -> Text
descIs :: [TriggerItem] -> Text
descIs [] = Text
"trigger an item"
descIs (TriggerItem
t : [TriggerItem]
_) = [Part] -> Text
makePhrase [TriggerItem -> Part
tiverb TriggerItem
t, TriggerItem -> Part
tiobject TriggerItem
t]

defaultHeroSelect :: Int -> (String, CmdTriple)
defaultHeroSelect :: Int -> (String, CmdTriple)
defaultHeroSelect Int
k = ([Int -> Char
Char.intToDigit Int
k], ([CmdCategory
CmdMeta], Text
"", Int -> HumanCmd
PickLeader Int
k))

macroRun25 :: [String]
macroRun25 :: [String]
macroRun25 = [String
"C-comma", String
"C-v"]

memberCycle :: Direction -> [CmdCategory] -> CmdTriple
memberCycle :: Direction -> [CmdCategory] -> CmdTriple
memberCycle Direction
d [CmdCategory]
cats = ( [CmdCategory]
cats
                     , Text
"cycle"
                       Text -> Text -> Text
<+> (if Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Backward then Text
"backwards" else Text
"")
                       Text -> Text -> Text
<+> Text
"among all party members"
                     , Direction -> HumanCmd
PointmanCycle Direction
d )

memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel Direction
d [CmdCategory]
cats = ( [CmdCategory]
cats
                          , Text
"cycle"
                            Text -> Text -> Text
<+> (if Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Backward then Text
"backwards" else Text
"")
                            Text -> Text -> Text
<+> Text
" among party members on the level"
                          , Direction -> HumanCmd
PointmanCycleLevel Direction
d )