    -- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"
    -- client commands that do not return server requests,,
    -- but only change internal client state.
    -- None of such commands takes game time.
    module Game.LambdaHack.Client.UI.HandleHumanLocalM
      ( -- * Meta commands
        macroHuman, macroHumanTransition
        -- * Local commands
      , chooseItemHuman, chooseItemDialogMode
      , chooseItemProjectHuman, chooseItemApplyHuman
      , psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman
      , pointmanCycleHuman, pointmanCycleLevelHuman
      , selectActorHuman, selectNoneHuman, selectWithPointerHuman
      , repeatHuman, repeatHumanTransition
      , repeatLastHuman, repeatLastHumanTransition
      , recordHuman, recordHumanTransition, allHistoryHuman
      , markVisionHuman, markSmellHuman, markSuspectHuman, markAnimHuman
      , overrideTutHuman
      , printScreenHuman
        -- * Commands specific to aiming
      , cancelHuman, acceptHuman, detailCycleHuman
      , clearTargetIfItemClearHuman, itemClearHuman
      , moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman
      , aimAscendHuman, epsIncrHuman
      , xhairUnknownHuman, xhairItemHuman, xhairStairHuman
      , xhairPointerFloorHuman, xhairPointerMuteHuman, xhairPointerEnemyHuman
      , aimPointerFloorHuman, aimPointerEnemyHuman
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , chooseItemDialogModeLore, projectCheck
      , posFromXhair, permittedApplyClient, endAiming, endAimingMsg
      , flashAiming
    #endif
        -- * Operations both internal and used in unit tests
      , permittedProjectClient, xhairLegalEps
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Data.Either
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import qualified Data.Map.Strict as M
    import qualified Data.Text as T
    import qualified NLP.Miniutter.English as MU

    import           Game.LambdaHack.Client.BfsM
    import           Game.LambdaHack.Client.CommonM
    import           Game.LambdaHack.Client.MonadClient
    import           Game.LambdaHack.Client.State
    import           Game.LambdaHack.Client.UI.ActorUI
    import           Game.LambdaHack.Client.UI.Animation
    import           Game.LambdaHack.Client.UI.Content.Screen
    import           Game.LambdaHack.Client.UI.ContentClientUI
    import           Game.LambdaHack.Client.UI.DrawM
    import           Game.LambdaHack.Client.UI.EffectDescription
    import           Game.LambdaHack.Client.UI.Frame
    import           Game.LambdaHack.Client.UI.FrameM
    import           Game.LambdaHack.Client.UI.HandleHelperM
    import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
    import           Game.LambdaHack.Client.UI.InventoryM
    import qualified Game.LambdaHack.Client.UI.Key as K
    import           Game.LambdaHack.Client.UI.MonadClientUI
    import           Game.LambdaHack.Client.UI.Msg
    import           Game.LambdaHack.Client.UI.MsgM
    import           Game.LambdaHack.Client.UI.Overlay
    import           Game.LambdaHack.Client.UI.PointUI
    import           Game.LambdaHack.Client.UI.SessionUI
    import           Game.LambdaHack.Client.UI.Slideshow
    import           Game.LambdaHack.Client.UI.SlideshowM
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.ClientOptions
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    import qualified Game.LambdaHack.Common.ItemAspect as IA
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Level
    import           Game.LambdaHack.Common.Misc
    import           Game.LambdaHack.Common.MonadStateRead
    import           Game.LambdaHack.Common.Point
    import           Game.LambdaHack.Common.ReqFailure
    import           Game.LambdaHack.Common.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import           Game.LambdaHack.Common.Vector
    import qualified Game.LambdaHack.Content.FactionKind as FK
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import qualified Game.LambdaHack.Content.ModeKind as MK
    import           Game.LambdaHack.Content.RuleKind
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import qualified Game.LambdaHack.Definition.Color as Color
    import           Game.LambdaHack.Definition.Defs

    -- * Macro

    macroHuman :: MonadClientUI m => [String] -> m ()
    macroHuman :: forall (m :: * -> *). MonadClientUI m => [String] -> m ()
    macroHuman [String]
    ks = do
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
        let kms :: [KM]
    kms = String -> KM
    K.mkKM (String -> KM) -> [String] -> [KM]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    ks
            (KeyMacroFrame
    smacroFrameNew, [KeyMacroFrame]
    smacroStackMew) =
               [KM]
    -> KeyMacroFrame
    -> [KeyMacroFrame]
    -> (KeyMacroFrame, [KeyMacroFrame])
    macroHumanTransition [KM]
    kms (SessionUI -> KeyMacroFrame
    smacroFrame SessionUI
    sess) (SessionUI -> [KeyMacroFrame]
    smacroStack SessionUI
    sess)
        in SessionUI
    sess { smacroFrame = smacroFrameNew
                , smacroStack = smacroStackMew }
      MsgClassIgnore -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassIgnore
    MsgMacroOperation (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Macro activated:" Text -> Text -> Text
    <+> String -> Text
    T.pack ([String] -> String
    unwords [String]
    ks)

    -- | Push a new macro frame to the stack whenever repeating a macro.
    macroHumanTransition :: [K.KM] -> KeyMacroFrame -> [KeyMacroFrame]
                         -> (KeyMacroFrame, [KeyMacroFrame])
    macroHumanTransition :: [KM]
    -> KeyMacroFrame
    -> [KeyMacroFrame]
    -> (KeyMacroFrame, [KeyMacroFrame])
    macroHumanTransition [KM]
    kms KeyMacroFrame
    macroFrame [KeyMacroFrame]
    macroFrames =
      let smacroFrameNew :: KeyMacroFrame
    smacroFrameNew = KeyMacroFrame
    emptyMacroFrame {keyPending = KeyMacro kms}
      in (KeyMacroFrame
    smacroFrameNew, KeyMacroFrame
    macroFrame KeyMacroFrame -> [KeyMacroFrame] -> [KeyMacroFrame]
    forall a. a -> [a] -> [a]
    : [KeyMacroFrame]
    macroFrames)

    -- * ChooseItem

    -- | Display items from a given container store and possibly let the user
    -- chose one.
    chooseItemHuman :: MonadClientUI m => ActorId -> ItemDialogMode -> m MError
    chooseItemHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> ItemDialogMode -> m MError
    chooseItemHuman ActorId
    leader ItemDialogMode
    c =
      (FailError -> MError)
    -> (ActorId -> MError) -> Either FailError ActorId -> MError
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either FailError -> MError
    forall a. a -> Maybe a
    Just (MError -> ActorId -> MError
    forall a b. a -> b -> a
    const MError
    forall a. Maybe a
    Nothing) (Either FailError ActorId -> MError)
    -> m (Either FailError ActorId) -> m MError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False ItemDialogMode
    c

    chooseItemDialogModeLore :: forall m . MonadClientUI m
                             => m (Maybe ResultItemDialogMode)
    chooseItemDialogModeLore :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Maybe ResultItemDialogMode)
    chooseItemDialogModeLore = do
      schosenLoreOld <- (SessionUI -> ChosenLore) -> m ChosenLore
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> ChosenLore
    schosenLore
      (inhabitants, embeds) <- case schosenLoreOld of
        ChosenLore [(ActorId, Actor)]
    inh [(ItemId, ItemQuant)]
    emb -> ([(ActorId, Actor)], [(ItemId, ItemQuant)])
    -> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(ActorId, Actor)]
    inh, [(ItemId, ItemQuant)]
    emb)
        ChosenLore
    ChosenNothing -> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
    forall (m :: * -> *).
    MonadClientUI m =>
    m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
    computeChosenLore
      bagHuge <- getsState $ EM.map (const quantSingle) . sitemD
      itemToF <- getsState $ flip itemToFull
      ItemRoles itemRoles <- getsSession sroles
      let rlore :: ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
          rlore ItemId
    iid SLore
    slore ChosenLore
    schosenLore = do
            let itemRole :: EnumSet ItemId
    itemRole = EnumMap SLore (EnumSet ItemId)
    itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! SLore
    slore
                bagAll :: EnumMap ItemId ItemQuant
    bagAll = (ItemId -> ItemQuant -> Bool)
    -> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant
    forall k a.
    Enum k =>
    (k -> a -> Bool) -> EnumMap k a -> EnumMap k a
    EM.filterWithKey (\ItemId
    iid2 ItemQuant
    _ -> ItemId
    iid2 ItemId -> EnumSet ItemId -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet ItemId
    itemRole)
                                          EnumMap ItemId ItemQuant
    bagHuge
            (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {schosenLore}
            let iids :: [(ItemId, ItemQuant)]
    iids = (ItemId -> ItemFull)
    -> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
    sortIids ItemId -> ItemFull
    itemToF ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
    -> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap ItemId ItemQuant
    bagAll
                slot :: MenuSlot
    slot = Int -> MenuSlot
    forall a. Enum a => Int -> a
    toEnum (Int -> MenuSlot) -> Int -> MenuSlot
    forall a b. (a -> b) -> a -> b
    $ Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Int
    forall a. HasCallStack => String -> a
    error (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ItemId, [(ItemId, ItemQuant)]) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ItemId
    iid, [(ItemId, ItemQuant)]
    iids))
                              (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemId -> [ItemId] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex ItemId
    iid ([ItemId] -> Maybe Int) -> [ItemId] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ ((ItemId, ItemQuant) -> ItemId)
    -> [(ItemId, ItemQuant)] -> [ItemId]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemId, ItemQuant) -> ItemId
    forall a b. (a, b) -> a
    fst [(ItemId, ItemQuant)]
    iids
            Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode))
    -> Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
    forall a b. (a -> b) -> a -> b
    $ ResultItemDialogMode -> Maybe ResultItemDialogMode
    forall a. a -> Maybe a
    Just (ResultItemDialogMode -> Maybe ResultItemDialogMode)
    -> ResultItemDialogMode -> Maybe ResultItemDialogMode
    forall a b. (a -> b) -> a -> b
    $ SLore -> MenuSlot -> [(ItemId, ItemQuant)] -> ResultItemDialogMode
    RLore SLore
    slore MenuSlot
    slot [(ItemId, ItemQuant)]
    iids
      case inhabitants of
        (ActorId
    _, Actor
    b) : [(ActorId, Actor)]
    rest -> do
          let iid :: ItemId
    iid = Actor -> ItemId
    btrunk Actor
    b
          arItem <- (State -> AspectRecord) -> m AspectRecord
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> AspectRecord) -> m AspectRecord)
    -> (State -> AspectRecord) -> m AspectRecord
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> AspectRecord
    aspectRecordFromIid ItemId
    iid
          let slore | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Bool
    bproj Actor
    b = SLore
    STrunk
                    | Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arItem = SLore
    SBlast
                    | Bool
    otherwise = SLore
    SItem
          rlore iid slore (ChosenLore rest embeds)
        [] ->
          case [(ItemId, ItemQuant)]
    embeds of
            (ItemId
    iid, ItemQuant
    _) : [(ItemId, ItemQuant)]
    rest -> do
              let slore :: SLore
    slore = SLore
    SEmbed
              ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
    rlore ItemId
    iid SLore
    slore ([(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
    ChosenLore [(ActorId, Actor)]
    inhabitants [(ItemId, ItemQuant)]
    rest)
            [] -> do
              (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {schosenLore = ChosenNothing}
              Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ResultItemDialogMode
    forall a. Maybe a
    Nothing

    chooseItemDialogMode :: forall m. MonadClientUI m
                         => ActorId -> Bool -> ItemDialogMode
                         -> m (FailOrCmd ActorId)
    chooseItemDialogMode :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader0 Bool
    permitLoreCycle ItemDialogMode
    c = do
      CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      FontSetup{propFont} <- getFontSetup
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      (ggi, loreFound) <- do
        mggiLore <- if permitLoreCycle && c == MLore SItem
                    then chooseItemDialogModeLore
                    else return Nothing
        case mggiLore of
          Just ResultItemDialogMode
    rlore -> (Either Text ResultItemDialogMode, Bool)
    -> m (Either Text ResultItemDialogMode, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResultItemDialogMode -> Either Text ResultItemDialogMode
    forall a b. b -> Either a b
    Right ResultItemDialogMode
    rlore, Bool
    True)
          Maybe ResultItemDialogMode
    Nothing -> do
            ggi <- ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
    getStoreItem ActorId
    leader0 ItemDialogMode
    c
            return (ggi, False)
      -- Pointman could have been changed in @getStoreItem@ above.
      mleader <- getsClient sleader
      -- When run inside a test, without mleader, assume leader not changed.
      let leader = ActorId -> Maybe ActorId -> ActorId
    forall a. a -> Maybe a -> a
    fromMaybe ActorId
    leader0 Maybe ActorId
    mleader
      recordHistory  -- item chosen, wipe out already shown msgs
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      let meleeSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkHurtMelee Skills
    actorCurAndMaxSk
      bUI <- getsSession $ getActorUI leader
      case ggi of
        Right ResultItemDialogMode
    result -> case ResultItemDialogMode
    result of
          RStore CStore
    fromCStore [ItemId
    iid] -> do
            (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
              SessionUI
    sess {sitemSel = Just (iid, fromCStore, False)}
            Either FailError ActorId -> m (Either FailError ActorId)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either FailError ActorId -> m (Either FailError ActorId))
    -> Either FailError ActorId -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Either FailError ActorId
    forall a b. b -> Either a b
    Right ActorId
    leader
          RStore{} -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> ResultItemDialogMode -> String
    forall v. Show v => String -> v -> String
    `showFailure` ResultItemDialogMode
    result
          ROwned ItemId
    iid -> do
            found <- (State -> [(ActorId, (Actor, CStore))])
    -> m [(ActorId, (Actor, CStore))]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [(ActorId, (Actor, CStore))])
     -> m [(ActorId, (Actor, CStore))])
    -> (State -> [(ActorId, (Actor, CStore))])
    -> m [(ActorId, (Actor, CStore))]
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
    findIid ActorId
    leader FactionId
    side ItemId
    iid
            let (newAid, bestStore) = case leader `lookup` found of
                  Just (Actor
    _, CStore
    store) -> (ActorId
    leader, CStore
    store)
                  Maybe (Actor, CStore)
    Nothing -> case [(ActorId, (Actor, CStore))]
    found of
                    (ActorId
    aid, (Actor
    _, CStore
    store)) : [(ActorId, (Actor, CStore))]
    _ -> (ActorId
    aid, CStore
    store)
                    [] -> String -> (ActorId, CStore)
    forall a. HasCallStack => String -> a
    error (String -> (ActorId, CStore)) -> String -> (ActorId, CStore)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> ResultItemDialogMode -> String
    forall v. Show v => String -> v -> String
    `showFailure` ResultItemDialogMode
    result
            modifySession $ \SessionUI
    sess ->
              SessionUI
    sess {sitemSel = Just (iid, bestStore, False)}
            arena <- getArenaUI
            b2 <- getsState $ getActorBody newAid
            let banned = Faction -> Bool
    bannedPointmanSwitchBetweenLevels Faction
    fact
            if | newAid == leader -> return $ Right leader
               | blid b2 /= arena && banned ->
                 failSer NoChangeDunLeader
               | otherwise -> do
                 -- We switch leader only here, not when processing results
                 -- of lore screens, because lore is only about inspecting items.
                 --
                 -- This is a bit too verbose in aiming mode, but verbosity
                 -- here is good to turn player's attention to the switch.
                 void $ pickLeader True newAid
                 return $ Right newAid
          RLore SLore
    slore MenuSlot
    slot [(ItemId, ItemQuant)]
    iids -> do
            let promptFun :: ItemId -> ItemFull -> Int -> Text
    promptFun ItemId
    _ ItemFull
    itemFull Int
    _ = case SLore
    slore of
                  SLore
    SBody ->
                    let blurb :: Part
    blurb = if Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Condition
                                   (AspectRecord -> Bool) -> AspectRecord -> Bool
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
                                then Part
    "condition"
                                else Part
    "organ"
                    in [Part] -> Text
    makeSentence [ActorUI -> Part
    partActor ActorUI
    bUI, Part
    "is aware of" ,Part -> Part
    MU.AW Part
    blurb]
                  SLore
    _ ->
                    [Part] -> Text
    makeSentence [ Part -> Part -> Part
    MU.SubjectVerbSg (ActorUI -> Part
    partActor ActorUI
    bUI) Part
    "remember"
                                 , Part -> Part
    MU.AW (Part -> Part) -> Part -> Part
    forall a b. (a -> b) -> a -> b
    $ Text -> Part
    MU.Text (SLore -> Text
    headingSLore SLore
    slore) ]
            schosenLore <- (SessionUI -> ChosenLore) -> m ChosenLore
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> ChosenLore
    schosenLore
            let lorePending = Bool
    loreFound Bool -> Bool -> Bool
    && case ChosenLore
    schosenLore of
                  ChosenLore [] [] -> Bool
    False
                  ChosenLore
    _ -> Bool
    True
                renderOneItem =
                  (ItemId -> ItemFull -> Int -> Text)
    -> Int
    -> ItemDialogMode
    -> [(ItemId, ItemQuant)]
    -> MenuSlot
    -> m OKX
    forall (m :: * -> *).
    MonadClientUI m =>
    (ItemId -> ItemFull -> Int -> Text)
    -> Int
    -> ItemDialogMode
    -> [(ItemId, ItemQuant)]
    -> MenuSlot
    -> m OKX
    okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
    promptFun Int
    meleeSkill (SLore -> ItemDialogMode
    MLore SLore
    slore) [(ItemId, ItemQuant)]
    iids
                extraKeys = [Char -> KM
    K.mkChar Char
    '~' | Bool
    lorePending]
                slotBound = [(ItemId, ItemQuant)] -> Int
    forall a. [a] -> Int
    length [(ItemId, ItemQuant)]
    iids Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- displayOneMenuItem renderOneItem extraKeys slotBound slot
            case K.key km of
              Key
    K.Space -> do
                (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {schosenLore = ChosenNothing}
                ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False (SLore -> ItemDialogMode
    MLore SLore
    slore)
              K.Char Char
    '~' -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    True ItemDialogMode
    c
              Key
    K.Esc -> do
                (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {schosenLore = ChosenNothing}
                Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Key
    _ -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
          RSkills MenuSlot
    slot0 -> do
            -- This can be used in the future, e.g., to increase stats from
            -- level-up stat points, so let's keep it even if it shows
            -- no extra info compared to right pane display in menu.
            let renderOneItem :: MenuSlot -> m OKX
    renderOneItem MenuSlot
    slot = do
                  (prompt2, attrString) <- ActorId -> MenuSlot -> m (Text, AttrString)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> MenuSlot -> m (Text, AttrString)
    skillCloseUp ActorId
    leader MenuSlot
    slot
                  let ov0 = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont
                            (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ [AttrLine] -> Overlay
    offsetOverlay
                            ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    rwidth Int
    rwidth AttrString
    attrString
                  msgAdd MsgPromptGeneric prompt2
                  return (ov0, [])
                extraKeys :: [a]
    extraKeys = []
                slotBound :: Int
    slotBound = [Skill] -> Int
    forall a. [a] -> Int
    length [Skill]
    skillsInDisplayOrder Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    forall (m :: * -> *).
    MonadClientUI m =>
    (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    displayOneMenuItem MenuSlot -> m OKX
    renderOneItem [KM]
    forall a. [a]
    extraKeys Int
    slotBound MenuSlot
    slot0
            case K.key km of
              Key
    K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False ItemDialogMode
    MSkills
              Key
    K.Esc -> Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Key
    _ -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
          RPlaces MenuSlot
    slot0 -> do
            COps{coplace} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
            soptions <- getsClient soptions
            -- This is computed just once for the whole series of up and down arrow
            -- navigations, avoid quadratic blowup.
            places <- getsState $ EM.assocs
                                  . placesFromState coplace (sexposePlaces soptions)
            let renderOneItem MenuSlot
    slot = do
                  (prompt2, blurbs) <-
                    [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
    -> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
    forall (m :: * -> *).
    MonadClientUI m =>
    [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
    -> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
    placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
    places (ClientOptions -> Bool
    sexposePlaces ClientOptions
    soptions) MenuSlot
    slot
                  let splitText = Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    rwidth Int
    rwidth
                      ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap
                            ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
    -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
    -> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([AttrString] -> [AttrLine])
    -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([AttrString] -> [AttrLine])
     -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
    -> ([AttrString] -> [AttrLine])
    -> (DisplayFont, [AttrString])
    -> (DisplayFont, [AttrLine])
    forall a b. (a -> b) -> a -> b
    $ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AttrString -> [AttrLine]
    splitText) [(DisplayFont, [AttrString])]
    blurbs
                  msgAdd MsgPromptGeneric prompt2
                  return (ov0, [])
                extraKeys = []
                slotBound = [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))] -> Int
    forall a. [a] -> Int
    length [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
    places Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- displayOneMenuItem renderOneItem extraKeys slotBound slot0
            case K.key km of
              Key
    K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False ItemDialogMode
    MPlaces
              Key
    K.Esc -> Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Key
    _ -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
          RFactions MenuSlot
    slot0 -> do
            sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> ItemRoles
    sroles
            factions <- getsState $ factionsFromState sroles
            let renderOneItem MenuSlot
    slot = do
                  (prompt2, blurbs) <- [(FactionId, Faction)]
    -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
    forall (m :: * -> *).
    MonadClientUI m =>
    [(FactionId, Faction)]
    -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
    factionCloseUp [(FactionId, Faction)]
    factions MenuSlot
    slot
                  let splitText = Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    rwidth Int
    rwidth
                      ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap
                            ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
    -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
    -> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([AttrString] -> [AttrLine])
    -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([AttrString] -> [AttrLine])
     -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
    -> ([AttrString] -> [AttrLine])
    -> (DisplayFont, [AttrString])
    -> (DisplayFont, [AttrLine])
    forall a b. (a -> b) -> a -> b
    $ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AttrString -> [AttrLine]
    splitText) [(DisplayFont, [AttrString])]
    blurbs
                  msgAdd MsgPromptGeneric prompt2
                  return (ov0, [])
                extraKeys = []
                slotBound = [(FactionId, Faction)] -> Int
    forall a. [a] -> Int
    length [(FactionId, Faction)]
    factions Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- displayOneMenuItem renderOneItem extraKeys slotBound slot0
            case K.key km of
              Key
    K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False ItemDialogMode
    MFactions
              Key
    K.Esc -> Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Key
    _ -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
          RModes MenuSlot
    slot0 -> do
            let displayOneMenuItemBig :: (MenuSlot -> m OKX)
                                      -> [K.KM] -> Int -> MenuSlot
                                      -> m K.KM
                displayOneMenuItemBig :: (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    displayOneMenuItemBig MenuSlot -> m OKX
    renderOneItem [KM]
    extraKeys Int
    slotBound MenuSlot
    slot = do
                  let keys :: [KM]
    keys = [KM
    K.spaceKM, KM
    K.escKM]
                             [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM
    K.upKM | MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0]
                             [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM
    K.downKM | MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    slotBound]
                             [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM]
    extraKeys
                  okx <- MenuSlot -> m OKX
    renderOneItem MenuSlot
    slot
                  -- Here it differs from @displayOneMenuItem@,
                  slides <- overlayToSlideshow rheight keys okx
                  ekm2 <- displayChoiceScreen "" ColorFull True slides keys
                  let km = (KM -> KM) -> (MenuSlot -> KM) -> KeyOrSlot -> KM
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either KM -> KM
    forall a. a -> a
    id (String -> MenuSlot -> KM
    forall a. HasCallStack => String -> a
    error (String -> MenuSlot -> KM) -> String -> MenuSlot -> KM
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    ekm2) KeyOrSlot
    ekm2
                  -- Here it stops differing.
                  case K.key km of
                    Key
    K.Up -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    displayOneMenuItemBig MenuSlot -> m OKX
    renderOneItem [KM]
    extraKeys
                                                  Int
    slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
    forall a b. (a -> b) -> a -> b
    $ MenuSlot -> MenuSlot
    forall a. Enum a => a -> a
    pred MenuSlot
    slot
                    Key
    K.Down -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    displayOneMenuItemBig MenuSlot -> m OKX
    renderOneItem [KM]
    extraKeys
                                                    Int
    slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
    forall a b. (a -> b) -> a -> b
    $ MenuSlot -> MenuSlot
    forall a. Enum a => a -> a
    succ MenuSlot
    slot
                    Key
    _ -> KM -> m KM
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return KM
    km
            COps{comode} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
            svictories <- getsSession svictories
            nxtChal <- getsClient snxtChal
              -- mark victories only for current difficulty
            let f ![(a, b)]
    acc p
    _p !a
    i !b
    a = (a
    i, b
    a) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)]
    acc
                campaignModes = ContentData ModeKind
    -> GroupName ModeKind
    -> ([(ContentId ModeKind, ModeKind)]
        -> Int
        -> ContentId ModeKind
        -> ModeKind
        -> [(ContentId ModeKind, ModeKind)])
    -> [(ContentId ModeKind, ModeKind)]
    -> [(ContentId ModeKind, ModeKind)]
    forall a b.
    ContentData a
    -> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
    ofoldlGroup' ContentData ModeKind
    comode GroupName ModeKind
    MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
    -> Int
    -> ContentId ModeKind
    -> ModeKind
    -> [(ContentId ModeKind, ModeKind)]
    forall {a} {b} {p}. [(a, b)] -> p -> a -> b -> [(a, b)]
    f []
                renderOneItem MenuSlot
    slot = do
                  let (ContentId ModeKind
    gameModeId, ModeKind
    gameMode) = [(ContentId ModeKind, ModeKind)]
    campaignModes [(ContentId ModeKind, ModeKind)]
    -> Int -> (ContentId ModeKind, ModeKind)
    forall a. HasCallStack => [a] -> Int -> a
    !! MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot
                  ov0 <- Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
    describeMode Bool
    False ContentId ModeKind
    gameModeId
                  let victories = case ContentId ModeKind
    -> EnumMap (ContentId ModeKind) (Map Challenge Int)
    -> Maybe (Map Challenge Int)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup ContentId ModeKind
    gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
    svictories of
                        Maybe (Map Challenge Int)
    Nothing -> Int
    0
                        Just Map Challenge Int
    cm -> Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Challenge -> Map Challenge Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Challenge
    nxtChal Map Challenge Int
    cm)
                      verb = if Int
    victories Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then Part
    "remember" else Part
    "forsee"
                      prompt2 = [Part] -> Text
    makeSentence
                        [ Part -> Part -> Part
    MU.SubjectVerbSg Part
    "you" Part
    verb
                        , Text -> Part
    MU.Text (Text -> Part) -> Text -> Part
    forall a b. (a -> b) -> a -> b
    $ Text
    "the '" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> ModeKind -> Text
    MK.mname ModeKind
    gameMode Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "' adventure" ]
                  msgAdd MsgPromptGeneric prompt2
                  return (ov0, [])
                extraKeys = []
                slotBound = [(ContentId ModeKind, ModeKind)] -> Int
    forall a. [a] -> Int
    length [(ContentId ModeKind, ModeKind)]
    campaignModes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- displayOneMenuItemBig renderOneItem extraKeys slotBound slot0
            case K.key km of
              Key
    K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
    chooseItemDialogMode ActorId
    leader Bool
    False ItemDialogMode
    MModes
              Key
    K.Esc -> Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Key
    _ -> String -> m (Either FailError ActorId)
    forall a. HasCallStack => String -> a
    error (String -> m (Either FailError ActorId))
    -> String -> m (Either FailError ActorId)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
        Left Text
    err -> Text -> m (Either FailError ActorId)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    err

    -- * ChooseItemProject

    chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
                           => ActorId -> [HumanCmd.TriggerItem] -> m MError
    chooseItemProjectHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> [TriggerItem] -> m MError
    chooseItemProjectHuman ActorId
    leader [TriggerItem]
    ts = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
      let overStash = Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
          storesBase = [CStore
    CStash, CStore
    CEqp]
          stores | Bool
    overStash = [CStore]
    storesBase [CStore] -> [CStore] -> [CStore]
    forall a. [a] -> [a] -> [a]
    ++ [CStore
    CGround]
                 | Bool
    otherwise = CStore
    CGround CStore -> [CStore] -> [CStore]
    forall a. a -> [a] -> [a]
    : [CStore]
    storesBase
          (verb1, object1) = case ts of
            [] -> (Part
    "aim", Part
    "item")
            TriggerItem
    tr : [TriggerItem]
    _ -> (TriggerItem -> Part
    HumanCmd.tiverb TriggerItem
    tr, TriggerItem -> Part
    HumanCmd.tiobject TriggerItem
    tr)
          verb = [Part] -> Text
    makePhrase [Part
    verb1]
          triggerSyms = [TriggerItem] -> String
    triggerSymbols [TriggerItem]
    ts
      mpsuitReq <- psuitReq leader
      case mpsuitReq of
        -- If xhair aim invalid, no item is considered a (suitable) missile.
        Left Text
    err -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    err
        Right ItemFull -> Either ReqFailure (Point, Bool)
    psuitReqFun -> do
          itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
    -> m (Maybe (ItemId, CStore, Bool))
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
    sitemSel
          case itemSel of
            Just (ItemId
    _, CStore
    _, Bool
    True) -> MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
            Just (ItemId
    iid, CStore
    fromCStore, Bool
    False) -> do
              -- We don't validate vs @ts@ here, because player has selected
              -- this item, so he knows what he's doing (unless really absurd).
              itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
              bag <- getsState $ getBodyStoreBag b fromCStore
              case iid `EM.lookup` bag of
                Just ItemQuant
    _ | Either ReqFailure (Point, Bool) -> Bool
    forall a b. Either a b -> Bool
    isRight (ItemFull -> Either ReqFailure (Point, Bool)
    psuitReqFun ItemFull
    itemFull) ->
                  -- The player knows what he's doing. We warn him about range
                  -- and experimenting with unknown precious items is fine.
                  MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
                Maybe ItemQuant
    _ -> do
                  (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sitemSel = Nothing}
                  ActorId -> [TriggerItem] -> m MError
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> [TriggerItem] -> m MError
    chooseItemProjectHuman ActorId
    leader [TriggerItem]
    ts
            Maybe (ItemId, CStore, Bool)
    Nothing -> do
              let psuit :: m Suitability
    psuit =
                    Suitability -> m Suitability
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Suitability -> m Suitability) -> Suitability -> m Suitability
    forall a b. (a -> b) -> a -> b
    $ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
    SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
    -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
    forall a b. (a -> b) -> a -> b
    $ \Maybe CStore
    _ ItemFull
    itemFull ItemQuant
    _kit ->
                      -- Here the player does not explicitly pick an item,
                      -- so we may exclude precious unknown items, etc.
                      (ReqFailure -> Bool)
    -> ((Point, Bool) -> Bool)
    -> Either ReqFailure (Point, Bool)
    -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Bool -> ReqFailure -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (Point, Bool) -> Bool
    forall a b. (a, b) -> b
    snd (ItemFull -> Either ReqFailure (Point, Bool)
    psuitReqFun ItemFull
    itemFull)
                      Bool -> Bool -> Bool
    && (String -> Bool
    forall a. [a] -> Bool
    null String
    triggerSyms
                          Bool -> Bool -> Bool
    || ItemKind -> Char
    IK.isymbol (ItemFull -> ItemKind
    itemKind ItemFull
    itemFull) Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    triggerSyms)
                  prompt :: Text
    prompt = [Part] -> Text
    makePhrase [Part
    "What", Part
    object1, Part
    "to"]
                  promptGeneric :: Text
    promptGeneric = Text
    "What to"
              ggi <- ActorId
    -> m Suitability
    -> Text
    -> Text
    -> Text
    -> Text
    -> [CStore]
    -> m (Either Text (CStore, ItemId))
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> m Suitability
    -> Text
    -> Text
    -> Text
    -> Text
    -> [CStore]
    -> m (Either Text (CStore, ItemId))
    getGroupItem ActorId
    leader m Suitability
    psuit Text
    prompt Text
    promptGeneric Text
    verb Text
    "fling"
                                  [CStore]
    stores
              case ggi of
                Right (CStore
    fromCStore, ItemId
    iid) -> do
                  (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                    SessionUI
    sess {sitemSel = Just (iid, fromCStore, False)}
                  MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
                Left Text
    err -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    err

    permittedProjectClient :: MonadClientUI m
                           => ActorId -> m (ItemFull -> Either ReqFailure Bool)
    permittedProjectClient :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (ItemFull -> Either ReqFailure Bool)
    permittedProjectClient ActorId
    leader = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      b <- getsState $ getActorBody leader
      let skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkProject Skills
    actorCurAndMaxSk
          calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
      return $ permittedProject False skill calmE

    projectCheck :: MonadClientUI m => ActorId -> Point -> m (Maybe ReqFailure)
    projectCheck :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (Maybe ReqFailure)
    projectCheck ActorId
    leader Point
    tpos = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      eps <- getsClient seps
      sb <- getsState $ getActorBody leader
      let lid = Actor -> LevelId
    blid Actor
    sb
          spos = Actor -> Point
    bpos Actor
    sb
      -- Not @ScreenContent@, because not drawing here.
      case bresenhamsLineAlgorithm eps spos tpos of
        Maybe [Point]
    Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqFailure -> m (Maybe ReqFailure))
    -> Maybe ReqFailure -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Maybe ReqFailure
    forall a. a -> Maybe a
    Just ReqFailure
    ProjectAimOnself
        Just [] -> String -> m (Maybe ReqFailure)
    forall a. HasCallStack => String -> a
    error (String -> m (Maybe ReqFailure)) -> String -> m (Maybe ReqFailure)
    forall a b. (a -> b) -> a -> b
    $ String
    "project from the edge of level"
                           String -> (Point, Point, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Point
    spos, Point
    tpos, Actor
    sb)
        Just (Point
    pos : [Point]
    _) -> do
          lvl <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel LevelId
    lid
          let t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    pos
          if not $ Tile.isWalkable coTileSpeedup t
            then return $ Just ProjectBlockTerrain
            else if occupiedBigLvl pos lvl
                 then return $ Just ProjectBlockActor
                 else return Nothing

    -- | Check whether one is permitted to aim (for projecting) at a target.
    -- The check is stricter for actor targets, assuming the player simply wants
    -- to hit a single actor. In order to fine tune trick-shots, e.g., piercing
    -- many actors, other aiming modes should be used.
    -- Returns a different @seps@ if needed to reach the target.
    --
    -- Note: Simple Perception check is not enough for the check,
    -- e.g., because the target actor can be obscured by a glass wall.
    xhairLegalEps :: MonadClientUI m => ActorId -> m (Either Text Int)
    xhairLegalEps :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (Either Text Int)
    xhairLegalEps ActorId
    leader = do
      cops@COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      b <- getsState $ getActorBody leader
      lidV <- viewedLevelUI
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (LevelId
    lidV LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> LevelId
    blid Actor
    b) ()
          findNewEps Bool
    onlyFirst Point
    pos = do
            lvl <- LevelId -> m Level
    forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
    getLevel (Actor -> LevelId
    blid Actor
    b)
            oldEps <- getsClient seps
            return $! case makeLine onlyFirst b pos oldEps cops lvl of
              Just Int
    newEps -> Int -> Either Text Int
    forall a b. b -> Either a b
    Right Int
    newEps
              Maybe Int
    Nothing -> Text -> Either Text Int
    forall a b. a -> Either a b
    Left (Text -> Either Text Int) -> Text -> Either Text Int
    forall a b. (a -> b) -> a -> b
    $ if Bool
    onlyFirst
                                then Text
    "aiming blocked at the first step"
                                else Text
    "aiming line blocked somewhere"
      xhair <- getsSession sxhair
      case xhair of
        Maybe Target
    Nothing -> Either Text Int -> m (Either Text Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Int -> m (Either Text Int))
    -> Either Text Int -> m (Either Text Int)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Int
    forall a b. a -> Either a b
    Left Text
    "no aim designated"
        Just (TEnemy ActorId
    a) -> do
          body <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    a
          let pos = Actor -> Point
    bpos Actor
    body
          if blid body == lidV
          then findNewEps False pos
          else return $ Left "can't fling at an enemy on remote level"
        Just (TNonEnemy ActorId
    a) -> do
          body <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    a
          let pos = Actor -> Point
    bpos Actor
    body
          if blid body == lidV
          then findNewEps False pos
          else return $ Left "can't fling at a non-enemy on remote level"
        Just (TPoint TEnemyPos{} LevelId
    _ Point
    _) ->
          Either Text Int -> m (Either Text Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Int -> m (Either Text Int))
    -> Either Text Int -> m (Either Text Int)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Int
    forall a b. a -> Either a b
    Left Text
    "selected opponent not visible"
        Just (TPoint TGoal
    _ LevelId
    lid Point
    pos) ->
          if LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV
          then Bool -> Point -> m (Either Text Int)
    findNewEps Bool
    True Point
    pos  -- @True@ to help pierce many foes, etc.
          else Either Text Int -> m (Either Text Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Int -> m (Either Text Int))
    -> Either Text Int -> m (Either Text Int)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Int
    forall a b. a -> Either a b
    Left Text
    "can't fling at a target on remote level"
        Just (TVector Vector
    v) -> do
          -- Not @ScreenContent@, because not drawing here.
          let shifted :: Point
    shifted = Int -> Int -> Point -> Vector -> Point
    shiftBounded Int
    rWidthMax Int
    rHeightMax (Actor -> Point
    bpos Actor
    b) Vector
    v
          if Point
    shifted Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    b Bool -> Bool -> Bool
    && Vector
    v Vector -> Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int -> Int -> Vector
    Vector Int
    0 Int
    0
          then Either Text Int -> m (Either Text Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Int -> m (Either Text Int))
    -> Either Text Int -> m (Either Text Int)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Int
    forall a b. a -> Either a b
    Left Text
    "selected translation is void"
          else Bool -> Point -> m (Either Text Int)
    findNewEps Bool
    True Point
    shifted  -- @True@, because the goal is vague anyway

    posFromXhair :: (MonadClient m, MonadClientUI m)
                 => ActorId -> m (Either Text Point)
    posFromXhair :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m (Either Text Point)
    posFromXhair ActorId
    leader = do
      canAim <- ActorId -> m (Either Text Int)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (Either Text Int)
    xhairLegalEps ActorId
    leader
      case canAim of
        Right Int
    newEps -> do
          -- Modify @seps@, permanently.
          (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli -> StateClient
    cli {seps = newEps}
          mxhairPos <- m (Maybe Point)
    forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
    mxhairToPos
          case mxhairPos of
            Maybe Point
    Nothing -> String -> m (Either Text Point)
    forall a. HasCallStack => String -> a
    error (String -> m (Either Text Point))
    -> String -> m (Either Text Point)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> Maybe Point -> String
    forall v. Show v => String -> v -> String
    `showFailure` Maybe Point
    mxhairPos
            Just Point
    pos -> do
              munit <- ActorId -> Point -> m (Maybe ReqFailure)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (Maybe ReqFailure)
    projectCheck ActorId
    leader Point
    pos
              case munit of
                Maybe ReqFailure
    Nothing -> Either Text Point -> m (Either Text Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Point -> m (Either Text Point))
    -> Either Text Point -> m (Either Text Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Either Text Point
    forall a b. b -> Either a b
    Right Point
    pos
                Just ReqFailure
    reqFail -> Either Text Point -> m (Either Text Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Point -> m (Either Text Point))
    -> Either Text Point -> m (Either Text Point)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Point
    forall a b. a -> Either a b
    Left (Text -> Either Text Point) -> Text -> Either Text Point
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Text
    showReqFailure ReqFailure
    reqFail
        Left Text
    cause -> Either Text Point -> m (Either Text Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Point -> m (Either Text Point))
    -> Either Text Point -> m (Either Text Point)
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text Point
    forall a b. a -> Either a b
    Left Text
    cause

    -- | On top of `permittedProjectClient`, it also checks legality
    -- of aiming at the target and projection range. It also modifies @eps@.
    psuitReq :: (MonadClient m, MonadClientUI m)
             => ActorId
             -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    psuitReq :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    psuitReq ActorId
    leader = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      lidV <- viewedLevelUI
      if lidV /= blid b
      then return $ Left "can't fling on remote level"
      else do
        mpos <- posFromXhair leader
        p <- permittedProjectClient leader
        case mpos of
          Left Text
    err -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
     -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
    -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    forall a b. (a -> b) -> a -> b
    $ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    forall a b. a -> Either a b
    Left Text
    err
          Right Point
    pos -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
     -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
    -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    forall a b. (a -> b) -> a -> b
    $ (ItemFull -> Either ReqFailure (Point, Bool))
    -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    forall a b. b -> Either a b
    Right ((ItemFull -> Either ReqFailure (Point, Bool))
     -> Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
    -> (ItemFull -> Either ReqFailure (Point, Bool))
    -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
    forall a b. (a -> b) -> a -> b
    $ \ItemFull
    itemFull ->
            case ItemFull -> Either ReqFailure Bool
    p ItemFull
    itemFull of
              Left ReqFailure
    err -> ReqFailure -> Either ReqFailure (Point, Bool)
    forall a b. a -> Either a b
    Left ReqFailure
    err
              Right Bool
    False -> (Point, Bool) -> Either ReqFailure (Point, Bool)
    forall a b. b -> Either a b
    Right (Point
    pos, Bool
    False)
              Right Bool
    True ->
                let arItem :: AspectRecord
    arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
                in (Point, Bool) -> Either ReqFailure (Point, Bool)
    forall a b. b -> Either a b
    Right (Point
    pos, Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + AspectRecord -> ItemKind -> Int
    IA.totalRange AspectRecord
    arItem (ItemFull -> ItemKind
    itemKind ItemFull
    itemFull)
                               Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Point -> Point -> Int
    chessDist (Actor -> Point
    bpos Actor
    b) Point
    pos)

    -- $setup
    -- >>> import Game.LambdaHack.Definition.DefsInternal

    -- |
    -- >>> let trigger1 = HumanCmd.TriggerItem{tiverb="verb", tiobject="object", tisymbols=[toContentSymbol 'a', toContentSymbol 'b']}
    -- >>> let trigger2 = HumanCmd.TriggerItem{tiverb="verb2", tiobject="object2", tisymbols=[toContentSymbol 'c']}
    -- >>> triggerSymbols [trigger1, trigger2]
    -- "abc"
    --
    -- >>> triggerSymbols []
    -- ""
    triggerSymbols :: [HumanCmd.TriggerItem] -> [ContentSymbol IK.ItemKind]
    triggerSymbols :: [TriggerItem] -> String
    triggerSymbols [] = []
    triggerSymbols (HumanCmd.TriggerItem{String
    tisymbols :: String
    tisymbols :: TriggerItem -> String
    tisymbols} : [TriggerItem]
    ts) =
      String
    tisymbols String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [TriggerItem] -> String
    triggerSymbols [TriggerItem]
    ts

    -- * ChooseItemApply

    chooseItemApplyHuman :: forall m. MonadClientUI m
                         => ActorId -> [HumanCmd.TriggerItem] -> m MError
    chooseItemApplyHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> [TriggerItem] -> m MError
    chooseItemApplyHuman ActorId
    leader [TriggerItem]
    ts = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
      let overStash = Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
          storesBase = [CStore
    CStash, CStore
    CEqp, CStore
    COrgan]
          stores | Bool
    overStash = [CStore]
    storesBase [CStore] -> [CStore] -> [CStore]
    forall a. [a] -> [a] -> [a]
    ++ [CStore
    CGround]
                 | Bool
    otherwise = CStore
    CGround CStore -> [CStore] -> [CStore]
    forall a. a -> [a] -> [a]
    : [CStore]
    storesBase
          (verb1, object1) = case ts of
            [] -> (Part
    "trigger", Part
    "item")
            TriggerItem
    tr : [TriggerItem]
    _ -> (TriggerItem -> Part
    HumanCmd.tiverb TriggerItem
    tr, TriggerItem -> Part
    HumanCmd.tiobject TriggerItem
    tr)
          verb = [Part] -> Text
    makePhrase [Part
    verb1]
          triggerSyms = [TriggerItem] -> String
    triggerSymbols [TriggerItem]
    ts
          prompt = [Part] -> Text
    makePhrase [Part
    "What", Part
    object1, Part
    "to"]
          promptGeneric = Text
    "What to"
      itemSel <- getsSession sitemSel
      case itemSel of
        Just (ItemId
    _, CStore
    _, Bool
    True) -> MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
        Just (ItemId
    iid, CStore
    fromCStore, Bool
    False) -> do
          -- We don't validate vs @ts@ here, because player has selected
          -- this item, so he knows what he's doing (unless really absurd).
          itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
          bag <- getsState $ getBodyStoreBag b fromCStore
          mp <- permittedApplyClient leader
          case iid `EM.lookup` bag of
            Just ItemQuant
    kit | Bool -> Either ReqFailure Bool -> Bool
    forall b a. b -> Either a b -> b
    fromRight Bool
    False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
    mp (CStore -> Maybe CStore
    forall a. a -> Maybe a
    Just CStore
    fromCStore) ItemFull
    itemFull ItemQuant
    kit) ->
              MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
            Maybe ItemQuant
    _ -> do
              (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sitemSel = Nothing}
              ActorId -> [TriggerItem] -> m MError
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> [TriggerItem] -> m MError
    chooseItemApplyHuman ActorId
    leader [TriggerItem]
    ts
        Maybe (ItemId, CStore, Bool)
    Nothing -> do
          let psuit :: m Suitability
              psuit :: m Suitability
    psuit = do
                mp <- ActorId
    -> m (Maybe CStore
          -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> m (Maybe CStore
          -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
    permittedApplyClient ActorId
    leader
                return $ SuitsSomething $ \Maybe CStore
    cstore ItemFull
    itemFull ItemQuant
    kit ->
                  Bool -> Either ReqFailure Bool -> Bool
    forall b a. b -> Either a b -> b
    fromRight Bool
    False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
    mp Maybe CStore
    cstore ItemFull
    itemFull ItemQuant
    kit)
                  Bool -> Bool -> Bool
    && (String -> Bool
    forall a. [a] -> Bool
    null String
    triggerSyms
                      Bool -> Bool -> Bool
    || ItemKind -> Char
    IK.isymbol (ItemFull -> ItemKind
    itemKind ItemFull
    itemFull) Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    triggerSyms)
          ggi <- ActorId
    -> m Suitability
    -> Text
    -> Text
    -> Text
    -> Text
    -> [CStore]
    -> m (Either Text (CStore, ItemId))
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> m Suitability
    -> Text
    -> Text
    -> Text
    -> Text
    -> [CStore]
    -> m (Either Text (CStore, ItemId))
    getGroupItem ActorId
    leader m Suitability
    psuit Text
    prompt Text
    promptGeneric Text
    verb Text
    "trigger"
                              [CStore]
    stores
          case ggi of
            Right (CStore
    fromCStore, ItemId
    iid) -> do
              (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                SessionUI
    sess {sitemSel = Just (iid, fromCStore, False)}
              MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
            Left Text
    err -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    err

    permittedApplyClient :: MonadClientUI m
                         => ActorId
                         -> m (Maybe CStore -> ItemFull -> ItemQuant
                               -> Either ReqFailure Bool)
    permittedApplyClient :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> m (Maybe CStore
          -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
    permittedApplyClient ActorId
    leader = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      b <- getsState $ getActorBody leader
      let skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorCurAndMaxSk
          calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
      localTime <- getsState $ getLocalTime (blid b)
      return $ permittedApply corule localTime skill calmE

    -- * PickLeader

    pickLeaderHuman :: MonadClientUI m => Int -> m MError
    pickLeaderHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m MError
    pickLeaderHuman Int
    k = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      fact <- getsState $ (EM.! side) . sfactionD
      arena <- getArenaUI
      sactorUI <- getsSession sactorUI
      mhero <- getsState $ tryFindHeroK sactorUI side k
      allOurs <- getsState $ fidActorNotProjGlobalAssocs side -- not only on level
      let allOursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
    -> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ActorId
    aid, Actor
    b) -> (ActorId
    aid, Actor
    b, ActorDictUI
    sactorUI ActorDictUI -> ActorId -> ActorUI
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ActorId
    aid)) [(ActorId, Actor)]
    allOurs
          hs = ((ActorId, Actor, ActorUI)
     -> (Bool, Bool, Bool, Char, Color, ActorId))
    -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (ActorId, Actor, ActorUI)
    -> (Bool, Bool, Bool, Char, Color, ActorId)
    keySelected [(ActorId, Actor, ActorUI)]
    allOursUI
          mactor = case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall a. Int -> [a] -> [a]
    drop Int
    k [(ActorId, Actor, ActorUI)]
    hs of
                     [] -> Maybe (ActorId, Actor)
    forall a. Maybe a
    Nothing
                     (ActorId
    aid, Actor
    b, ActorUI
    _) : [(ActorId, Actor, ActorUI)]
    _ -> (ActorId, Actor) -> Maybe (ActorId, Actor)
    forall a. a -> Maybe a
    Just (ActorId
    aid, Actor
    b)
          mchoice = if FactionKind -> Bool
    FK.fhasGender (Faction -> FactionKind
    gkind Faction
    fact) then Maybe (ActorId, Actor)
    mhero else Maybe (ActorId, Actor)
    mactor
          banned = Faction -> Bool
    bannedPointmanSwitchBetweenLevels Faction
    fact
      case mchoice of
        Maybe (ActorId, Actor)
    Nothing -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "no such member of the party"
        Just (ActorId
    aid, Actor
    b)
          | Actor -> LevelId
    blid Actor
    b LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= LevelId
    arena Bool -> Bool -> Bool
    && Bool
    banned ->
              Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg (Text -> m MError) -> Text -> m MError
    forall a b. (a -> b) -> a -> b
    $ ReqFailure -> Text
    showReqFailure ReqFailure
    NoChangeDunLeader
          | Bool
    otherwise -> do
              m Bool -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m Bool -> m ()) -> m Bool -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> ActorId -> m Bool
    forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
    pickLeader Bool
    True ActorId
    aid
              MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing

    -- * PickLeaderWithPointer

    pickLeaderWithPointerHuman :: MonadClientUI m => ActorId -> m MError
    pickLeaderWithPointerHuman :: forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
    pickLeaderWithPointerHuman = ActorId -> m MError
    forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
    pickLeaderWithPointer

    -- * PointmanCycle

    -- | Switch current pointman to the next on the viewed level, if any, wrapping.
    pointmanCycleLevelHuman :: MonadClientUI m => ActorId -> Direction -> m MError
    pointmanCycleLevelHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Direction -> m MError
    pointmanCycleLevelHuman ActorId
    leader = ActorId -> Bool -> Direction -> m MError
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Direction -> m MError
    pointmanCycleLevel ActorId
    leader Bool
    True

    -- * PointmanBack

    -- | Switch current pointman to the previous in the whole dungeon, wrapping.
    pointmanCycleHuman :: MonadClientUI m => ActorId -> Direction -> m MError
    pointmanCycleHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Direction -> m MError
    pointmanCycleHuman ActorId
    leader = ActorId -> Bool -> Direction -> m MError
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Direction -> m MError
    pointmanCycle ActorId
    leader Bool
    True

    -- * SelectActor

    selectActorHuman :: MonadClientUI m => ActorId -> m ()
    selectActorHuman :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
    selectActorHuman ActorId
    leader = do
      bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession ((SessionUI -> ActorUI) -> m ActorUI)
    -> (SessionUI -> ActorUI) -> m ActorUI
    forall a b. (a -> b) -> a -> b
    $ ActorId -> SessionUI -> ActorUI
    getActorUI ActorId
    leader
      wasMemeber <- getsSession $ ES.member leader . sselected
      let upd = if Bool
    wasMemeber
                then ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.delete ActorId
    leader  -- already selected, deselect instead
                else ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.insert ActorId
    leader
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sselected = upd $ sselected sess}
      let subject = ActorUI -> Part
    partActor ActorUI
    bodyUI
      msgAdd MsgActionAlert $ makeSentence [subject, if wasMemeber
                                                     then "deselected"
                                                     else "selected"]

    -- * SelectNone

    selectNoneHuman :: MonadClientUI m => m ()
    selectNoneHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    selectNoneHuman = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      lidV <- viewedLevelUI
      oursIds <- getsState $ fidActorRegularIds side lidV
      let ours = [ActorId] -> EnumSet ActorId
    forall k. Enum k => [k] -> EnumSet k
    ES.fromDistinctAscList [ActorId]
    oursIds
      oldSel <- getsSession sselected
      let wasNone = EnumSet ActorId -> Bool
    forall k. EnumSet k -> Bool
    ES.null (EnumSet ActorId -> Bool) -> EnumSet ActorId -> Bool
    forall a b. (a -> b) -> a -> b
    $ EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.intersection EnumSet ActorId
    ours EnumSet ActorId
    oldSel
          upd = if Bool
    wasNone
                then EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.union  -- already all deselected; select all instead
                else EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.difference
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sselected = upd (sselected sess) ours}
      let subject = Part
    "all party members on the level"
      msgAdd MsgActionAlert $ makeSentence [subject, if wasNone
                                                     then "selected"
                                                     else "deselected"]

    -- * SelectWithPointer

    selectWithPointerHuman :: MonadClientUI m => m MError
    selectWithPointerHuman :: forall (m :: * -> *). MonadClientUI m => m MError
    selectWithPointerHuman = do
      COps{corule=RuleContent{rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lidV <- viewedLevelUI
      -- Not @ScreenContent@, because not drawing here.
      side <- getsClient sside
      ours <- getsState $ filter (not . bproj . snd)
                          . actorAssocs (== side) lidV
      sactorUI <- getsSession sactorUI
      let oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
    -> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ActorId
    aid, Actor
    b) -> (ActorId
    aid, Actor
    b, ActorDictUI
    sactorUI ActorDictUI -> ActorId -> ActorUI
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ActorId
    aid)) [(ActorId, Actor)]
    ours
          viewed = ((ActorId, Actor, ActorUI)
     -> (Bool, Bool, Bool, Char, Color, ActorId))
    -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (ActorId, Actor, ActorUI)
    -> (Bool, Bool, Bool, Char, Color, ActorId)
    keySelected [(ActorId, Actor, ActorUI)]
    oursUI
      pUI <- getsSession spointer
      let p@(Point px py) = squareToMap $ uiToSquare pUI
      -- Select even if no space in status line for the actor's symbol.
      if | py == rHeightMax + 1 && px == 0 -> selectNoneHuman >> return Nothing
         | py == rHeightMax + 1 ->
             case drop (px - 1) viewed of
               [] -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "not pointing at an actor"
               (ActorId
    aid, Actor
    _, ActorUI
    _) : [(ActorId, Actor, ActorUI)]
    _ -> ActorId -> m ()
    forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
    selectActorHuman ActorId
    aid m () -> m MError -> m MError
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing
         | otherwise ->
             case find (\(ActorId
    _, Actor
    b) -> Actor -> Point
    bpos Actor
    b Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    p) ours of
               Maybe (ActorId, Actor)
    Nothing -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "not pointing at an actor"
               Just (ActorId
    aid, Actor
    _) -> ActorId -> m ()
    forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
    selectActorHuman ActorId
    aid m () -> m MError -> m MError
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing

    -- * Repeat

    -- Note that walk followed by repeat should not be equivalent to run,
    -- because the player can really use a command that does not stop
    -- at terrain change or when walking over items.
    repeatHuman :: MonadClientUI m => Int -> m ()
    repeatHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
    repeatHuman Int
    n =
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
        let (KeyMacroFrame
    smacroFrameNew, [KeyMacroFrame]
    smacroStackMew) =
               Int
    -> KeyMacroFrame
    -> [KeyMacroFrame]
    -> (KeyMacroFrame, [KeyMacroFrame])
    repeatHumanTransition Int
    n (SessionUI -> KeyMacroFrame
    smacroFrame SessionUI
    sess) (SessionUI -> [KeyMacroFrame]
    smacroStack SessionUI
    sess)
        in SessionUI
    sess { smacroFrame = smacroFrameNew
                , smacroStack = smacroStackMew }

    repeatHumanTransition :: Int -> KeyMacroFrame -> [KeyMacroFrame]
                          -> (KeyMacroFrame, [KeyMacroFrame])
    repeatHumanTransition :: Int
    -> KeyMacroFrame
    -> [KeyMacroFrame]
    -> (KeyMacroFrame, [KeyMacroFrame])
    repeatHumanTransition Int
    n KeyMacroFrame
    macroFrame [KeyMacroFrame]
    macroFrames =
      let kms :: [KM]
    kms = [[KM]] -> [KM]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[KM]] -> [KM])
    -> (Either [KM] KeyMacro -> [[KM]]) -> Either [KM] KeyMacro -> [KM]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [KM] -> [[KM]]
    forall a. Int -> a -> [a]
    replicate Int
    n ([KM] -> [[KM]])
    -> (Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [[KM]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyMacro -> [KM]
    unKeyMacro (KeyMacro -> [KM])
    -> (Either [KM] KeyMacro -> KeyMacro)
    -> Either [KM] KeyMacro
    -> [KM]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeyMacro -> Either [KM] KeyMacro -> KeyMacro
    forall b a. b -> Either a b -> b
    fromRight KeyMacro
    forall a. Monoid a => a
    mempty
                (Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [KM]
    forall a b. (a -> b) -> a -> b
    $ KeyMacroFrame -> Either [KM] KeyMacro
    keyMacroBuffer KeyMacroFrame
    macroFrame
      in [KM]
    -> KeyMacroFrame
    -> [KeyMacroFrame]
    -> (KeyMacroFrame, [KeyMacroFrame])
    macroHumanTransition [KM]
    kms KeyMacroFrame
    macroFrame [KeyMacroFrame]
    macroFrames

    -- * RepeatLast

    -- Note that walk followed by repeat should not be equivalent to run,
    -- because the player can really use a command that does not stop
    -- at terrain change or when walking over items.
    repeatLastHuman :: MonadClientUI m => Int -> m ()
    repeatLastHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
    repeatLastHuman Int
    n = (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
      SessionUI
    sess {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }

    repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame
    repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame
    repeatLastHumanTransition Int
    n KeyMacroFrame
    macroFrame =
      let macro :: KeyMacro
    macro = [KM] -> KeyMacro
    KeyMacro ([KM] -> KeyMacro) -> (Maybe KM -> [KM]) -> Maybe KM -> KeyMacro
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[KM]] -> [KM]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[KM]] -> [KM]) -> (Maybe KM -> [[KM]]) -> Maybe KM -> [KM]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [KM] -> [[KM]]
    forall a. Int -> a -> [a]
    replicate Int
    n ([KM] -> [[KM]]) -> (Maybe KM -> [KM]) -> Maybe KM -> [[KM]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe KM -> [KM]
    forall a. Maybe a -> [a]
    maybeToList (Maybe KM -> KeyMacro) -> Maybe KM -> KeyMacro
    forall a b. (a -> b) -> a -> b
    $ KeyMacroFrame -> Maybe KM
    keyLast KeyMacroFrame
    macroFrame
      in KeyMacroFrame
    macroFrame { keyPending = macro <> keyPending macroFrame }

    -- * Record

    -- | Starts and stops recording of macros.
    recordHuman :: MonadClientUI m => m ()
    recordHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    recordHuman = do
      smacroFrameOld <- (SessionUI -> KeyMacroFrame) -> m KeyMacroFrame
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> KeyMacroFrame
    smacroFrame
      let (smacroFrameNew, msg) = recordHumanTransition smacroFrameOld
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {smacroFrame = smacroFrameNew}
      macroStack <- getsSession smacroStack
      unless (T.null msg || not (null macroStack)) $ msgAdd MsgPromptGeneric msg

    recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
    recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
    recordHumanTransition KeyMacroFrame
    macroFrame =
      let (Either [KM] KeyMacro
    buffer, Text
    msg) = case KeyMacroFrame -> Either [KM] KeyMacro
    keyMacroBuffer KeyMacroFrame
    macroFrame of
            Right KeyMacro
    _ ->
              -- Start recording in-game macro.
              ([KM] -> Either [KM] KeyMacro
    forall a b. a -> Either a b
    Left [], Text
    "Recording a macro. Stop recording with the same key.")
            Left [KM]
    xs ->
              -- Stop recording in-game macro.
              (KeyMacro -> Either [KM] KeyMacro
    forall a b. b -> Either a b
    Right (KeyMacro -> Either [KM] KeyMacro)
    -> ([KM] -> KeyMacro) -> [KM] -> Either [KM] KeyMacro
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [KM] -> KeyMacro
    KeyMacro ([KM] -> KeyMacro) -> ([KM] -> [KM]) -> [KM] -> KeyMacro
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [KM] -> [KM]
    forall a. [a] -> [a]
    reverse ([KM] -> Either [KM] KeyMacro) -> [KM] -> Either [KM] KeyMacro
    forall a b. (a -> b) -> a -> b
    $ [KM]
    xs, Text
    "Macro recording stopped.")
          smacroFrameNew :: KeyMacroFrame
    smacroFrameNew = KeyMacroFrame
    macroFrame {keyMacroBuffer = buffer}
      in (KeyMacroFrame
    smacroFrameNew, Text
    msg)

    -- * AllHistory

    allHistoryHuman :: forall m. MonadClientUI m => m ()
    allHistoryHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    allHistoryHuman = do
      CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      history <- getsSession shistory
      arena <- getArenaUI
      localTime <- getsState $ getLocalTime arena
      global <- getsState stime
      FontSetup{..} <- getFontSetup
      let renderedHistoryRaw = History -> [AttrString]
    renderHistory History
    history
          histLenRaw = [AttrString] -> Int
    forall a. [a] -> Int
    length [AttrString]
    renderedHistoryRaw
          placeholderLine = Color -> Text -> AttrString
    textFgToAS Color
    Color.BrBlack
            Text
    "Newest_messages_are_at_the_bottom._Press_END_to_get_there."
          placeholderCount =
            (- Int
    histLenRaw Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4)
          renderedHistory = Int -> AttrString -> [AttrString]
    forall a. Int -> a -> [a]
    replicate Int
    placeholderCount AttrString
    placeholderLine
                            [AttrString] -> [AttrString] -> [AttrString]
    forall a. [a] -> [a] -> [a]
    ++ [AttrString]
    renderedHistoryRaw
          histLen = Int
    placeholderCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    histLenRaw
          splitRow AttrString
    as =
            let (AttrString
    tLab, AttrString
    tDesc) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= AttrCharW32
    Color.spaceAttrW32) AttrString
    as
                labLen :: Int
    labLen = DisplayFont -> AttrString -> Int
    forall a. DisplayFont -> [a] -> Int
    textSize DisplayFont
    monoFont AttrString
    tLab
                par1 :: AttrLine
    par1 = case (AttrLine -> Bool) -> [AttrLine] -> [AttrLine]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (AttrLine -> AttrLine -> Bool
    forall a. Eq a => a -> a -> Bool
    /= AttrLine
    emptyAttrLine) ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ AttrString -> [AttrLine]
    linesAttr AttrString
    tDesc of
                  [] -> AttrLine
    emptyAttrLine
                  [AttrLine
    l] -> AttrLine
    l
                  [AttrLine]
    ls -> AttrString -> AttrLine
    attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ AttrString -> [AttrString] -> AttrString
    forall a. [a] -> [[a]] -> [a]
    intercalate [AttrCharW32
    Color.spaceAttrW32]
                                       ([AttrString] -> AttrString) -> [AttrString] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ (AttrLine -> AttrString) -> [AttrLine] -> [AttrString]
    forall a b. (a -> b) -> [a] -> [b]
    map AttrLine -> AttrString
    attrLine [AttrLine]
    ls
            in (AttrString -> AttrLine
    attrStringToAL AttrString
    tLab, (Int
    labLen, AttrLine
    par1))
          (tsLab, tsDesc) = unzip $ map splitRow renderedHistory
          ovs = (Overlay -> Overlay -> Overlay)
    -> DisplayFont
    -> Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++) DisplayFont
    monoFont ([AttrLine] -> Overlay
    offsetOverlay [AttrLine]
    tsLab)
                (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ [(Int, AttrLine)] -> Overlay
    offsetOverlayX [(Int, AttrLine)]
    tsDesc
          turnsGlobal = Time
    global Time -> Time -> Int
    `timeFitUp` Time
    timeTurn
          turnsLocal = Time
    localTime Time -> Time -> Int
    `timeFitUp` Time
    timeTurn
          msg = [Part] -> Text
    makeSentence
            [ Part
    "You survived for"
            , Int -> Part -> Part
    MU.CarWs Int
    turnsGlobal Part
    "half-second turn"
            , Part
    "(this level:"
            , Int -> Part
    MU.Car Int
    turnsLocal Part -> Part -> Part
    forall a. Semigroup a => a -> a -> a
    <> Part
    ")" ]
          kxs = [ (MenuSlot -> KeyOrSlot
    forall a b. b -> Either a b
    Right MenuSlot
    sn, ( Int -> Int -> PointUI
    PointUI Int
    0 (MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    sn)
                             , DisplayFont -> Int -> ButtonWidth
    ButtonWidth DisplayFont
    propFont Int
    1000 ))
                | MenuSlot
    sn <- Int -> [MenuSlot] -> [MenuSlot]
    forall a. Int -> [a] -> [a]
    take Int
    histLen [MenuSlot]
    natSlots ]
      msgAdd MsgPromptGeneric msg
      let keysAllHistory =
            KM
    K.returnKM
    #ifndef USE_JSFILE
            KM -> [KM] -> [KM]
    forall a. a -> [a] -> [a]
    : Char -> KM
    K.mkChar Char
    '.'
    #endif
            KM -> [KM] -> [KM]
    forall a. a -> [a] -> [a]
    : [KM
    K.spaceKM, KM
    K.escKM]
      slides <- overlayToSlideshow (rheight - 2) keysAllHistory (ovs, kxs)
      let historyLines = case [KYX] -> [KYX]
    forall a. [a] -> [a]
    reverse ([KYX] -> [KYX]) -> [KYX] -> [KYX]
    forall a b. (a -> b) -> a -> b
    $ (OKX -> [KYX]) -> [OKX] -> [KYX]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OKX -> [KYX]
    forall a b. (a, b) -> b
    snd ([OKX] -> [KYX]) -> [OKX] -> [KYX]
    forall a b. (a -> b) -> a -> b
    $ Slideshow -> [OKX]
    slideshow Slideshow
    slides of
            (Left{}, (PointUI, ButtonWidth)
    _) : [KYX]
    rest -> [KYX]
    rest  -- don't count the @--more--@ line
            [KYX]
    l -> [KYX]
    l
          maxIx = [KYX] -> Int
    forall a. [a] -> Int
    length [KYX]
    historyLines Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [KM] -> Int
    forall a. [a] -> Int
    length [KM]
    keysAllHistory
          menuName = String
    "history"
      modifySession $ \SessionUI
    sess ->
        SessionUI
    sess {smenuIxMap = M.insert menuName maxIx $ smenuIxMap sess}
      let displayAllHistory = do
            ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
    forall (m :: * -> *).
    MonadClientUI m =>
    String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
    displayChoiceScreen String
    menuName ColorMode
    ColorFull Bool
    False Slideshow
    slides
                                       [KM]
    keysAllHistory
            case ekm of
              Left KM
    km | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> KM
    K.mkChar Char
    '.' -> do
                let t :: Text
    t = [Text] -> Text
    T.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (AttrString -> Text) -> [AttrString] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Text
    T.pack (String -> Text) -> (AttrString -> String) -> AttrString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AttrCharW32 -> Char) -> AttrString -> String
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> Char
    Color.charFromW32)
                                        [AttrString]
    renderedHistoryRaw
                path <- Text -> String -> m String
    forall (m :: * -> *).
    MonadClientRead m =>
    Text -> String -> m String
    dumpTextFile Text
    t String
    "history.txt"
                msgAdd MsgPromptGeneric $ "All of history dumped to file" <+> T.pack path <> "."
              Left KM
    km | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.escKM ->
                MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Try to survive a few seconds more, if you can."
              Left KM
    km | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.spaceKM ->
                MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Steady on."
              Left KM
    km | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.returnKM ->
                MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Press RET when history message selected to see it in full."
              Right MenuSlot
    slot ->
                MenuSlot -> m ()
    displayOneReport (MenuSlot -> m ()) -> MenuSlot -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> MenuSlot
    forall a. Enum a => Int -> a
    toEnum (Int -> MenuSlot) -> Int -> MenuSlot
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    placeholderCount
              KeyOrSlot
    _ -> String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    ekm
          displayOneReport :: MenuSlot -> m ()
          displayOneReport MenuSlot
    slot0 = do
            let renderOneItem :: MenuSlot -> m OKX
    renderOneItem MenuSlot
    slot = do
                  let timeReport :: AttrString
    timeReport = case Int -> [AttrString] -> [AttrString]
    forall a. Int -> [a] -> [a]
    drop (MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot)
                                             [AttrString]
    renderedHistoryRaw of
                        [] -> String -> AttrString
    forall a. HasCallStack => String -> a
    error (String -> AttrString) -> String -> AttrString
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> MenuSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` MenuSlot
    slot
                        AttrString
    tR : [AttrString]
    _ -> AttrString
    tR
                      markParagraph :: AttrCharW32 -> AttrString
    markParagraph AttrCharW32
    c | AttrCharW32 -> Char
    Color.charFromW32 AttrCharW32
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' = [AttrCharW32
    c, AttrCharW32
    c]
                      markParagraph AttrCharW32
    c = [AttrCharW32
    c]
                      reportWithParagraphs :: AttrString
    reportWithParagraphs = (AttrCharW32 -> AttrString) -> AttrString -> AttrString
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AttrCharW32 -> AttrString
    markParagraph AttrString
    timeReport
                      (Overlay
    ovLab, Overlay
    ovDesc) =
                        DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
    labDescOverlay DisplayFont
    monoFont Int
    rwidth AttrString
    reportWithParagraphs
                      ov0 :: EnumMap DisplayFont Overlay
    ov0 = (Overlay -> Overlay -> Overlay)
    -> DisplayFont
    -> Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++) DisplayFont
    monoFont Overlay
    ovLab
                            (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont Overlay
    ovDesc
                      prompt :: Text
    prompt = [Part] -> Text
    makeSentence
                        [ Part
    "the", Int -> Part
    MU.Ordinal (Int -> Part) -> Int -> Part
    forall a b. (a -> b) -> a -> b
    $ MenuSlot -> Int
    forall a. Enum a => a -> Int
    fromEnum MenuSlot
    slot Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                        , Part
    "most recent record follows" ]
                  MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    prompt
                  OKX -> m OKX
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EnumMap DisplayFont Overlay
    ov0, [])
                extraKeys :: [a]
    extraKeys = []
                slotBound :: Int
    slotBound = Int
    histLenRaw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
            km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    forall (m :: * -> *).
    MonadClientUI m =>
    (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
    displayOneMenuItem MenuSlot -> m OKX
    renderOneItem [KM]
    forall a. [a]
    extraKeys Int
    slotBound MenuSlot
    slot0
            case K.key km of
              Key
    K.Space -> m ()
    displayAllHistory
              Key
    K.Esc -> MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric
                              Text
    "Try to learn from your previous mistakes."
              Key
    _ -> String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
      displayAllHistory

    -- * MarkVision

    markVisionHuman :: MonadClientUI m => Int -> m ()
    markVisionHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
    markVisionHuman Int
    delta = (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> SessionUI -> SessionUI
    cycleMarkVision Int
    delta

    -- * MarkSmell

    markSmellHuman :: MonadClientUI m => m ()
    markSmellHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    markSmellHuman = (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession SessionUI -> SessionUI
    toggleMarkSmell

    -- * MarkSuspect

    markSuspectHuman :: MonadClient m => Int -> m ()
    markSuspectHuman :: forall (m :: * -> *). MonadClient m => Int -> m ()
    markSuspectHuman Int
    delta = do
      -- @condBFS@ depends on the setting we change here.
      m ()
    forall (m :: * -> *). MonadClient m => m ()
    invalidateBfsAll
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient (Int -> StateClient -> StateClient
    cycleMarkSuspect Int
    delta)

    -- * MarkAnim

    markAnimHuman :: MonadClient m => m ()
    markAnimHuman :: forall (m :: * -> *). MonadClient m => m ()
    markAnimHuman = do
      noAnim <- (StateClient -> Bool) -> m Bool
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Bool) -> m Bool)
    -> (StateClient -> Bool) -> m Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False (Maybe Bool -> Bool)
    -> (StateClient -> Maybe Bool) -> StateClient -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClientOptions -> Maybe Bool
    snoAnim (ClientOptions -> Maybe Bool)
    -> (StateClient -> ClientOptions) -> StateClient -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> ClientOptions
    soptions
      modifyClient $ \StateClient
    cli ->
        StateClient
    cli {soptions = (soptions cli) {snoAnim = Just $ not noAnim}}

    -- * OverrideTut

    overrideTutHuman :: MonadClientUI m => Int -> m ()
    overrideTutHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
    overrideTutHuman Int
    delta = (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Int -> SessionUI -> SessionUI
    cycleOverrideTut Int
    delta

    -- * PrintScreen

    printScreenHuman :: MonadClientUI m => m ()
    printScreenHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    printScreenHuman = do
      MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgActionAlert Text
    "Screenshot printed."
      m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    printScreen

    -- * Cancel

    -- | End aiming mode, rejecting the current position, unless when on
    -- remote level, in which case, return to our level.
    cancelHuman :: MonadClientUI m => m ()
    cancelHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    cancelHuman = do
      maimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      case maimMode of
        Just AimMode
    aimMode -> do
          let lidV :: LevelId
    lidV = AimMode -> LevelId
    aimLevelId AimMode
    aimMode
          lidOur <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    getArenaUI
          if lidV == lidOur
          then clearAimMode
          else do
            xhairPos <- xhairToPos
            let sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidOur Point
    xhairPos
            modifySession $ \SessionUI
    sess ->
              SessionUI
    sess {saimMode = Just aimMode {aimLevelId = lidOur}}
            setXHairFromGUI sxhair
            doLook
        Maybe AimMode
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- * Accept

    -- | Accept the current crosshair position as target, ending
    -- aiming mode, if active.
    acceptHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
    acceptHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m ()
    acceptHuman ActorId
    leader = do
      ActorId -> m ()
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m ()
    endAiming ActorId
    leader
      ActorId -> m ()
    forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
    endAimingMsg ActorId
    leader
      m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    clearAimMode

    -- | End aiming mode, accepting the current position.
    endAiming :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
    endAiming :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m ()
    endAiming ActorId
    leader = do
      sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe Target
    sxhair
      modifyClient $ updateTarget leader $ const sxhair

    endAimingMsg :: MonadClientUI m => ActorId -> m ()
    endAimingMsg :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
    endAimingMsg ActorId
    leader = do
      subject <- ActorId -> m Part
    forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
    partActorLeader ActorId
    leader
      tgt <- getsClient $ getTarget leader
      (mtargetMsg, _) <- targetDesc tgt
      msgAdd MsgActionAlert $ case mtargetMsg of
        Maybe Text
    Nothing ->
          [Part] -> Text
    makeSentence [Part -> Part -> Part
    MU.SubjectVerbSg Part
    subject Part
    "clear target"]
        Just Text
    targetMsg ->
          [Part] -> Text
    makeSentence [Part -> Part -> Part
    MU.SubjectVerbSg Part
    subject Part
    "target", Text -> Part
    MU.Text Text
    targetMsg]

    -- * DetailCycle

    -- | Cycle detail level of aiming mode descriptions, starting up.
    detailCycleHuman :: MonadClientUI m => m ()
    detailCycleHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    detailCycleHuman = do
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        (\AimMode
    aimMode -> AimMode
    aimMode {detailLevel = detailCycle $ detailLevel aimMode})
                     <$> saimMode sess}
      m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    doLook

    detailCycle :: DetailLevel -> DetailLevel
    detailCycle :: DetailLevel -> DetailLevel
    detailCycle DetailLevel
    detail = if DetailLevel
    detail DetailLevel -> DetailLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == DetailLevel
    forall a. Bounded a => a
    minBound then DetailLevel
    forall a. Bounded a => a
    maxBound else DetailLevel -> DetailLevel
    forall a. Enum a => a -> a
    pred DetailLevel
    detail

    -- * ClearTargetIfItemClear

    clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m)
                                => ActorId -> m ()
    clearTargetIfItemClearHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m ()
    clearTargetIfItemClearHuman ActorId
    leader = do
      itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
    -> m (Maybe (ItemId, CStore, Bool))
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
    sitemSel
      when (isNothing itemSel) $ do
        setXHairFromGUI Nothing
        modifyClient $ updateTarget leader (const Nothing)
        doLook

    -- * ItemClear

    itemClearHuman :: MonadClientUI m => m ()
    itemClearHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    itemClearHuman = (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sitemSel = Nothing}

    -- * MoveXhair

    -- | Move the xhair. Assumes aiming mode.
    moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError
    moveXhairHuman :: forall (m :: * -> *). MonadClientUI m => Vector -> Int -> m MError
    moveXhairHuman Vector
    dir Int
    n = do
      -- Not @ScreenContent@, because not drawing here.
      COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      saimMode <- getsSession saimMode
      let lidV = LevelId -> (AimMode -> LevelId) -> Maybe AimMode -> LevelId
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> LevelId
    forall a. HasCallStack => String -> a
    error (String -> LevelId) -> String -> LevelId
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (Vector, Int) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Vector
    dir, Int
    n)) AimMode -> LevelId
    aimLevelId Maybe AimMode
    saimMode
      xhair <- getsSession sxhair
      xhairPos <- xhairToPos
      let shiftB Point
    pos = Int -> Int -> Point -> Vector -> Point
    shiftBounded Int
    rWidthMax Int
    rHeightMax Point
    pos Vector
    dir
          newPos = (Point -> Point) -> Point -> [Point]
    forall a. (a -> a) -> a -> [a]
    iterate Point -> Point
    shiftB Point
    xhairPos [Point] -> Int -> Point
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    n
      if newPos == xhairPos then failMsg "never mind"
      else do
        mleader <- getsClient sleader
        sxhair <- case (xhair, mleader) of
         (Just TVector{}, Just ActorId
    leader) -> do
           lpos <- (State -> Point) -> m Point
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
    forall a b. (a -> b) -> a -> b
    $ Actor -> Point
    bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActorId -> State -> Actor
    getActorBody ActorId
    leader
           return $ Just $ TVector $ newPos `vectorToFrom` lpos
         (Maybe Target, Maybe ActorId)
    _ -> Maybe Target -> m (Maybe Target)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Target -> m (Maybe Target))
    -> Maybe Target -> m (Maybe Target)
    forall a b. (a -> b) -> a -> b
    $ Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidV Point
    newPos
        setXHairFromGUI sxhair
        doLook
        return Nothing

    -- * AimTgt

    -- | Start aiming.
    aimTgtHuman :: MonadClientUI m => m ()
    aimTgtHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimTgtHuman = do
      -- (Re)start aiming at the current level.
      lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailLevel (SessionUI -> Maybe AimMode
    saimMode SessionUI
    sess)
        in Just $ AimMode lidV newDetail}
      doLook
      msgAdd MsgPromptAction "*flinging started; press again to project*"

    -- * AimFloor

    -- | Cycle aiming mode. Do not change position of the xhair,
    -- switch target to point at different things at that position.
    aimFloorHuman :: MonadClientUI m => m ()
    aimFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimFloorHuman = do
      lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
      mleader <- getsClient sleader
      mlpos <- case mleader of
        Maybe ActorId
    Nothing -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Point
    forall a. Maybe a
    Nothing
        Just ActorId
    leader -> (State -> Maybe Point) -> m (Maybe Point)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe Point) -> m (Maybe Point))
    -> (State -> Maybe Point) -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Maybe Point
    forall a. a -> Maybe a
    Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Point
    bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActorId -> State -> Actor
    getActorBody ActorId
    leader
      xhairPos <- xhairToPos
      xhair <- getsSession sxhair
      saimMode <- getsSession saimMode
      bsAll <- getsState $ actorAssocs (const True) lidV
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      let sxhair = case Maybe Target
    xhair of
            Maybe Target
    _ | Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe AimMode
    saimMode ->  -- first key press: keep target
              Maybe Target
    xhair
            Just TEnemy{} -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidV Point
    xhairPos
            Just TNonEnemy{} -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidV Point
    xhairPos
            Just TPoint{} | Just Point
    lpos <- Maybe Point
    mlpos, Point
    xhairPos Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Point
    lpos ->
              Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ Vector -> Target
    TVector (Vector -> Target) -> Vector -> Target
    forall a b. (a -> b) -> a -> b
    $ Point
    xhairPos Point -> Point -> Vector
    `vectorToFrom` Point
    lpos
            Just TVector{} ->
              -- If many actors, we pick here the first that would be picked
              -- by '*', so that all other projectiles on the tile come next,
              -- when pressing '*', without any intervening actors from other tiles.
              -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
              case ((ActorId, Actor) -> Bool)
    -> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\(ActorId
    _, Actor
    b) -> Actor -> Point
    bpos Actor
    b Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    xhairPos) [(ActorId, Actor)]
    bsAll of
                Just (ActorId
    aid, Actor
    b) -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ if FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    side Faction
    fact (Actor -> FactionId
    bfid Actor
    b)
                                        then ActorId -> Target
    TEnemy ActorId
    aid
                                        else ActorId -> Target
    TNonEnemy ActorId
    aid
                Maybe (ActorId, Actor)
    Nothing -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown LevelId
    lidV Point
    xhairPos
            Maybe Target
    _ -> Maybe Target
    xhair
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailLevel Maybe AimMode
    saimMode
        in Just $ AimMode lidV newDetail}
      setXHairFromGUI sxhair
      doLook

    -- * AimEnemy

    aimEnemyHuman :: MonadClientUI m => m ()
    aimEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimEnemyHuman = do
      lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
      mleader <- getsClient sleader
      mlpos <- case mleader of
        Maybe ActorId
    Nothing -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Point
    forall a. Maybe a
    Nothing
        Just ActorId
    leader -> (State -> Maybe Point) -> m (Maybe Point)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe Point) -> m (Maybe Point))
    -> (State -> Maybe Point) -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Maybe Point
    forall a. a -> Maybe a
    Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Point
    bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mxhairPos <- mxhairToPos
      xhair <- getsSession sxhair
      saimMode <- getsSession saimMode
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      bsAll <- getsState $ actorAssocs (const True) lidV
      let -- On the same position, big actors come before projectiles.
          ordPos Point
    lpos (a
    _, Actor
    b) = (Point -> Point -> Int
    chessDist Point
    lpos (Point -> Int) -> Point -> Int
    forall a b. (a -> b) -> a -> b
    $ Actor -> Point
    bpos Actor
    b, Actor -> Point
    bpos Actor
    b, Actor -> Bool
    bproj Actor
    b)
          dbs = case Maybe Point
    mlpos of
            Maybe Point
    Nothing -> [(ActorId, Actor)]
    bsAll
            Just Point
    lpos -> ((ActorId, Actor) -> (Int, Point, Bool))
    -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Point -> (ActorId, Actor) -> (Int, Point, Bool)
    forall {a}. Point -> (a, Actor) -> (Int, Point, Bool)
    ordPos Point
    lpos) [(ActorId, Actor)]
    bsAll
          pickUnderXhair =  -- switch to the actor under xhair, if any
            Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((Maybe Point -> Maybe Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Point
    mxhairPos) (Maybe Point -> Bool)
    -> ((ActorId, Actor) -> Maybe Point) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point -> Maybe Point
    forall a. a -> Maybe a
    Just (Point -> Maybe Point)
    -> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Maybe Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Point
    bpos (Actor -> Point)
    -> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> Actor
    forall a b. (a, b) -> b
    snd) [(ActorId, Actor)]
    dbs
          (pickEnemies, i) = case xhair of
            Just (TEnemy ActorId
    a) | Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode ->  -- pick next enemy
              (Bool
    True, Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId
    a) (ActorId -> Bool)
    -> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> ActorId
    forall a b. (a, b) -> a
    fst) [(ActorId, Actor)]
    dbs))
            Just (TEnemy ActorId
    a) ->  -- first key press, retarget old enemy
              (Bool
    True, Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId
    a) (ActorId -> Bool)
    -> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> ActorId
    forall a b. (a, b) -> a
    fst) [(ActorId, Actor)]
    dbs)
            Just (TNonEnemy ActorId
    a) | Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode ->  -- pick next non-enemy
              (Bool
    False, Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId
    a) (ActorId -> Bool)
    -> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> ActorId
    forall a b. (a, b) -> a
    fst) [(ActorId, Actor)]
    dbs))
            Just (TNonEnemy ActorId
    a) ->  -- first key press, retarget old non-enemy
              (Bool
    False, Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ActorId
    a) (ActorId -> Bool)
    -> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> ActorId
    forall a b. (a, b) -> a
    fst) [(ActorId, Actor)]
    dbs)
            Maybe Target
    _ -> (Bool
    True, Int
    pickUnderXhair)
          (lt, gt) = splitAt i dbs
          isEnemy Actor
    b = FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    side Faction
    fact (Actor -> FactionId
    bfid Actor
    b)
                      Bool -> Bool -> Bool
    && Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    b)
                      Bool -> Bool -> Bool
    && Actor -> Int64
    bhp Actor
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0
          cond = if Bool
    pickEnemies then Actor -> Bool
    isEnemy else Bool -> Bool
    not (Bool -> Bool) -> (Actor -> Bool) -> Actor -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Bool
    isEnemy
          lf = ((ActorId, Actor) -> Bool)
    -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Actor -> Bool
    cond (Actor -> Bool)
    -> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ActorId, Actor) -> Actor
    forall a b. (a, b) -> b
    snd) ([(ActorId, Actor)] -> [(ActorId, Actor)])
    -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a b. (a -> b) -> a -> b
    $ [(ActorId, Actor)]
    gt [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. [a] -> [a] -> [a]
    ++ [(ActorId, Actor)]
    lt
          sxhair = case [(ActorId, Actor)]
    lf of
            (ActorId
    a, Actor
    _) : [(ActorId, Actor)]
    _ -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ if Bool
    pickEnemies then ActorId -> Target
    TEnemy ActorId
    a else ActorId -> Target
    TNonEnemy ActorId
    a
            [] -> Maybe Target
    xhair  -- no seen foes in sight, stick to last target
      -- Register the chosen enemy, to pick another on next invocation.
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailLevel Maybe AimMode
    saimMode
        in Just $ AimMode lidV newDetail}
      setXHairFromGUI sxhair
      doLook

    -- * AimItem

    aimItemHuman :: MonadClientUI m => m ()
    aimItemHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimItemHuman = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      lidV <- viewedLevelUI
      mleader <- getsClient sleader
      mlpos <- case mleader of
        Maybe ActorId
    Nothing -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Point
    forall a. Maybe a
    Nothing
        Just ActorId
    leader -> (State -> Maybe Point) -> m (Maybe Point)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Maybe Point) -> m (Maybe Point))
    -> (State -> Maybe Point) -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Maybe Point
    forall a. a -> Maybe a
    Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Point
    bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mxhairPos <- mxhairToPos
      xhair <- getsSession sxhair
      saimMode <- getsSession saimMode
      Level{lfloor} <- getLevel lidV
      mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    side
      -- Don't consider own stash an ordinary pile of items.
      let lfloorBarStash = case Maybe (LevelId, Point)
    mstash of
            Just (LevelId
    lid, Point
    pos) | LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV -> Point -> ItemFloor -> ItemFloor
    forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
    EM.delete Point
    pos ItemFloor
    lfloor
            Maybe (LevelId, Point)
    _ -> ItemFloor
    lfloor
          bsAll = ItemFloor -> [Point]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys ItemFloor
    lfloorBarStash
          ordPos Point
    lpos Point
    p = (Point -> Point -> Int
    chessDist Point
    lpos Point
    p, Point
    p)
          dbs = case Maybe Point
    mlpos of
            Maybe Point
    Nothing -> [Point]
    bsAll
            Just Point
    lpos -> (Point -> (Int, Point)) -> [Point] -> [Point]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Point -> Point -> (Int, Point)
    ordPos Point
    lpos) [Point]
    bsAll
          pickUnderXhair =  -- switch to the item under xhair, if any
            let i :: Int
    i = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1)
                    (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Point -> Bool) -> [Point] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex ((Maybe Point -> Maybe Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Point
    mxhairPos) (Maybe Point -> Bool) -> (Point -> Maybe Point) -> Point -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point -> Maybe Point
    forall a. a -> Maybe a
    Just) [Point]
    dbs
            in Int -> [Point] -> ([Point], [Point])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    i [Point]
    dbs
          (lt, gt) = case xhair of
            Just (TPoint TGoal
    _ LevelId
    lid Point
    pos)
              | Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode Bool -> Bool -> Bool
    && LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV ->  -- pick next item
                let i :: Int
    i = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Point -> [Point] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Point
    pos [Point]
    dbs
                in Int -> [Point] -> ([Point], [Point])
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [Point]
    dbs
            Just (TPoint TGoal
    _ LevelId
    lid Point
    pos)
              | LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == LevelId
    lidV ->  -- first key press, retarget old item
                let i :: Int
    i = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (-Int
    1) (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Point -> [Point] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Point
    pos [Point]
    dbs
                in Int -> [Point] -> ([Point], [Point])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    i [Point]
    dbs
            Maybe Target
    _ -> ([Point], [Point])
    pickUnderXhair
          gtlt = [Point]
    gt [Point] -> [Point] -> [Point]
    forall a. [a] -> [a] -> [a]
    ++ [Point]
    lt
          sxhair = case [Point]
    gtlt of
            Point
    p : [Point]
    _ -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidV Point
    p  -- don't force AI to collect it
            [] -> Maybe Target
    xhair  -- no items remembered, stick to last target
      -- Register the chosen enemy, to pick another on next invocation.
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailLevel Maybe AimMode
    saimMode
        in Just $ AimMode lidV newDetail}
      setXHairFromGUI sxhair
      doLook

    -- * AimAscend

    -- | Change the displayed level in aiming mode to (at most)
    -- k levels shallower. Enters aiming mode, if not already in one.
    aimAscendHuman :: MonadClientUI m => Int -> m MError
    aimAscendHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m MError
    aimAscendHuman Int
    k = do
      dungeon <- (State -> Dungeon) -> m Dungeon
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> Dungeon
    sdungeon
      lidV <- viewedLevelUI
      let up = Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
      case ascendInBranch dungeon up lidV of
        [] -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "no more levels in this direction"
        LevelId
    _ : [LevelId]
    _ -> do
          let ascendOne :: LevelId -> LevelId
    ascendOne LevelId
    lid = case Dungeon -> Bool -> LevelId -> [LevelId]
    ascendInBranch Dungeon
    dungeon Bool
    up LevelId
    lid of
                [] -> LevelId
    lid
                LevelId
    nlid : [LevelId]
    _ -> LevelId
    nlid
              lidK :: LevelId
    lidK = (LevelId -> LevelId) -> LevelId -> [LevelId]
    forall a. (a -> a) -> a -> [a]
    iterate LevelId -> LevelId
    ascendOne LevelId
    lidV [LevelId] -> Int -> LevelId
    forall a. HasCallStack => [a] -> Int -> a
    !! Int -> Int
    forall a. Num a => a -> a
    abs Int
    k
          xhairPos <- m Point
    forall (m :: * -> *). MonadClientUI m => m Point
    xhairToPos
          let sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TKnown LevelId
    lidK Point
    xhairPos
          modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
            let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailLevel (SessionUI -> Maybe AimMode
    saimMode SessionUI
    sess)
            in Just $ AimMode lidK newDetail}
          setXHairFromGUI sxhair
          doLook
          return Nothing

    -- * EpsIncr

    -- | Tweak the @eps@ parameter of the aiming digital line.
    epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()
    epsIncrHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    Direction -> m ()
    epsIncrHuman Direction
    d = do
      -- Perform the change:
      let sepsDelta :: Int
    sepsDelta = case Direction
    d of
            Direction
    Forward -> Int
    1
            Direction
    Backward -> -Int
    1
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli -> StateClient
    cli {seps = seps cli + sepsDelta}
      m ()
    forall (m :: * -> *). MonadClient m => m ()
    invalidateBfsPathAll
      -- Provide UI feedback:
      -- Hack @sreportNull@ to display the new line even if no earlier messages.
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sreportNull = False}
      saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      lidV <- viewedLevelUI
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode =
        let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    DetailLow AimMode -> DetailLevel
    detailLevel Maybe AimMode
    saimMode
        in Just $ AimMode lidV newDetail}
      flashAiming
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode}
      -- The change may not affect the line shape, hence 'possibly'.
      msgAdd MsgPromptAction "Aiming line (possibly) modified."

    -- Flash the aiming line and path.
    flashAiming :: MonadClientUI m => m ()
    flashAiming :: forall (m :: * -> *). MonadClientUI m => m ()
    flashAiming = do
      lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
      animate lidV pushAndDelay

    -- * XhairUnknown

    xhairUnknownHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
    xhairUnknownHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m MError
    xhairUnknownHuman ActorId
    leader = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mpos <- closestUnknown leader
      case mpos of
        Maybe Point
    Nothing -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "no more unknown spots left"
        Just Point
    p -> do
          let sxhair :: Maybe Target
    sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown (Actor -> LevelId
    blid Actor
    b) Point
    p
          Maybe Target -> m ()
    forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
    setXHairFromGUI Maybe Target
    sxhair
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    doLook
          MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing

    -- * XhairItem

    xhairItemHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
    xhairItemHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m MError
    xhairItemHuman ActorId
    leader = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      items <- closestItems leader
      case items of
        [] -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg Text
    "no more reachable items remembered or visible"
        [(Int, (Point, EnumMap ItemId ItemQuant))]
    _ -> do
          let (Int
    _, (Point
    p, EnumMap ItemId ItemQuant
    bag)) = ((Int, (Point, EnumMap ItemId ItemQuant))
     -> (Int, (Point, EnumMap ItemId ItemQuant)) -> Ordering)
    -> [(Int, (Point, EnumMap ItemId ItemQuant))]
    -> (Int, (Point, EnumMap ItemId ItemQuant))
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    maximumBy (((Int, (Point, EnumMap ItemId ItemQuant)) -> Int)
    -> (Int, (Point, EnumMap ItemId ItemQuant))
    -> (Int, (Point, EnumMap ItemId ItemQuant))
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Int, (Point, EnumMap ItemId ItemQuant)) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, (Point, EnumMap ItemId ItemQuant))]
    items
              sxhair :: Maybe Target
    sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint (EnumMap ItemId ItemQuant -> TGoal
    TItem EnumMap ItemId ItemQuant
    bag) (Actor -> LevelId
    blid Actor
    b) Point
    p
          Maybe Target -> m ()
    forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
    setXHairFromGUI Maybe Target
    sxhair
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    doLook
          MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing

    -- * XhairStair

    xhairStairHuman :: (MonadClient m, MonadClientUI m)
                    => ActorId -> Bool -> m MError
    xhairStairHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> m MError
    xhairStairHuman ActorId
    leader Bool
    up = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      stairs <- closestTriggers (if up then ViaStairsUp else ViaStairsDown) leader
      case stairs of
        [] -> Text -> m MError
    forall (m :: * -> *). MonadClientUI m => Text -> m MError
    failMsg (Text -> m MError) -> Text -> m MError
    forall a b. (a -> b) -> a -> b
    $ Text
    "no reachable stairs" Text -> Text -> Text
    <+> if Bool
    up then Text
    "up" else Text
    "down"
        [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
    _ -> do
          let (Int
    _, (Point
    p, (Point
    p0, EnumMap ItemId ItemQuant
    bag))) = ((Int, (Point, (Point, EnumMap ItemId ItemQuant)))
     -> (Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Ordering)
    -> [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
    -> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    maximumBy (((Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Int)
    -> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
    -> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
    stairs
              sxhair :: Maybe Target
    sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint (EnumMap ItemId ItemQuant -> Point -> TGoal
    TEmbed EnumMap ItemId ItemQuant
    bag Point
    p0) (Actor -> LevelId
    blid Actor
    b) Point
    p
          Maybe Target -> m ()
    forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
    setXHairFromGUI Maybe Target
    sxhair
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    doLook
          MError -> m MError
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MError
    forall a. Maybe a
    Nothing

    -- * XhairPointerFloor

    xhairPointerFloorHuman :: MonadClientUI m => m ()
    xhairPointerFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    xhairPointerFloorHuman = do
      saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      aimPointerFloorHuman
      when (isNothing saimMode) $
        modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode}

    -- * XhairPointerMute

    xhairPointerMuteHuman :: MonadClientUI m => m ()
    xhairPointerMuteHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    xhairPointerMuteHuman = do
      saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      aimPointerFloorLoud False
      when (isNothing saimMode) $
        modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode}

    -- * XhairPointerEnemy

    xhairPointerEnemyHuman :: MonadClientUI m => m ()
    xhairPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    xhairPointerEnemyHuman = do
      saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      aimPointerEnemyHuman
      when (isNothing saimMode) $
        modifySession $ \SessionUI
    sess -> SessionUI
    sess {saimMode}

    -- * AimPointerFloor

    aimPointerFloorHuman :: MonadClientUI m => m ()
    aimPointerFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimPointerFloorHuman = Bool -> m ()
    forall (m :: * -> *). MonadClientUI m => Bool -> m ()
    aimPointerFloorLoud Bool
    True

    aimPointerFloorLoud :: MonadClientUI m => Bool -> m ()
    aimPointerFloorLoud :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
    aimPointerFloorLoud Bool
    loud = do
      COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lidV <- viewedLevelUI
      -- Not @ScreenContent@, because not drawing here.
      pUI <- getsSession spointer
      let p = PointSquare -> Point
    squareToMap (PointSquare -> Point) -> PointSquare -> Point
    forall a b. (a -> b) -> a -> b
    $ PointUI -> PointSquare
    uiToSquare PointUI
    pUI
      if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
      then do
        oldXhair <- getsSession sxhair
        let sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown LevelId
    lidV Point
    p
            sxhairMoused = Maybe Target
    sxhair Maybe Target -> Maybe Target -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Target
    oldXhair
            detailSucc = if Bool
    sxhairMoused
                         then AimMode -> DetailLevel
    detailLevel
                         else DetailLevel -> DetailLevel
    detailCycle (DetailLevel -> DetailLevel)
    -> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AimMode -> DetailLevel
    detailLevel
        modifySession $ \SessionUI
    sess ->
          SessionUI
    sess { saimMode =
                   let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailSucc
                                         (SessionUI -> Maybe AimMode
    saimMode SessionUI
    sess)
                   in Just $ AimMode lidV newDetail
               , sxhairMoused }
        setXHairFromGUI sxhair
        when loud doLook
      else stopPlayBack

    -- * AimPointerEnemy

    aimPointerEnemyHuman :: MonadClientUI m => m ()
    aimPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
    aimPointerEnemyHuman = do
      COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lidV <- viewedLevelUI
      -- Not @ScreenContent@, because not drawing here.
      pUI <- getsSession spointer
      let p = PointSquare -> Point
    squareToMap (PointSquare -> Point) -> PointSquare -> Point
    forall a b. (a -> b) -> a -> b
    $ PointUI -> PointSquare
    uiToSquare PointUI
    pUI
      if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
      then do
        bsAll <- getsState $ actorAssocs (const True) lidV
        oldXhair <- getsSession sxhair
        side <- getsClient sside
        fact <- getsState $ (EM.! side) . sfactionD
        let sxhair =
              -- If many actors, we pick here the first that would be picked
              -- by '*', so that all other projectiles on the tile come next,
              -- when pressing '*', without any intervening actors from other tiles.
              -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
              case ((ActorId, Actor) -> Bool)
    -> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\(ActorId
    _, Actor
    b) -> Actor -> Point
    bpos Actor
    b Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    p) [(ActorId, Actor)]
    bsAll of
                Just (ActorId
    aid, Actor
    b) -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ if FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    side Faction
    fact (Actor -> FactionId
    bfid Actor
    b)
                                        then ActorId -> Target
    TEnemy ActorId
    aid
                                        else ActorId -> Target
    TNonEnemy ActorId
    aid
                Maybe (ActorId, Actor)
    Nothing -> Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown LevelId
    lidV Point
    p
            sxhairMoused = Maybe Target
    sxhair Maybe Target -> Maybe Target -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Target
    oldXhair
            detailSucc = if Bool
    sxhairMoused
                         then AimMode -> DetailLevel
    detailLevel
                         else DetailLevel -> DetailLevel
    detailCycle (DetailLevel -> DetailLevel)
    -> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AimMode -> DetailLevel
    detailLevel
        modifySession $ \SessionUI
    sess ->
          SessionUI
    sess { saimMode =
                   let newDetail = DetailLevel
    -> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DetailLevel
    defaultDetailLevel AimMode -> DetailLevel
    detailSucc
                                         (SessionUI -> Maybe AimMode
    saimMode SessionUI
    sess)
                   in Just $ AimMode lidV newDetail
               , sxhairMoused }
        setXHairFromGUI sxhair
        doLook
      else stopPlayBack