content: -- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"
  -- client commands that return server requests.
  -- A couple of them do not take time, the rest does.
  -- Here prompts and menus are displayed, but any feedback resulting
  -- from the commands (e.g., from inventory manipulation) is generated later on,
  -- by the server, for all clients that witness the results of the commands.
  module Game.LambdaHack.Client.UI.HandleHumanGlobalM
    ( -- * Meta commands
      byAreaHuman, byAimModeHuman
    , composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman
    , loopOnNothingHuman, executeIfClearHuman
      -- * Global commands that usually take time
    , waitHuman, waitHuman10, yellHuman, moveRunHuman
    , runOnceAheadHuman, moveOnceToXhairHuman
    , runOnceToXhairHuman, continueToXhairHuman
    , moveItemHuman, projectHuman, applyHuman
    , alterDirHuman, alterWithPointerHuman, closeDirHuman
    , helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman
    , mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman
    , settingsMenuHuman, challengeMenuHuman, gameDifficultyIncr
    , gameFishToggle, gameGoodsToggle, gameWolfToggle, gameKeeperToggle
    , gameScenarioIncr
      -- * Global commands that never take time
    , gameExitWithHuman, ExitStrategy(..), gameDropHuman, gameExitHuman
    , gameSaveHuman, doctrineHuman, automateHuman, automateToggleHuman
    , automateBackHuman
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, alterCommon
    , goToXhair, goToXhairExplorationMode, goToXhairGoTo
    , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems
    , projectItem, applyItem, alterTileAtPos, verifyAlters, processTileActions
    , verifyEscape, verifyToolEffect, closeTileAtPos, msgAddDone, pickPoint
    , generateMenu
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import qualified Data.Char as Char
  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           Data.Version
  import qualified NLP.Miniutter.English as MU
  
  import           Game.LambdaHack.Client.Bfs
  import           Game.LambdaHack.Client.BfsM
  import           Game.LambdaHack.Client.CommonM
  import           Game.LambdaHack.Client.MonadClient
  import           Game.LambdaHack.Client.Request
  import           Game.LambdaHack.Client.State
  import           Game.LambdaHack.Client.UI.ActorUI
  import           Game.LambdaHack.Client.UI.Content.Input
  import           Game.LambdaHack.Client.UI.Content.Screen
  import           Game.LambdaHack.Client.UI.ContentClientUI
  import           Game.LambdaHack.Client.UI.Frame
  import           Game.LambdaHack.Client.UI.FrameM
  import           Game.LambdaHack.Client.UI.HandleHelperM
  import           Game.LambdaHack.Client.UI.HandleHumanLocalM
  import           Game.LambdaHack.Client.UI.HumanCmd
  import           Game.LambdaHack.Client.UI.InventoryM
  import           Game.LambdaHack.Client.UI.ItemDescription
  import qualified Game.LambdaHack.Client.UI.Key as K
  import           Game.LambdaHack.Client.UI.KeyBindings
  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.RunM
  import           Game.LambdaHack.Client.UI.SessionUI
  import           Game.LambdaHack.Client.UI.Slideshow
  import           Game.LambdaHack.Client.UI.SlideshowM
  import           Game.LambdaHack.Client.UI.UIOptions
  import           Game.LambdaHack.Common.Actor
  import           Game.LambdaHack.Common.ActorState
  import           Game.LambdaHack.Common.Area
  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.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.Content.TileKind as TK
  import qualified Game.LambdaHack.Core.Dice as Dice
  import           Game.LambdaHack.Core.Random
  import qualified Game.LambdaHack.Definition.Ability as Ability
  import qualified Game.LambdaHack.Definition.Color as Color
  import           Game.LambdaHack.Definition.Defs
  import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal
  
  -- * ByArea
  
  -- | Pick command depending on area the mouse pointer is in.
  -- The first matching area is chosen. If none match, only interrupt.
  byAreaHuman :: MonadClientUI m
              => (K.KM -> HumanCmd -> m (Either MError ReqUI))
              -> [(CmdArea, HumanCmd)]
              -> m (Either MError ReqUI)
  byAreaHuman cmdSemInCxtOfKM l = do
    CCUI{coinput=InputContent{brevMap}} <- getsSession sccui
    pUI <- getsSession spointer
    let PointSquare px py = uiToSquare pUI
        p = Point {..}  -- abuse of convention: @Point@, not @PointSquare@ used
                        -- for the whole UI screen in square font coordinates
        pointerInArea a = do
          rs <- areaToRectangles a
          return $! any (`inside` p) $ catMaybes rs
    cmds <- filterM (pointerInArea . fst) l
    case cmds of
      [] -> do
        stopPlayBack
        return $ Left Nothing
      (_, cmd) : _ -> do
        let kmFound = case M.lookup cmd brevMap of
              Just (km : _) -> km
              _ -> K.escKM
        cmdSemInCxtOfKM kmFound cmd
  
  -- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM".
  areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]
  areaToRectangles ca = map toArea <$> do
   CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui
   case ca of
    CaMessage -> return [(0, 0, rwidth - 1, 0)]
    CaMapLeader -> do  -- takes preference over @CaMapParty@ and @CaMap@
      mleader <- getsClient sleader
      case mleader of
        Nothing -> return []
        Just leader -> do
          b <- getsState $ getActorBody leader
          let PointSquare x y = mapToSquare $ bpos b
          return [(x, y, x, y)]
    CaMapParty -> do  -- takes preference over @CaMap@
      lidV <- viewedLevelUI
      side <- getsClient sside
      ours <- getsState $ filter (not . bproj) . map snd
                          . actorAssocs (== side) lidV
      let rectFromB p = let PointSquare x y = mapToSquare p
                        in (x, y, x, y)
      return $! map (rectFromB . bpos) ours
    CaMap ->
      let PointSquare xo yo = mapToSquare originPoint
          PointSquare xe ye = mapToSquare $ Point (rwidth - 1) (rheight - 4)
      in return [(xo, yo, xe, ye)]
    CaLevelNumber -> let y = rheight - 2
                     in return [(0, y, 1, y)]
    CaArenaName -> let y = rheight - 2
                       x = (rwidth - 1) `div` 2 - 11
                   in return [(3, y, x, y)]
    CaPercentSeen -> let y = rheight - 2
                         x = (rwidth - 1) `div` 2
                     in return [(x - 9, y, x, y)]
    CaXhairDesc -> let y = rheight - 2
                       x = (rwidth - 1) `div` 2 + 2
                   in return [(x, y, rwidth - 1, y)]
    CaSelected -> let y = rheight - 1
                      x = (rwidth - 1) `div` 2
                  in return [(0, y, x - 24, y)]
    CaCalmGauge -> let y = rheight - 1
                       x = (rwidth - 1) `div` 2
                   in return [(x - 22, y, x - 18, y)]
    CaCalmValue -> let y = rheight - 1
                       x = (rwidth - 1) `div` 2
                   in return [(x - 17, y, x - 11, y)]
    CaHPGauge -> let y = rheight - 1
                     x = (rwidth - 1) `div` 2
                 in return [(x - 9, y, x - 6, y)]
    CaHPValue -> let y = rheight - 1
                     x = (rwidth - 1) `div` 2
                 in return [(x - 6, y, x, y)]
    CaLeaderDesc -> let y = rheight - 1
                        x = (rwidth - 1) `div` 2 + 2
                    in return [(x, y, rwidth - 1, y)]
  
  -- * ByAimMode
  
  byAimModeHuman :: MonadClientUI m
                 => m (Either MError ReqUI) -> m (Either MError ReqUI)
                 -> m (Either MError ReqUI)
  byAimModeHuman cmdNotAimingM cmdAimingM = do
    aimMode <- getsSession saimMode
    if isNothing aimMode then cmdNotAimingM else cmdAimingM
  
  -- * ComposeIfLocal
  
  composeIfLocalHuman :: MonadClientUI m
                      => m (Either MError ReqUI) -> m (Either MError ReqUI)
                      -> m (Either MError ReqUI)
  composeIfLocalHuman c1 c2 = do
    slideOrCmd1 <- c1
    case slideOrCmd1 of
      Left merr1 -> do
        slideOrCmd2 <- c2
        case slideOrCmd2 of
          Left merr2 -> return $ Left $ mergeMError merr1 merr2
          _ -> return slideOrCmd2
      _ -> return slideOrCmd1
  
  -- * ComposeUnlessError
  
  composeUnlessErrorHuman :: MonadClientUI m
                          => m (Either MError ReqUI) -> m (Either MError ReqUI)
                          -> m (Either MError ReqUI)
  composeUnlessErrorHuman c1 c2 = do
    slideOrCmd1 <- c1
    case slideOrCmd1 of
      Left Nothing -> c2
      _ -> return slideOrCmd1
  
  -- * Compose2ndLocal
  
  compose2ndLocalHuman :: MonadClientUI m
                       => m (Either MError ReqUI) -> m (Either MError ReqUI)
                       -> m (Either MError ReqUI)
  compose2ndLocalHuman c1 c2 = do
    slideOrCmd1 <- c1
    case slideOrCmd1 of
      Left merr1 -> do
        slideOrCmd2 <- c2
        case slideOrCmd2 of
          Left merr2 -> return $ Left $ mergeMError merr1 merr2
          _ -> return slideOrCmd1  -- ignore second request, keep effect
      req -> do
        void c2  -- ignore second request, keep effect
        return req
  
  -- * LoopOnNothing
  
  loopOnNothingHuman :: MonadClientUI m
                     => m (Either MError ReqUI)
                     -> m (Either MError ReqUI)
  loopOnNothingHuman cmd = do
    res <- cmd
    case res of
      Left Nothing -> loopOnNothingHuman cmd
      _ -> return res
  
  -- * ExecuteIfClear
  
  executeIfClearHuman :: MonadClientUI m
                      => m (Either MError ReqUI)
                      -> m (Either MError ReqUI)
  executeIfClearHuman c1 = do
    sreportNull <- getsSession sreportNull
    sreqDelay <- getsSession sreqDelay
    -- When server query delay is handled, don't complicate things by clearing
    -- screen instead of running the command.
    if sreportNull || sreqDelay == ReqDelayHandled
    then c1
    else return $ Left Nothing
  
  -- * Wait
  
  -- | Leader waits a turn (and blocks, etc.).
  waitHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
  waitHuman leader = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if Ability.getSk Ability.SkWait actorCurAndMaxSk > 0 then do
      modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}
      return $ Right ReqWait
    else failSer WaitUnskilled
  
  -- * Wait10
  
  -- | Leader waits a 1/10th of a turn (and doesn't block, etc.).
  waitHuman10 :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
  waitHuman10 leader = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if Ability.getSk Ability.SkWait actorCurAndMaxSk >= 4 then do
      modifySession $ \sess -> sess {swaitTimes = abs (swaitTimes sess) + 1}
      return $ Right ReqWait10
    else failSer WaitUnskilled
  
  -- * Yell
  
  -- | Leader yells or yawns, if sleeping.
  yellHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
  yellHuman leader = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if Ability.getSk Ability.SkWait actorCurAndMaxSk > 0
       -- If waiting drained and really, potentially, no other possible action,
       -- still allow yelling.
       || Ability.getSk Ability.SkMove actorCurAndMaxSk <= 0
       || Ability.getSk Ability.SkDisplace actorCurAndMaxSk <= 0
       || Ability.getSk Ability.SkMelee actorCurAndMaxSk <= 0
    then return $ Right ReqYell
    else failSer WaitUnskilled
  
  -- * MoveDir and RunDir
  
  moveRunHuman :: (MonadClient m, MonadClientUI m)
               => ActorId -> Bool -> Bool -> Bool -> Bool -> Vector
               -> m (FailOrCmd RequestTimed)
  moveRunHuman leader initialStep finalGoal run runAhead dir = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    arena <- getArenaUI
    sb <- getsState $ getActorBody leader
    fact <- getsState $ (EM.! bfid sb) . sfactionD
    -- Start running in the given direction. The first turn of running
    -- succeeds much more often than subsequent turns, because we ignore
    -- most of the disturbances, since the player is mostly aware of them
    -- and still explicitly requests a run, knowing how it behaves.
    sel <- getsSession sselected
    let runMembers = if runAhead || noRunWithMulti fact
                     then [leader]
                     else ES.elems (ES.delete leader sel) ++ [leader]
        runParams = RunParams { runLeader = leader
                              , runMembers
                              , runInitial = True
                              , runStopMsg = Nothing
                              , runWaiting = 0 }
        initRunning = when (initialStep && run) $ do
          modifySession $ \sess ->
            sess {srunning = Just runParams}
          when runAhead $ macroHuman macroRun25
    -- When running, the invisible actor is hit (not displaced!),
    -- so that running in the presence of roving invisible
    -- actors is equivalent to moving (with visible actors
    -- this is not a problem, since runnning stops early enough).
    let tpos = bpos sb `shift` dir
    -- We start by checking actors at the target position,
    -- which gives a partial information (actors can be invisible),
    -- as opposed to accessibility (and items) which are always accurate
    -- (tiles can't be invisible).
    tgts <- getsState $ posToAidAssocs tpos arena
    case tgts of
      [] -> do  -- move or search or alter
        runStopOrCmd <- moveSearchAlter leader run dir
        case runStopOrCmd of
          Left stopMsg -> return $ Left stopMsg
          Right runCmd -> do
            -- Don't check @initialStep@ and @finalGoal@
            -- and don't stop going to target: door opening is mundane enough.
            initRunning
            return $ Right runCmd
      [(target, _)] | run
                      && initialStep
                      && Ability.getSk Ability.SkDisplace actorCurAndMaxSk > 0 ->
        -- No @stopPlayBack@: initial displace is benign enough.
        -- Displacing requires accessibility, but it's checked later on.
        displaceAid leader target
      _ : _ : _ | run
                  && initialStep
                  && Ability.getSk Ability.SkDisplace actorCurAndMaxSk > 0 ->
        failSer DisplaceMultiple
      (target, tb) : _ | not run
                         && initialStep && finalGoal
                         && bfid tb == bfid sb && not (bproj tb) -> do
        stopPlayBack  -- don't ever auto-repeat leader choice
        -- We always see actors from our own faction.
        -- Select one of adjacent actors by bumping into him. Takes no time.
        success <- pickLeader True target
        let !_A = assert (success `blame` "bump self"
                                  `swith` (leader, target, tb)) ()
        failWith "the pointman switched by bumping"
      (target, tb) : _ | not run
                         && initialStep && finalGoal
                         && (bfid tb /= bfid sb || bproj tb) -> do
        stopPlayBack  -- don't ever auto-repeat melee
        if Ability.getSk Ability.SkMelee actorCurAndMaxSk > 0
        then -- No problem if there are many projectiles at the spot. We just
             -- attack the first one.
             meleeAid leader target
        else failSer MeleeUnskilled
      _ : _ -> failWith "actor in the way"
  
  -- | Actor attacks an enemy actor or his own projectile.
  meleeAid :: (MonadClient m, MonadClientUI m)
           => ActorId -> ActorId -> m (FailOrCmd RequestTimed)
  meleeAid leader target = do
    side <- getsClient sside
    tb <- getsState $ getActorBody target
    sfact <- getsState $ (EM.! side) . sfactionD
    mel <- pickWeaponClient leader target
    case mel of
      Nothing -> failWith "nothing to melee with"
      Just wp -> do
        let returnCmd = do
              -- Set personal target to enemy, so that AI, if it takes over
              -- the actor, is likely to continue the fight even if the foe flees.
              modifyClient $ updateTarget leader $ const $ Just $ TEnemy target
              -- Also set xhair to see the foe's HP, because it's automatically
              -- set to any new spotted actor, so it needs to be reset
              -- and also it's not useful as permanent ranged target anyway.
              modifySession $ \sess -> sess {sxhair = Just $ TEnemy target}
              return $ Right wp
            res | bproj tb || isFoe side sfact (bfid tb) = returnCmd
                | isFriend side sfact (bfid tb) = do
                  let !_A = assert (side /= bfid tb) ()
                  go1 <- displayYesNo ColorBW
                           "You are bound by an alliance. Really attack?"
                  if not go1 then failWith "attack canceled" else returnCmd
                | otherwise = do
                  go2 <- displayYesNo ColorBW
                           "This attack will start a war. Are you sure?"
                  if not go2 then failWith "attack canceled" else returnCmd
        res
    -- Seeing the actor prevents altering a tile under it, but that
    -- does not limit the player, he just doesn't waste a turn
    -- on a failed altering.
  
  -- | Actor swaps position with another.
  displaceAid :: MonadClientUI m
              => ActorId -> ActorId -> m (FailOrCmd RequestTimed)
  displaceAid leader target = do
    COps{coTileSpeedup} <- getsState scops
    sb <- getsState $ getActorBody leader
    tb <- getsState $ getActorBody target
    tfact <- getsState $ (EM.! bfid tb) . sfactionD
    actorMaxSk <- getsState $ getActorMaxSkills target
    dEnemy <- getsState $ dispEnemy leader target actorMaxSk
    let immobile = Ability.getSk Ability.SkMove actorMaxSk <= 0
        tpos = bpos tb
        adj = checkAdjacent sb tb
        atWar = isFoe (bfid tb) tfact (bfid sb)
    if | not adj -> failSer DisplaceDistant
       | not (bproj tb) && atWar
         && actorDying tb ->  -- checked separately for a better message
         failSer DisplaceDying
       | not (bproj tb) && atWar
         && actorWaits tb ->  -- checked separately for a better message
         failSer DisplaceBraced
       | not (bproj tb) && atWar
         && immobile ->  -- checked separately for a better message
         failSer DisplaceImmobile
       | not dEnemy && atWar ->
         failSer DisplaceSupported
       | otherwise -> do
         let lid = blid sb
         lvl <- getLevel lid
         -- Displacing requires full access.
         if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then
           case posToAidsLvl tpos lvl of
             [] -> error $ "" `showFailure` (leader, sb, target, tb)
             [_] -> return $ Right $ ReqDisplace target
             _ -> failSer DisplaceMultiple
         else failSer DisplaceAccess
  
  -- | Leader moves or searches or alters. No visible actor at the position.
  moveSearchAlter :: MonadClientUI m
                  => ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
  moveSearchAlter leader run dir = do
    COps{coTileSpeedup} <- getsState scops
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    sb <- getsState $ getActorBody leader
    let moveSkill = Ability.getSk Ability.SkMove actorCurAndMaxSk
        spos = bpos sb           -- source position
        tpos = spos `shift` dir  -- target position
    alterable <- getsState $ tileAlterable (blid sb) tpos
    lvl <- getLevel $ blid sb
    let t = lvl `at` tpos
    runStopOrCmd <-
      if Tile.isWalkable coTileSpeedup t then  -- Movement requires full access.
        if | moveSkill > 0 ->
               -- A potential invisible actor is hit. War started without asking.
               return $ Right $ ReqMove dir
           | bwatch sb == WSleep -> failSer MoveUnskilledAsleep
           | otherwise -> failSer MoveUnskilled
      else do  -- Not walkable, so search and/or alter the tile.
        let sxhair = Just $ TPoint TUnknown (blid sb) tpos
        -- Point xhair to see details with `~`.
        setXHairFromGUI sxhair
        if run then do
          -- Explicit request to examine the terrain.
          blurb <- lookAtPosition tpos (blid sb)
          mapM_ (uncurry msgAdd) blurb
          failWith $ "the terrain is" <+>
            if | Tile.isModifiable coTileSpeedup t -> "potentially modifiable"
               | alterable -> "potentially triggerable"
               | otherwise -> "completely inert"
        else alterCommon leader True tpos
    return $! runStopOrCmd
  
  alterCommon :: MonadClientUI m
              => ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
  alterCommon leader bumping tpos = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    cops@COps{cotile, coTileSpeedup} <- getsState scops
    side <- getsClient sside
    factionD <- getsState sfactionD
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    sb <- getsState $ getActorBody leader
    let alterSkill = Ability.getSk Ability.SkAlter actorCurAndMaxSk
        spos = bpos sb
    alterable <- getsState $ tileAlterable (blid sb) tpos
    lvl <- getLevel $ blid sb
    localTime <- getsState $ getLocalTime (blid sb)
    embeds <- getsState $ getEmbedBag (blid sb) tpos
    itemToF <- getsState $ flip itemToFull
    getKind <- getsState $ flip getIidKind
    let t = lvl `at` tpos
        underFeet = tpos == spos  -- if enter and alter, be more permissive
        modificationFailureHint = msgAdd MsgTutorialHint "Some doors can be opened, stairs unbarred, treasures recovered, only if you find tools that increase your terrain modification ability and act as keys to the puzzle. To gather clues about the keys, listen to what's around you, examine items, inspect terrain, trigger, bump and harass. Once you uncover a likely tool, wield it, return and try to break through again."
    if | not alterable -> do
           let name = MU.Text $ TK.tname $ okind cotile t
               itemLook (iid, kit@(k, _)) =
                 let itemFull = itemToF iid
                 in partItemWsShort rwidth side factionD k localTime itemFull kit
               embedKindList =
                 map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)
               ilooks = map itemLook $ sortEmbeds cops t embedKindList
           failWith $ makePhrase $
             ["there is no way to activate or modify", MU.AW name]
             ++ if EM.null embeds
                then []
                else ["with", MU.WWandW ilooks]
             -- misclick? related to AlterNothing but no searching possible;
             -- this also rules out activating embeds that only cause
             -- raw damage, with no chance of altering the tile
       | Tile.isSuspect coTileSpeedup t
         && not underFeet
         && alterSkill <= 1 -> do
           modificationFailureHint
           failSer AlterUnskilled
       | not (Tile.isSuspect coTileSpeedup t)
         && not underFeet
         && alterSkill < Tile.alterMinSkill coTileSpeedup t -> do
           -- Rather rare (requires high skill), so describe the tile.
           blurb <- lookAtPosition tpos (blid sb)
           mapM_ (uncurry msgAdd) blurb
           modificationFailureHint
           failSer AlterUnwalked
       | chessDist tpos (bpos sb) > 1 ->
           -- Checked late to give useful info about distant tiles.
           failSer AlterDistant
       | not underFeet
         && (occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl) ->
           -- Don't mislead describing terrain, if other actor is to blame.
           failSer AlterBlockActor
       | otherwise -> do  -- promising
           verAlters <- verifyAlters leader bumping tpos
           case verAlters of
             Right () ->
               if bumping then
                 return $ Right $ ReqMove $ vectorToFrom tpos spos
               else do
                 msgAddDone False leader tpos "modify"
                 return $ Right $ ReqAlter tpos
             Left err -> return $ Left err
           -- Even when bumping, we don't use ReqMove, because we don't want
           -- to hit invisible actors, e.g., hidden in a wall.
           -- If server performed an attack for free
           -- on the invisible actor anyway, the player (or AI)
           -- would be tempted to repeatedly hit random walls
           -- in hopes of killing a monster residing within.
           -- If the action had a cost, misclicks would incur the cost, too.
           -- Right now the player may repeatedly alter tiles trying to learn
           -- about invisible pass-wall actors, but when an actor detected,
           -- it costs a turn and does not harm the invisible actors,
           -- so it's not so tempting.
  
  -- * RunOnceAhead
  
  runOnceAheadHuman :: MonadClientUI m
                    => ActorId -> m (Either MError RequestTimed)
  runOnceAheadHuman leader = do
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    keyPressed <- anyKeyPressed
    srunning <- getsSession srunning
    -- When running, stop if disturbed. If not running, stop at once.
    case srunning of
      Nothing -> do
        msgAdd MsgRunStopReason "run stop: nothing to do"
        return $ Left Nothing
      Just RunParams{runMembers}
        | noRunWithMulti fact && runMembers /= [leader] -> do
        msgAdd MsgRunStopReason "run stop: automatic pointman change"
        return $ Left Nothing
      Just _runParams | keyPressed -> do
        discardPressedKey
        msgAdd MsgRunStopReason "run stop: key pressed"
        weaveJust <$> failWith "interrupted"
      Just runParams -> do
        arena <- getArenaUI
        runOutcome <- continueRun arena runParams
        case runOutcome of
          Left stopMsg -> do
            msgAdd MsgRunStopReason ("run stop:" <+> stopMsg)
            return $ Left Nothing
          Right runCmd ->
            return $ Right runCmd
  
  -- * MoveOnceToXhair
  
  moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                       => ActorId -> m (FailOrCmd RequestTimed)
  moveOnceToXhairHuman leader = goToXhair leader True False
  
  goToXhair :: (MonadClient m, MonadClientUI m)
            => ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
  goToXhair leader initialStep run = do
    aimMode <- getsSession saimMode
    -- Movement is legal only outside aiming mode.
    if isJust aimMode
    then failWith "cannot move in aiming mode"
    else goToXhairExplorationMode leader initialStep run
  
  goToXhairExplorationMode :: (MonadClient m, MonadClientUI m)
                           => ActorId -> Bool -> Bool
                           -> m (FailOrCmd RequestTimed)
  goToXhairExplorationMode leader initialStep run = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    sb <- getsState $ getActorBody leader
    let moveSkill = Ability.getSk Ability.SkMove actorCurAndMaxSk
    -- If skill is too low, no path in @Bfs@ is going to be found,
    -- but we check the skill (and sleep) to give a more accurate message.
    if | moveSkill > 0 -> do
         xhair <- getsSession sxhair
         xhairGoTo <- getsSession sxhairGoTo
         mfail <-
           if isJust xhairGoTo && xhairGoTo /= xhair
           then failWith "crosshair position changed"
           else do
             when (isNothing xhairGoTo) $  -- set it up for next steps
               modifySession $ \sess -> sess {sxhairGoTo = xhair}
             goToXhairGoTo leader initialStep run
         when (isLeft mfail) $
           modifySession $ \sess -> sess {sxhairGoTo = Nothing}
         return mfail
       | bwatch sb == WSleep -> failSer MoveUnskilledAsleep
       | otherwise -> failSer MoveUnskilled
  
  goToXhairGoTo :: (MonadClient m, MonadClientUI m)
                => ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
  goToXhairGoTo leader initialStep run = do
    b <- getsState $ getActorBody leader
    mxhairPos <- mxhairToPos
    case mxhairPos of
      Nothing -> failWith "crosshair position invalid"
      Just c -> do
        running <- getsSession srunning
        case running of
          -- Don't use running params from previous run or goto-xhair.
          Just paramOld | not initialStep -> do
            arena <- getArenaUI
            runOutcome <- multiActorGoTo arena c paramOld
            case runOutcome of
              Left stopMsg -> return $ Left stopMsg
              Right (finalGoal, dir) ->
                moveRunHuman leader initialStep finalGoal run False dir
          _ | c == bpos b -> failWith "position reached"
          _ -> do
            let !_A = assert (initialStep || not run) ()
            (bfs, mpath) <- getCacheBfsAndPath leader c
            xhairMoused <- getsSession sxhairMoused
            case mpath of
              _ | xhairMoused && isNothing (accessBfs bfs c) ->
                failWith
                  "no route to crosshair (press again to go there anyway)"
              _ | initialStep && adjacent (bpos b) c -> do
                let dir = towards (bpos b) c
                moveRunHuman leader initialStep True run False dir
              Nothing -> failWith "no route to crosshair"
              Just AndPath{pathList=[]} -> failWith "almost there"
              Just AndPath{pathList = p1 : _} -> do
                let finalGoal = p1 == c
                    dir = towards (bpos b) p1
                moveRunHuman leader initialStep finalGoal run False dir
  
  multiActorGoTo :: (MonadClient m, MonadClientUI m)
                 => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
  multiActorGoTo arena c paramOld =
    case paramOld of
      RunParams{runMembers = []} -> failWith "selected actors no longer there"
      RunParams{runMembers = r : rs, runWaiting} -> do
        onLevel <- getsState $ memActor r arena
        b <- getsState $ getActorBody r
        mxhairPos <- mxhairToPos
        if not onLevel || mxhairPos == Just (bpos b) then do
          let paramNew = paramOld {runMembers = rs}
          multiActorGoTo arena c paramNew
        else do
          sL <- getState
          modifyClient $ updateLeader r sL
          let runMembersNew = rs ++ [r]
              paramNew = paramOld { runMembers = runMembersNew
                                  , runWaiting = 0}
          (bfs, mpath) <- getCacheBfsAndPath r c
          xhairMoused <- getsSession sxhairMoused
          case mpath of
            _ | xhairMoused && isNothing (accessBfs bfs c) ->
              failWith "no route to crosshair (press again to go there anyway)"
            Nothing -> failWith "no route to crosshair"
            Just AndPath{pathList=[]} -> failWith "almost there"
            Just AndPath{pathList = p1 : _} -> do
              let finalGoal = p1 == c
                  dir = towards (bpos b) p1
              tgts <- getsState $ posToAids p1 arena
              case tgts of
                [] -> do
                  modifySession $ \sess -> sess {srunning = Just paramNew}
                  return $ Right (finalGoal, dir)
                [target] | target `elem` rs || runWaiting <= length rs ->
                  -- Let r wait until all others move. Mark it in runWaiting
                  -- to avoid cycles. When all wait for each other, fail.
                  multiActorGoTo arena c paramNew{runWaiting=runWaiting + 1}
                _ ->
                  failWith "collective running finished"  -- usually OK
  
  -- * RunOnceToXhair
  
  runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                      => ActorId -> m (FailOrCmd RequestTimed)
  runOnceToXhairHuman leader = goToXhair leader True True
  
  -- * ContinueToXhair
  
  continueToXhairHuman :: (MonadClient m, MonadClientUI m)
                       => ActorId -> m (FailOrCmd RequestTimed)
  continueToXhairHuman leader = goToXhair leader False False{-irrelevant-}
  
  -- * MoveItem
  
  moveItemHuman :: forall m. MonadClientUI m
                => ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
                -> m (FailOrCmd RequestTimed)
  moveItemHuman leader stores destCStore mverb auto = do
    let !_A = assert (destCStore `notElem` stores) ()
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if Ability.getSk Ability.SkMoveItem actorCurAndMaxSk > 0
    then moveOrSelectItem leader stores destCStore mverb auto
    else failSer MoveItemUnskilled
  
  -- This cannot be structured as projecting or applying, with @ByItemMode@
  -- and @ChooseItemToMove@, because at least in case of grabbing items,
  -- more than one item is chosen, which doesn't fit @sitemSel@. Separating
  -- grabbing of multiple items as a distinct command is too high a price.
  moveOrSelectItem :: forall m. MonadClientUI m
                   => ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
                   -> m (FailOrCmd RequestTimed)
  moveOrSelectItem leader storesRaw destCStore mverb auto = do
    b <- getsState $ getActorBody leader
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
    let calmE = calmEnough b actorCurAndMaxSk
        overStash = mstash == Just (blid b, bpos b)
        stores = case storesRaw of
          CEqp : rest@(_ : _) | not calmE -> rest ++ [CEqp]
          CGround : rest@(_ : _) | overStash -> rest ++ [CGround]
          _ -> storesRaw
    itemSel <- getsSession sitemSel
    modifySession $ \sess -> sess {sitemSel = Nothing}  -- prevent surprise
    case itemSel of
      _ | stores == [CGround] && overStash ->
        failWith "you can't loot items from your own stash"
      Just (_, fromCStore@CEqp, _) | fromCStore /= destCStore
                                     && fromCStore `elem` stores
                                     && not calmE ->
        failWith "neither the selected item nor any other can be unequipped"
      Just (_, fromCStore@CGround, _) | fromCStore /= destCStore
                                        && fromCStore `elem` stores
                                        && overStash ->
        failWith "you vainly paw through your own hoard"
      Just (iid, fromCStore, _) | fromCStore /= destCStore
                                  && fromCStore `elem` stores -> do
        bag <- getsState $ getBodyStoreBag b fromCStore
        case iid `EM.lookup` bag of
          Nothing ->  -- the case of old selection or selection from another actor
            moveOrSelectItem leader stores destCStore mverb auto
          Just (k, it) -> assert (k > 0) $ do
            let eqpFree = eqpFreeN b
                kToPick | destCStore == CEqp = min eqpFree k
                        | otherwise = k
            if | destCStore == CEqp && not calmE -> failSer ItemNotCalm
               | destCStore == CGround && overStash -> failSer ItemOverStash
               | kToPick == 0 -> failWith "no more items can be equipped"
               | otherwise -> do
                 socK <- pickNumber (not auto) kToPick
                 case socK of
                   Left Nothing ->
                     moveOrSelectItem leader stores destCStore mverb auto
                   Left (Just err) -> return $ Left err
                   Right kChosen ->
                     let is = (fromCStore, [(iid, (kChosen, take kChosen it))])
                     in Right <$> moveItems leader stores is destCStore
      _ -> do
        mis <- selectItemsToMove leader stores destCStore mverb auto
        case mis of
          Left err -> return $ Left err
          Right (fromCStore, [(iid, _)]) | stores /= [CGround] -> do
            modifySession $ \sess ->
              sess {sitemSel = Just (iid, fromCStore, False)}
            moveOrSelectItem leader stores destCStore mverb auto
          Right is@(fromCStore, _) ->
            if | fromCStore == CEqp && not calmE -> failSer ItemNotCalm
               | fromCStore == CGround && overStash -> failSer ItemOverStash
               | otherwise -> Right <$> moveItems leader stores is destCStore
  
  selectItemsToMove :: forall m. MonadClientUI m
                    => ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
                    -> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))
  selectItemsToMove leader stores destCStore mverb auto = do
    let verb = fromMaybe (verbCStore destCStore) mverb
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    b <- getsState $ getActorBody leader
    mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
    lastItemMove <- getsSession slastItemMove
    -- This calmE is outdated when one of the items increases max Calm
    -- (e.g., in pickup, which handles many items at once), but this is OK,
    -- the server accepts item movement based on calm at the start, not end
    -- or in the middle.
    -- The calmE is inaccurate also if an item not IDed, but that's intended
    -- and the server will ignore and warn (and content may avoid that,
    -- e.g., making all rings identified)
    let calmE = calmEnough b actorCurAndMaxSk
        overStash = mstash == Just (blid b, bpos b)
    if | destCStore == CEqp && not calmE -> failSer ItemNotCalm
       | destCStore == CGround && overStash -> failSer ItemOverStash
       | destCStore == CEqp && eqpOverfull b 1 -> failSer EqpOverfull
       | otherwise -> do
         let storesLast = case lastItemMove of
               Just (lastFrom, lastDest) | lastDest == destCStore
                                           && lastFrom `elem` stores ->
                 lastFrom : delete lastFrom stores
               _ -> stores
             prompt = "What to"
             promptEqp = "What consumable to"
             eqpItemsN body =
               let n = sum $ map fst $ EM.elems $ beqp body
               in "(" <> makePhrase [MU.CarWs n "item"]
             ppItemDialogBody body actorSk cCur = case cCur of
               MStore CEqp | not $ calmEnough body actorSk ->
                 "distractedly paw at" <+> ppItemDialogModeIn cCur
               MStore CGround | mstash == Just (blid body, bpos body) ->
                 "greedily fondle" <+> ppItemDialogModeIn cCur
               _ -> case destCStore of
                 CEqp | not $ calmEnough body actorSk ->
                   "distractedly attempt to" <+> verb
                   <+> ppItemDialogModeFrom cCur
                 CEqp | eqpOverfull body 1 ->
                   "attempt to fit into equipment" <+> ppItemDialogModeFrom cCur
                 CGround | mstash == Just (blid body, bpos body) ->
                   "greedily attempt to" <+> verb <+> ppItemDialogModeFrom cCur
                 CEqp -> verb
                         <+> eqpItemsN body <+> "so far)"
                         <+> ppItemDialogModeFrom cCur
                 _ -> verb <+> ppItemDialogModeFrom cCur
                      <+> if cCur == MStore CEqp
                          then eqpItemsN body <+> "now)"
                          else ""
             (promptGeneric, psuit) =
               -- We prune item list only for eqp, because other stores don't have
               -- so clear cut heuristics. So when picking up a stash, either grab
               -- it to auto-store things, or equip first using the pruning
               -- and then stash the rest selectively or en masse.
               if destCStore == CEqp
               then (promptEqp, return $ SuitsSomething $ \_ itemFull _kit ->
                      IA.goesIntoEqp $ aspectRecordFull itemFull)
               else (prompt, return SuitsEverything)
         ggi <-
           getFull leader psuit
                   (\body _ actorSk cCur _ ->
                      prompt <+> ppItemDialogBody body actorSk cCur)
                   (\body _ actorSk cCur _ ->
                      promptGeneric <+> ppItemDialogBody body actorSk cCur)
                   storesLast (not auto) True
         case ggi of
           Right (fromCStore, l) -> do
             modifySession $ \sess ->
               sess {slastItemMove = Just (fromCStore, destCStore)}
             return $ Right (fromCStore, l)
           Left err -> failWith err
  
  moveItems :: forall m. MonadClientUI m
            => ActorId -> [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore
            -> m RequestTimed
  moveItems leader stores (fromCStore, l) destCStore = do
    let !_A = assert (fromCStore /= destCStore && fromCStore `elem` stores) ()
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    b <- getsState $ getActorBody leader
    discoBenefit <- getsClient sdiscoBenefit
    let calmE = calmEnough b actorCurAndMaxSk
        ret4 :: [(ItemId, ItemQuant)] -> Int -> m [(ItemId, Int, CStore, CStore)]
        ret4 [] _ = return []
        ret4 ((iid, (k, _)) : rest) oldN = do
          let !_A = assert (k > 0) ()
              retRec toCStore = do
                let n = oldN + if toCStore == CEqp then k else 0
                l4 <- ret4 rest n
                return $ (iid, k, fromCStore, toCStore) : l4
          if stores == [CGround] && destCStore == CStash  -- normal pickup
          then -- @CStash@ is the implicit default; refine:
               if | not $ benInEqp $ discoBenefit EM.! iid -> retRec CStash
                  | eqpOverfull b (oldN + 1) -> do
                    -- Action goes through, but changed, so keep in history.
                    msgAdd MsgActionWarning $
                      "Warning:" <+> showReqFailure EqpOverfull <> "."
                    retRec CStash
                  | eqpOverfull b (oldN + k) -> do
                    -- If this stack doesn't fit, we don't equip any part of it,
                    -- but we may equip a smaller stack later of other items
                    -- in the same pickup.
                    msgAdd MsgActionWarning $
                      "Warning:" <+> showReqFailure EqpStackFull <> "."
                    retRec CStash
                  | not calmE -> do
                    msgAdd MsgActionWarning $
                      "Warning:" <+> showReqFailure ItemNotCalm <> "."
                    retRec CStash
                  | otherwise ->
                    -- Prefer @CEqp@ if all conditions hold:
                    retRec CEqp
          else case destCStore of  -- player forces store, so @benInEqp@ ignored
            CEqp | eqpOverfull b (oldN + 1) -> do
              -- Action aborted, so different colour and not in history.
              msgAdd MsgPromptItems $
                "Failure:" <+> showReqFailure EqpOverfull <> "."
              -- No recursive call here, we exit item manipulation,
              -- but something is moved or else outer functions would not call us.
              return []
            CEqp | eqpOverfull b (oldN + k) -> do
              msgAdd MsgPromptItems $
                "Failure:" <+> showReqFailure EqpStackFull <> "."
              return []
            _ -> retRec destCStore
    l4 <- ret4 l 0
    if null l4
    then error $ "" `showFailure` (stores, fromCStore, l, destCStore)
    else return $! ReqMoveItems l4
  
  -- * Project
  
  projectHuman :: (MonadClient m, MonadClientUI m)
               => ActorId -> m (FailOrCmd RequestTimed)
  projectHuman leader = do
    curChal <- getsClient scurChal
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if | ckeeper curChal ->
         failSer ProjectFinderKeeper
       | Ability.getSk Ability.SkProject actorCurAndMaxSk <= 0 ->
         -- Detailed are check later.
         failSer ProjectUnskilled
       | otherwise -> do
         itemSel <- getsSession sitemSel
         case itemSel of
           Just (_, COrgan, _) -> failWith "can't fling an organ"
           Just (iid, fromCStore, _) -> do
             b <- getsState $ getActorBody leader
             bag <- getsState $ getBodyStoreBag b fromCStore
             case iid `EM.lookup` bag of
               Nothing -> failWith "no item to fling"
               Just _kit -> do
                 itemFull <- getsState $ itemToFull iid
                 let i = (fromCStore, (iid, itemFull))
                 projectItem leader i
           Nothing -> failWith "no item to fling"
  
  projectItem :: (MonadClient m, MonadClientUI m)
              => ActorId -> (CStore, (ItemId, ItemFull))
              -> m (FailOrCmd RequestTimed)
  projectItem leader (fromCStore, (iid, itemFull)) = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    b <- getsState $ getActorBody leader
    let calmE = calmEnough b actorCurAndMaxSk
    if fromCStore == CEqp && not calmE then failSer ItemNotCalm
    else do
      mpsuitReq <- psuitReq leader
      case mpsuitReq of
        Left err -> failWith err
        Right psuitReqFun ->
          case psuitReqFun itemFull of
            Left reqFail -> failSer reqFail
            Right (pos, _) -> do
              Benefit{benFling} <- getsClient $ (EM.! iid) . sdiscoBenefit
              go <- if benFling >= 0
                    then displayYesNo ColorFull
                           "The item may be beneficial. Do you really want to fling it?"
                    else return True
              if go then do
                -- Set personal target to enemy, so that AI, if it takes over
                -- the actor, is likely to continue the fight even if the foe
                -- flees. Similarly if the crosshair points at position, etc.
                sxhair <- getsSession sxhair
                modifyClient $ updateTarget leader (const sxhair)
                -- Project.
                eps <- getsClient seps
                return $ Right $ ReqProject pos eps iid fromCStore
              else do
                modifySession $ \sess -> sess {sitemSel = Nothing}
                failWith "never mind"
  
  -- * Apply
  
  applyHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
  applyHuman leader = do
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    if Ability.getSk Ability.SkApply
                     actorCurAndMaxSk <= 0 then  -- detailed check later
      failSer ApplyUnskilled
    else do
      itemSel <- getsSession sitemSel
      case itemSel of
        Just (iid, fromCStore, _) -> do
          b <- getsState $ getActorBody leader
          bag <- getsState $ getBodyStoreBag b fromCStore
          case iid `EM.lookup` bag of
            Nothing -> failWith "no item to trigger"
            Just kit -> do
              itemFull <- getsState $ itemToFull iid
              applyItem leader (fromCStore, (iid, (itemFull, kit)))
        Nothing -> failWith "no item to trigger"
  
  applyItem :: MonadClientUI m
            => ActorId -> (CStore, (ItemId, ItemFullKit))
            -> m (FailOrCmd RequestTimed)
  applyItem leader (fromCStore, (iid, (itemFull, kit))) = do
    COps{corule} <- getsState scops
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    b <- getsState $ getActorBody leader
    localTime <- getsState $ getLocalTime (blid b)
    let skill = Ability.getSk Ability.SkApply actorCurAndMaxSk
        calmE = calmEnough b actorCurAndMaxSk
        arItem = aspectRecordFull itemFull
    if fromCStore == CEqp && not calmE then failSer ItemNotCalm
    else case permittedApply corule localTime skill calmE (Just fromCStore)
                             itemFull kit of
      Left reqFail -> failSer reqFail
      Right _ -> do
        Benefit{benApply} <- getsClient $ (EM.! iid) . sdiscoBenefit
        go <-
          if | IA.checkFlag Ability.Periodic arItem
               && not (IA.checkFlag Ability.Durable arItem) ->
               -- No warning if item durable, because activation weak,
               -- but price low, due to no destruction.
               displayYesNo ColorFull
                            "Triggering this periodic item may not produce all its effects (check item description) and moreover, because it's not durable, will destroy it. Are you sure?"
             | benApply < 0 ->
               displayYesNo ColorFull
                            "The item appears harmful. Do you really want to trigger it?"
             | otherwise -> return True
        if go
        then return $ Right $ ReqApply iid fromCStore
        else do
          modifySession $ \sess -> sess {sitemSel = Nothing}
          failWith "never mind"
  
  -- * AlterDir
  
  -- | Ask for a direction and alter a tile, if possible.
  alterDirHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
  alterDirHuman leader = pickPoint leader "modify" >>= \case
    Just p -> alterTileAtPos leader p
    Nothing -> failWith "never mind"
  
  -- | Try to alter a tile using a feature at the given position.
  --
  -- We don't check if the tile is interesting, e.g., if any embedded
  -- item can be triggered, because the player explicitely requested
  -- the action. Consequently, even if all embedded items are recharching,
  -- the time will be wasted and the server will describe the failure in detail.
  alterTileAtPos :: MonadClientUI m
                 => ActorId -> Point -> m (FailOrCmd RequestTimed)
  alterTileAtPos leader pos = do
    sb <- getsState $ getActorBody leader
    let sxhair = Just $ TPoint TUnknown (blid sb) pos
    -- Point xhair to see details with `~`.
    setXHairFromGUI sxhair
    alterCommon leader False pos
  
  -- | Verify that the tile can be transformed or any embedded item effect
  -- triggered and the player is aware if the effect is dangerous or grave,
  -- such as ending the game.
  verifyAlters :: forall m. MonadClientUI m
               => ActorId -> Bool -> Point -> m (FailOrCmd ())
  verifyAlters leader bumping tpos = do
    COps{cotile, coTileSpeedup} <- getsState scops
    sb <- getsState $ getActorBody leader
    arItem <- getsState $ aspectRecordFromIid $ btrunk sb
    embeds <- getsState $ getEmbedBag (blid sb) tpos
    lvl <- getLevel $ blid sb
    getKind <- getsState $ flip getIidKind
    let embedKindList =
          if IA.checkFlag Ability.Blast arItem
          then []  -- prevent embeds triggering each other in a loop
          else map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)
        underFeet = tpos == bpos sb  -- if enter and alter, be more permissive
        blockedByItem = EM.member tpos (lfloor lvl)
        tile = lvl `at` tpos
        feats = TK.tfeature $ okind cotile tile
        tileActions =
          mapMaybe (parseTileAction
                      (bproj sb)
                      (underFeet || blockedByItem)  -- avoids AlterBlockItem
                      embedKindList)
                   feats
    if null tileActions
       && blockedByItem
       && not underFeet
       && Tile.isModifiable coTileSpeedup tile
    then failSer AlterBlockItem
    else processTileActions leader bumping tpos tileActions
  
  processTileActions :: forall m. MonadClientUI m
                     => ActorId -> Bool -> Point -> [TileAction]
                     -> m (FailOrCmd ())
  processTileActions leader bumping tpos tas = do
    COps{coTileSpeedup} <- getsState scops
    getKind <- getsState $ flip getIidKind
    sb <- getsState $ getActorBody leader
    lvl <- getLevel $ blid sb
    sar <- getsState $ aspectRecordFromIid $ btrunk sb
    let leaderIsMist = IA.checkFlag Ability.Blast sar
                       && Dice.infDice (IK.idamage $ getKind $ btrunk sb) <= 0
        tileMinSkill = Tile.alterMinSkill coTileSpeedup $ lvl `at` tpos
        processTA :: Maybe Bool -> [TileAction] -> Bool
                  -> m (FailOrCmd (Maybe (Bool, Bool)))
        processTA museResult [] bumpFailed = do
          let useResult = fromMaybe False museResult
          -- No warning will be generated if during explicit modification
          -- an embed is activated but there is not enough tools
          -- for a subsequent transformation. This is fine. Bumping would
          -- produce the warning and S-dir also displays the tool info.
          -- We can't rule out the embed is the main feature and the tool
          -- transformation is not important despite following it.
          -- We don't want spam in such a case.
          return $ Right $ if Tile.isSuspect coTileSpeedup (lvl `at` tpos)
                              || useResult && not bumpFailed
                           then Nothing  -- success of some kind
                           else Just (useResult, bumpFailed)  -- not quite
        processTA museResult (ta : rest) bumpFailed = case ta of
          EmbedAction (iid, _) -> do
            -- Embeds are activated in the order in tile definition
            -- and never after the tile is changed.
            -- We assume the item would trigger and we let the player
            -- take the risk of wasted turn to verify the assumption.
            -- If the item recharges, the wasted turns let the player wait.
            let useResult = fromMaybe False museResult
            if | leaderIsMist
                 || bproj sb && tileMinSkill > 0 ->  -- local skill check
                 processTA (Just useResult) rest bumpFailed
                   -- embed won't fire; try others
               | (not . any IK.isEffEscape) (IK.ieffects $ getKind iid) ->
                 processTA (Just True) rest False
                   -- no escape checking needed, effect found;
                   -- also bumpFailed reset, because must have been
                   -- marginal if an embed was following it
               | otherwise -> do
                 mfail <- verifyEscape
                 case mfail of
                   Left err -> return $ Left err
                   Right () -> processTA (Just True) rest False
                     -- effect found, bumpFailed reset
          ToAction{} ->
            if fromMaybe True museResult
               && not (bproj sb && tileMinSkill > 0)  -- local skill check
            then return $ Right Nothing  -- tile changed, no more activations
            else processTA museResult rest bumpFailed
                   -- failed, but not due to bumping
          WithAction tools0 _ ->
            if not bumping || null tools0 then
              if fromMaybe True museResult then do
                -- UI requested, so this is voluntary, so item loss is fine.
                kitAssG <- getsState $ kitAssocs leader [CGround]
                kitAssE <- getsState $ kitAssocs leader [CEqp]
                let kitAss = listToolsToConsume kitAssG kitAssE
                    grps0 = map (\(x, y) -> (False, x, y)) tools0
                      -- apply if durable
                    (_, iidsToApply, grps) =
                      foldl' subtractIidfromGrps (EM.empty, [], grps0) kitAss
                if null grps then do
                  let hasEffectOrDmg (_, (_, ItemFull{itemKind})) =
                        IK.idamage itemKind /= 0
                        || any IK.forApplyEffect (IK.ieffects itemKind)
                  mfail <- case filter hasEffectOrDmg iidsToApply of
                    [] -> return $ Right ()
                    (store, (_, itemFull)) : _ ->
                      verifyToolEffect (blid sb) store itemFull
                  case mfail of
                    Left err -> return $ Left err
                    Right () -> return $ Right Nothing  -- tile changed, done
                else processTA museResult rest bumpFailed  -- not enough tools
              else processTA museResult rest bumpFailed  -- embeds failed
            else processTA museResult rest True  -- failed due to bumping
    mfail <- processTA Nothing tas False
    case mfail of
      Left err -> return $ Left err
      Right Nothing -> return $ Right ()
      Right (Just (useResult, bumpFailed)) -> do
        let !_A = assert (not useResult || bumpFailed) ()
        blurb <- lookAtPosition tpos (blid sb)
        mapM_ (uncurry msgAdd) blurb
        if bumpFailed then do
          revCmd <- revCmdMap
          let km = revCmd AlterDir
              msg = "bumping is not enough to transform this terrain; modify with the '"
                    <> T.pack (K.showKM km)
                    <> "' command instead"
          if useResult then do
            merr <- failMsg msg
            msgAdd MsgPromptAction $ showFailError $ fromJust merr
            return $ Right ()  -- effect the embed activation, though
          else failWith msg
        else failWith "unable to activate nor modify at this time"
          -- related to, among others, @SfxNoItemsForTile@ on the server
  
  verifyEscape :: MonadClientUI m => m (FailOrCmd ())
  verifyEscape = do
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    if not (FK.fcanEscape $ gkind fact)
    then failWith
           "This is the way out, but where would you go in this alien world?"
             -- exceptionally a full sentence, because a real question
    else do
      (_, total) <- getsState $ calculateTotal side
      dungeonTotal <- getsState sgold
      let prompt | dungeonTotal == 0 =
                   "You finally reached your goal. Really leave now?"
                 | total == 0 =
                   "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"
                 | total < dungeonTotal =
                   "You've finally found the way out, but you didn't gather all valuables rumoured to be laying around. Really leave already?"
                 | otherwise =
                   "This is the way out and you collected all treasure there is to find. Really leave now?"
      -- The player can back off, but we never insist,
      -- because possibly the score formula doesn't reward treasure
      -- or he is focused on winning only.
      go <- displayYesNo ColorBW prompt
      if not go
      then failWith "here's your chance"
      else return $ Right ()
  
  verifyToolEffect :: MonadClientUI m
                   => LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
  verifyToolEffect lid store itemFull = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    side <- getsClient sside
    localTime <- getsState $ getLocalTime lid
    factionD <- getsState sfactionD
    let (name1, powers) = partItemShort rwidth side factionD localTime
                                        itemFull quantSingle
        objectA = makePhrase [MU.AW name1, powers]
        -- "Potentially", because an unidentified items on the ground can take
        -- precedence (perhaps placed there in order to get identified!).
        prompt = "Do you really want to transform the terrain potentially using"
                 <+> objectA <+> ppCStoreIn store
                 <+> "that may cause substantial side-effects?"
        objectThe = makePhrase ["the", name1]
    go <- displayYesNo ColorBW prompt
    if not go
    then failWith $ "replace" <+> objectThe <+> "and try again"
           -- question capitalized and ended with a dot, answer neither
    else return $ Right ()
  
  -- * AlterWithPointer
  
  -- | Try to alter a tile using a feature under the pointer.
  alterWithPointerHuman :: MonadClientUI m
                        => ActorId -> m (FailOrCmd RequestTimed)
  alterWithPointerHuman leader = do
    COps{corule=RuleContent{rWidthMax, rHeightMax}} <- getsState scops
    pUI <- getsSession spointer
    let p = squareToMap $ uiToSquare pUI
    if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
    then alterTileAtPos leader p
    else failWith "never mind"
  
  -- * CloseDir
  
  -- | Close nearby open tile; ask for direction, if there is more than one.
  closeDirHuman :: MonadClientUI m
                => ActorId -> m (FailOrCmd RequestTimed)
  closeDirHuman leader = do
    COps{coTileSpeedup} <- getsState scops
    b <- getsState $ getActorBody leader
    lvl <- getLevel $ blid b
    let vPts = vicinityUnsafe $ bpos b
        openPts = filter (Tile.isClosable coTileSpeedup . at lvl) vPts
    case openPts of
      []  -> failSer CloseNothing
      [o] -> closeTileAtPos leader o
      _   -> pickPoint leader "close" >>= \case
        Nothing -> failWith "never mind"
        Just p -> closeTileAtPos leader p
  
  -- | Close tile at given position.
  closeTileAtPos :: MonadClientUI m
                 => ActorId -> Point -> m (FailOrCmd RequestTimed)
  closeTileAtPos leader tpos = do
    COps{coTileSpeedup} <- getsState scops
    actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
    b <- getsState $ getActorBody leader
    alterable <- getsState $ tileAlterable (blid b) tpos
    lvl <- getLevel $ blid b
    let alterSkill = Ability.getSk Ability.SkAlter actorCurAndMaxSk
        t = lvl `at` tpos
        isOpen = Tile.isClosable coTileSpeedup t
        isClosed = Tile.isOpenable coTileSpeedup t
    case (alterable, isClosed, isOpen) of
      (False, _, _) -> failSer CloseNothing
      (True, False, False) -> failSer CloseNonClosable
      (True, True,  False) -> failSer CloseClosed
      (True, True,  True) -> error "TileKind content validation"
      (True, False, True) ->
        if | tpos `chessDist` bpos b > 1
            -> failSer CloseDistant
           | alterSkill <= 1
            -> failSer AlterUnskilled
           | EM.member tpos $ lfloor lvl
            -> failSer AlterBlockItem
           | occupiedBigLvl tpos lvl || occupiedProjLvl tpos lvl
            -> failSer AlterBlockActor
           | otherwise
            -> do
               msgAddDone True leader tpos "close"
               return $ Right (ReqAlter tpos)
  
  -- | Adds message with proper names.
  msgAddDone :: MonadClientUI m => Bool -> ActorId -> Point -> Text -> m ()
  msgAddDone mentionTile leader p verb = do
    COps{cotile} <- getsState scops
    b <- getsState $ getActorBody leader
    lvl <- getLevel $ blid b
    let tname = TK.tname $ okind cotile $ lvl `at` p
        s = case T.words tname of
              [] -> "thing"
              ("open" : xs) -> T.unwords xs
              _ -> tname
        object | mentionTile = "the" <+> s
               | otherwise = ""
        v = p `vectorToFrom` bpos b
        dir | v == Vector 0 0 = "underneath"
            | otherwise = compassText v
    msgAdd MsgActionComplete $ "You" <+> verb <+> object <+> dir <> "."
  
  -- | Prompts user to pick a point.
  pickPoint :: MonadClientUI m => ActorId -> Text -> m (Maybe Point)
  pickPoint leader verb = do
    b <- getsState $ getActorBody leader
    UIOptions{uVi, uLeftHand} <- getsSession sUIOptions
    let dirKeys = K.dirAllKey uVi uLeftHand
        keys = K.escKM
             : K.leftButtonReleaseKM
             : map (K.KM K.NoModifier) dirKeys
    msgAdd MsgPromptGeneric $ "Where to" <+> verb <> "? [movement key] [pointer]"
    slides <- reportToSlideshow [K.escKM]
    km <- getConfirms ColorFull keys slides
    case K.key km of
      K.LeftButtonRelease -> do
        pUI <- getsSession spointer
        let p = squareToMap $ uiToSquare pUI
        return $ Just p
      _ -> return $ shift (bpos b) <$> K.handleDir dirKeys km
  
  -- * Help
  
  -- | Display command help.
  helpHuman :: MonadClientUI m
            => (K.KM -> HumanCmd -> m (Either MError ReqUI))
            -> m (Either MError ReqUI)
  helpHuman cmdSemInCxtOfKM = do
    ccui@CCUI{coinput, coscreen=ScreenContent{rwidth, rheight, rintroScreen}}
      <- getsSession sccui
    fontSetup@FontSetup{..} <- getFontSetup
    gameModeId <- getsState sgameModeId
    modeOv <- describeMode True gameModeId
    curTutorial <- getsSession scurTutorial
    overrideTut <- getsSession soverrideTut
    let displayTutorialHints = fromMaybe curTutorial overrideTut
        modeH = ( "Press SPACE or PGDN to advance or ESC to see the map again."
                , (modeOv, []) )
        keyH = keyHelp ccui fontSetup
        -- This takes a list of paragraphs and returns a list of screens.
        -- Both paragraph and screen is a list of lines.
        --
        -- This would be faster, but less clear, if paragraphs were stored
        -- reversed in content. Not worth it, until we have huge manuals
        -- or run on weak mobiles. Even then, precomputation during
        -- compilation may be better.
        --
        -- Empty lines may appear at the end of pages, but it's fine,
        -- it means there is a new section on the next page.
        packIntoScreens :: [[String]] -> [[String]] -> Int -> [[String]]
        packIntoScreens [] acc _ = [intercalate [""] (reverse acc)]
        packIntoScreens ([] : ls) [] _  =
          -- Ignore empty paragraphs at the start of screen.
          packIntoScreens ls [] 0
        packIntoScreens (l : ls) [] h = assert (h == 0) $
          -- If a paragraph, even alone, is longer than screen height, it's split.
          if length l <= rheight - 3
          then packIntoScreens ls [l] (length l)
          else let (screen, rest) = splitAt (rheight - 3) l
               in screen : packIntoScreens (rest : ls) [] 0
        packIntoScreens (l : ls) acc h =
          -- The extra @+ 1@ comes from the empty line separating paragraphs,
          -- as added in @intercalate@.
          if length l + 1 + h <= rheight - 3
          then packIntoScreens ls (l : acc) (length l + 1 + h)
          else intercalate [""] (reverse acc) : packIntoScreens (l : ls) [] 0
        manualScreens = packIntoScreens (snd rintroScreen) [] 0
        sideBySide =
          if isSquareFont monoFont
          then \(screen1, screen2) ->  -- single column, two screens
            map offsetOverlay $ filter (not . null) [screen1, screen2]
          else \(screen1, screen2) ->  -- two columns, single screen
            [offsetOverlay screen1
             ++ xtranslateOverlay rwidth (offsetOverlay screen2)]
        listPairs (a : b : rest) = (a, b) : listPairs rest
        listPairs [a] = [(a, [])]
        listPairs [] = []
        -- Each screen begins with an empty line, to separate the header.
        manualOvs = map (EM.singleton monoFont)
                    $ concatMap sideBySide $ listPairs
                    $ map ((emptyAttrLine :) . map stringToAL) manualScreens
        addMnualHeader ov =
          ( "Showing PLAYING.md (best viewed in the browser)."
          , (ov, []) )
        manualH = map addMnualHeader manualOvs
        splitHelp (t, okx) =
          splitOKX fontSetup True rwidth rheight rwidth (textToAS t)
                   [K.spaceKM, K.returnKM, K.escKM] okx
        sli = toSlideshow fontSetup displayTutorialHints
              $ concatMap splitHelp $ modeH : keyH ++ manualH
    -- Thus, the whole help menu corresponds to a single menu of item or lore,
    -- e.g., shared stash menu. This is especially clear when the shared stash
    -- menu contains many pages.
    ekm <- displayChoiceScreen "help" ColorFull True sli
                               [K.spaceKM, K.returnKM, K.escKM]
    case ekm of
      Left km | km `elem` [K.escKM, K.spaceKM] -> return $ Left Nothing
      Left km | km == K.returnKM -> do
        msgAdd MsgPromptGeneric "Press RET when a command help text is selected to invoke the command."
        return $ Left Nothing
      Left km -> case km `M.lookup` bcmdMap coinput of
        Just (_desc, _cats, cmd) -> cmdSemInCxtOfKM km cmd
        Nothing -> weaveJust <$> failWith "never mind"
      Right _slot -> error $ "" `showFailure` ekm
  
  -- * Hint
  
  -- | Display hint or, if already displayed, display help.
  hintHuman :: MonadClientUI m
            => (K.KM -> HumanCmd -> m (Either MError ReqUI))
            -> m (Either MError ReqUI)
  hintHuman cmdSemInCxtOfKM = do
    sreportNull <- getsSession sreportNull
    if sreportNull then do
      promptMainKeys
      return $ Left Nothing
    else
      helpHuman cmdSemInCxtOfKM
  
  -- * Dashboard
  
  -- | Display the dashboard.
  dashboardHuman :: MonadClientUI m
                 => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                 -> m (Either MError ReqUI)
  dashboardHuman cmdSemInCxtOfKM = do
    CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui
    fontSetup@FontSetup{..} <- getFontSetup
    curTutorial <- getsSession scurTutorial
    overrideTut <- getsSession soverrideTut
    let displayTutorialHints = fromMaybe curTutorial overrideTut
        offsetCol2 = 3
        (ov0, kxs0) = okxsN coinput monoFont propFont offsetCol2 (const False)
                            False CmdDashboard ([], [], []) ([], [])
        al1 = textToAS "Dashboard"
        splitHelp (al, okx) = splitOKX fontSetup False rwidth (rheight - 2) rwidth
                                       al [K.returnKM, K.escKM] okx
        sli = toSlideshow fontSetup displayTutorialHints
              $ splitHelp (al1, (ov0, kxs0))
        extraKeys = [K.returnKM, K.escKM]
    ekm <- displayChoiceScreen "dashboard" ColorFull False sli extraKeys
    case ekm of
      Left km -> case km `M.lookup` bcmdMap coinput of
        _ | km == K.escKM -> weaveJust <$> failWith "never mind"
        _ | km == K.returnKM -> do
          msgAdd MsgPromptGeneric "Press RET when a menu name is selected to browse the menu."
          return $ Left Nothing
        Just (_desc, _cats, cmd) -> cmdSemInCxtOfKM km cmd
        Nothing -> weaveJust <$> failWith "never mind"
      Right _slot -> error $ "" `showFailure` ekm
  
  -- * ItemMenu
  
  itemMenuHuman :: MonadClientUI m
                => ActorId
                -> (K.KM -> HumanCmd -> m (Either MError ReqUI))
                -> m (Either MError ReqUI)
  itemMenuHuman leader cmdSemInCxtOfKM = do
    COps{corule} <- getsState scops
    itemSel <- getsSession sitemSel
    fontSetup@FontSetup{..} <- getFontSetup
    case itemSel of
      Just (iid, fromCStore, _) -> do
        side <- getsClient sside
        b <- getsState $ getActorBody leader
        bUI <- getsSession $ getActorUI leader
        bag <- getsState $ getBodyStoreBag b fromCStore
        case iid `EM.lookup` bag of
          Nothing -> weaveJust <$> failWith "no item to open item menu for"
          Just kit -> do
            CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui
            actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
            itemFull <- getsState $ itemToFull iid
            localTime <- getsState $ getLocalTime (blid b)
            found <- getsState $ findIid leader side iid
            let !_A = assert (not (null found) || fromCStore == CGround
                              `blame` (iid, leader)) ()
                fAlt (aid, (_, store)) = aid /= leader || store /= fromCStore
                foundAlt = filter fAlt found
                markParagraphs = rheight >= 45
                meleeSkill = Ability.getSk Ability.SkHurtMelee actorCurAndMaxSk
                partRawActor aid = getsSession (partActor . getActorUI aid)
                ppLoc aid store = do
                  parts <- ppContainerWownW partRawActor
                                            False
                                            (CActor aid store)
                  return $! "[" ++ T.unpack (makePhrase parts) ++ "]"
                dmode = MStore fromCStore
            foundTexts <- mapM (\(aid, (_, store)) -> ppLoc aid store) foundAlt
            (ovLab, ovDesc) <-
              itemDescOverlays markParagraphs meleeSkill dmode iid kit
                               itemFull rwidth
            let foundPrefix = textToAS $
                  if null foundTexts then "" else "The item is also in:"
                ovPrefix = ytranslateOverlay (length ovDesc)
                           $ offsetOverlay
                           $ splitAttrString rwidth rwidth foundPrefix
                ystart = length ovDesc + length ovPrefix - 1
                xstart = textSize monoFont (Color.spaceAttrW32
                                            : attrLine (snd $ last ovPrefix))
                foundKeys = map (K.KM K.NoModifier . K.Fun)
                                [1 .. length foundAlt]  -- starting from 1!
            let ks = zip foundKeys foundTexts
                width = if isSquareFont monoFont then 2 * rwidth else rwidth
                (ovFoundRaw, kxsFound) = wrapOKX monoFont ystart xstart width ks
                ovFound = ovPrefix ++ ovFoundRaw
            report <- getReportUI True
            CCUI{coinput} <- getsSession sccui
            mstash <- getsState $ \s -> gstash $ sfactionD s EM.! side
            curTutorial <- getsSession scurTutorial
            overrideTut <- getsSession soverrideTut
            let displayTutorialHints = fromMaybe curTutorial overrideTut
                calmE = calmEnough b actorCurAndMaxSk
                greyedOut cmd = not calmE && fromCStore == CEqp
                                || mstash == Just (blid b, bpos b)
                                   && fromCStore == CGround
                                || case cmd of
                  ByAimMode AimModeCmd{..} ->
                    greyedOut exploration || greyedOut aiming
                  ComposeIfLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2
                  ComposeUnlessError cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2
                  Compose2ndLocal cmd1 cmd2 -> greyedOut cmd1 || greyedOut cmd2
                  MoveItem stores destCStore _ _ ->
                    fromCStore `notElem` stores
                    || destCStore == CEqp && (not calmE || eqpOverfull b 1)
                    || destCStore == CGround && mstash == Just (blid b, bpos b)
                  Apply{} ->
                    let skill = Ability.getSk Ability.SkApply actorCurAndMaxSk
                    in not $ fromRight False
                           $ permittedApply corule localTime skill calmE
                                            (Just fromCStore) itemFull kit
                  Project{} ->
                    let skill = Ability.getSk Ability.SkProject actorCurAndMaxSk
                    in not $ fromRight False
                           $ permittedProject False skill calmE itemFull
                  _ -> False
                fmt n k h = " " <> T.justifyLeft n ' ' k <> " " <> h
                offsetCol2 = 11
                keyCaption = fmt offsetCol2 "keys" "command"
                offset = 1 + maxYofOverlay (ovDesc ++ ovFound)
                (ov0, kxs0) = xytranslateOKX 0 offset $
                   okxsN coinput monoFont propFont offsetCol2 greyedOut
                         True CmdItemMenu ([], [], ["", keyCaption]) ([], [])
                t0 = makeSentence [ MU.SubjectVerbSg (partActor bUI) "choose"
                                  , "an item", MU.Text $ ppCStoreIn fromCStore ]
                alRep = foldr (<+:>) [] $ renderReport True report
                al1 | null alRep = textToAS t0
                    | otherwise = alRep ++ stringToAS "\n" ++ textToAS t0
                splitHelp (al, okx) =
                  splitOKX fontSetup False rwidth (rheight - 2) rwidth al
                           [K.spaceKM, K.escKM] okx
                sli = toSlideshow fontSetup displayTutorialHints
                      $ splitHelp ( al1
                                  , ( EM.insertWith (++) squareFont ovLab
                                      $ EM.insertWith (++) propFont ovDesc
                                      $ EM.insertWith (++) monoFont ovFound ov0
                                          -- mono font, because there are buttons
                                    , kxsFound ++ kxs0 ))
                extraKeys = [K.spaceKM, K.escKM] ++ foundKeys
            recordHistory  -- report shown (e.g., leader switch), save to history
            ekm <- displayChoiceScreen "item menu" ColorFull False sli extraKeys
            case ekm of
              Left km -> case km `M.lookup` bcmdMap coinput of
                _ | km == K.escKM -> weaveJust <$> failWith "never mind"
                _ | km == K.spaceKM ->
                  chooseItemMenuHuman leader cmdSemInCxtOfKM dmode
                _ | km `elem` foundKeys -> case km of
                  K.KM{key=K.Fun n} -> do
                    let (newAid, (bNew, newCStore)) = foundAlt !! (n - 1)
                    fact <- getsState $ (EM.! side) . sfactionD
                    let banned = bannedPointmanSwitchBetweenLevels fact
                    if blid bNew /= blid b && banned
                    then weaveJust <$> failSer NoChangeDunLeader
                    else do
                      -- Verbosity not necessary to notice the switch
                      -- and it's explicitly requested, so no surprise.
                      void $ pickLeader False newAid
                      modifySession $ \sess ->
                        sess {sitemSel = Just (iid, newCStore, False)}
                      itemMenuHuman newAid cmdSemInCxtOfKM
                  _ -> error $ "" `showFailure` km
                Just (_desc, _cats, cmd) -> do
                  modifySession $ \sess ->
                    sess {sitemSel = Just (iid, fromCStore, True)}
                  cmdSemInCxtOfKM km cmd
                Nothing -> weaveJust <$> failWith "never mind"
              Right _slot -> error $ "" `showFailure` ekm
      Nothing -> weaveJust <$> failWith "no item to open item menu for"
  
  -- * ChooseItemMenu
  
  chooseItemMenuHuman :: MonadClientUI m
                      => ActorId
                      -> (K.KM -> HumanCmd -> m (Either MError ReqUI))
                      -> ItemDialogMode
                      -> m (Either MError ReqUI)
  chooseItemMenuHuman leader1 cmdSemInCxtOfKM c1 = do
    res2 <- chooseItemDialogMode leader1 True c1
    case res2 of
      Right leader2 -> itemMenuHuman leader2 cmdSemInCxtOfKM
      Left err -> return $ Left $ Just err
  
  -- * MainMenu
  
  generateMenu :: MonadClientUI m
               => (K.KM -> HumanCmd -> m (Either MError ReqUI))
               -> FontOverlayMap
               -> [(Text, HumanCmd, Maybe HumanCmd, Maybe FontOverlayMap)]
               -> [String]
               -> String
               -> m (Either MError ReqUI)
  generateMenu cmdSemInCxtOfKM blurb kdsRaw gameInfo menuName = do
    COps{corule} <- getsState scops
    CCUI{ coinput=InputContent{brevMap}
        , coscreen=ScreenContent{rheight, rwebAddress} } <- getsSession sccui
    FontSetup{..} <- getFontSetup
    let matchKM slot kd@(_, cmd, _, _) = case M.lookup cmd brevMap of
          Just (km : _) -> (Left km, kd)
          _ -> (Right slot, kd)
        kds = zipWith matchKM natSlots kdsRaw
        bindings =  -- key bindings to display
          let attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
              highAttr ac = ac {Color.acAttr = attrCursor}
              highW32 = Color.attrCharToW32 . highAttr . Color.attrCharFromW32
              markFirst d = markFirstAS $ textToAS d
              markFirstAS [] = []
              markFirstAS (ac : rest) = highW32 ac : rest
              fmt (ekm, (d, _, _, _)) = (ekm, markFirst d)
          in map fmt kds
        generate :: Int -> (KeyOrSlot, AttrString) -> KYX
        generate y (ekm, binding) =
          (ekm, (PointUI 0 y, ButtonWidth squareFont (length binding)))
        okxBindings = ( EM.singleton squareFont
                        $ offsetOverlay $ map (attrStringToAL . snd) bindings
                      , zipWith generate [0..] bindings )
        titleLine =
          rtitle corule ++ " " ++ showVersion (rexeVersion corule) ++ " "
        titleAndInfo = map stringToAL
                           ([ ""
                            , titleLine ++ "[" ++ rwebAddress ++ "]"
                            , "" ]
                            ++ gameInfo)
        webButton = ( Left $ K.mkChar '@'  -- to start the menu not here
                    , ( PointUI (2 * length titleLine) 1
                      , ButtonWidth squareFont (2 + length rwebAddress) ) )
        okxTitle = ( EM.singleton squareFont $ offsetOverlay titleAndInfo
                   , [webButton] )
        okx = xytranslateOKX 2 0
              $ sideBySideOKX 2 (length titleAndInfo) okxTitle okxBindings
        prepareBlurb ovs =
          let introLen = 1 + maxYofFontOverlayMap ovs
              start0 = max 0 (rheight - introLen
                              - if isSquareFont propFont then 1 else 2)
          in EM.map (xytranslateOverlay (-2) (start0 - 2)) ovs
            -- subtracting 2 from X and Y to negate the indentation in
            -- @displayChoiceScreenWithRightPane@
        returnDefaultOKS = return (prepareBlurb blurb, [])
        displayInRightPane ekm = case ekm `lookup` kds of
          Just (_, _, _, mblurbRight) -> case mblurbRight of
            Nothing -> returnDefaultOKS
            Just blurbRight -> return (prepareBlurb blurbRight, [])
          Nothing | ekm == Left (K.mkChar '@') -> returnDefaultOKS
          Nothing -> error $ "generateMenu: unexpected key:"
                             `showFailure` ekm
        keys = [K.leftKM, K.rightKM, K.escKM, K.mkChar '@']
        loop = do
          kmkm <- displayChoiceScreenWithRightPaneKMKM displayInRightPane True
                                                       menuName ColorFull True
                                                       (menuToSlideshow okx) keys
          case kmkm of
            Left (km@(K.KM {key=K.Left}), ekm) -> case ekm `lookup` kds of
              Just (_, _, Nothing, _) -> loop
              Just (_, _, Just cmdReverse, _) -> cmdSemInCxtOfKM km cmdReverse
              Nothing -> weaveJust <$> failWith "never mind"
            Left (km@(K.KM {key=K.Right}), ekm) -> case ekm `lookup` kds of
              Just (_, cmd, _, _) -> cmdSemInCxtOfKM km cmd
              Nothing -> weaveJust <$> failWith "never mind"
            Left (K.KM {key=K.Char '@'}, _)-> do
              success <- tryOpenBrowser rwebAddress
              if success
              then generateMenu cmdSemInCxtOfKM blurb kdsRaw gameInfo menuName
              else weaveJust <$> failWith "failed to open web browser"
            Left (km, _) -> case Left km `lookup` kds of
              Just (_, cmd, _, _) -> cmdSemInCxtOfKM km cmd
              Nothing -> weaveJust <$> failWith "never mind"
            Right slot -> case Right slot `lookup` kds of
              Just (_, cmd, _, _) -> cmdSemInCxtOfKM K.escKM cmd
              Nothing -> weaveJust <$> failWith "never mind"
    loop
  
  -- | Display the main menu.
  mainMenuHuman :: MonadClientUI m
                => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                -> m (Either MError ReqUI)
  mainMenuHuman cmdSemInCxtOfKM = do
    CCUI{coscreen=ScreenContent{rintroScreen}} <- getsSession sccui
    FontSetup{propFont} <- getFontSetup
    gameMode <- getGameMode
    curTutorial <- getsSession scurTutorial
    overrideTut <- getsSession soverrideTut
    curChal <- getsClient scurChal
    let offOn b = if b then "on" else "off"
        -- Key-description-command tuples.
        kds = [ ("+ setup and start new game>", ChallengeMenu, Nothing, Nothing)
              , ("@ save and exit to desktop", GameExit, Nothing, Nothing)
              , ("+ tweak convenience settings>", SettingsMenu, Nothing, Nothing)
              , ("@ toggle autoplay", AutomateToggle, Nothing, Nothing)
              , ("@ see command help", Help, Nothing, Nothing)
              , ("@ switch to dashboard", Dashboard, Nothing, Nothing)
              , ("^ back to playing", AutomateBack, Nothing, Nothing) ]
        gameName = MK.mname gameMode
        displayTutorialHints = fromMaybe curTutorial overrideTut
        gameInfo = map T.unpack
                     [ "Now playing:" <+> gameName
                     , ""
                     , "      with difficulty:" <+> tshow (cdiff curChal)
                     , "            cold fish:" <+> offOn (cfish curChal)
                     , "          ready goods:" <+> offOn (cgoods curChal)
                     , "            lone wolf:" <+> offOn (cwolf curChal)
                     , "        finder keeper:" <+> offOn (ckeeper curChal)
                     , "       tutorial hints:" <+> offOn displayTutorialHints
                     , "" ]
        glueLines (l1 : l2 : rest) =
          if | null l1 -> l1 : glueLines (l2 : rest)
             | null l2 -> l1 : l2 : glueLines rest
             | otherwise -> (l1 ++ l2) : glueLines rest
        glueLines ll = ll
        backstory | isSquareFont propFont = fst rintroScreen
                  | otherwise = glueLines $ fst rintroScreen
        backstoryAL = map (stringToAL . dropWhile (== ' ')) backstory
        blurb = attrLinesToFontMap [(propFont, backstoryAL)]
    generateMenu cmdSemInCxtOfKM blurb kds gameInfo "main"
  
  -- * MainMenuAutoOn
  
  -- | Display the main menu and set @swasAutomated@.
  mainMenuAutoOnHuman :: MonadClientUI m
                      => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                      -> m (Either MError ReqUI)
  mainMenuAutoOnHuman cmdSemInCxtOfKM = do
    modifySession $ \sess -> sess {swasAutomated = True}
    mainMenuHuman cmdSemInCxtOfKM
  
  -- * MainMenuAutoOff
  
  -- | Display the main menu and unset @swasAutomated@.
  mainMenuAutoOffHuman :: MonadClientUI m
                       => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                       -> m (Either MError ReqUI)
  mainMenuAutoOffHuman cmdSemInCxtOfKM = do
    modifySession $ \sess -> sess {swasAutomated = False}
    mainMenuHuman cmdSemInCxtOfKM
  
  -- * SettingsMenu
  
  -- | Display the settings menu.
  settingsMenuHuman :: MonadClientUI m
                    => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                    -> m (Either MError ReqUI)
  settingsMenuHuman cmdSemInCxtOfKM = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    UIOptions{uMsgWrapColumn} <- getsSession sUIOptions
    FontSetup{..} <- getFontSetup
    markSuspect <- getsClient smarkSuspect
    markVision <- getsSession smarkVision
    markSmell <- getsSession smarkSmell
    noAnim <- getsClient $ fromMaybe False . snoAnim . soptions
    side <- getsClient sside
    factDoctrine <- getsState $ gdoctrine . (EM.! side) . sfactionD
    overrideTut <- getsSession soverrideTut
    let offOn b = if b then "on" else "off"
        offOnAll n = case n of
          0 -> "none"
          1 -> "untried"
          2 -> "all"
          _ -> error $ "" `showFailure` n
        neverEver n = case n of
          0 -> "never"
          1 -> "aiming"
          2 -> "always"
          _ -> error $ "" `showFailure` n
        offOnUnset mb = case mb of
          Nothing -> "pass"
          Just b -> if b then "force on" else "force off"
        tsuspect = "@ mark suspect terrain:" <+> offOnAll markSuspect
        tvisible = "@ show visible zone:" <+> neverEver markVision
        tsmell = "@ display smell clues:" <+> offOn markSmell
        tanim = "@ play animations:" <+> offOn (not noAnim)
        tdoctrine = "@ squad doctrine:" <+> Ability.nameDoctrine factDoctrine
        toverride = "@ override tutorial hints:" <+> offOnUnset overrideTut
        width = if isSquareFont propFont
                then rwidth `div` 2
                else min uMsgWrapColumn (rwidth - 2)
        textToBlurb t = Just $ attrLinesToFontMap
          [ ( propFont
            , splitAttrString width width
              $ textToAS t ) ]
        -- Key-description-command-text tuples.
        kds = [ ( tsuspect, MarkSuspect 1, Just (MarkSuspect (-1))
                , textToBlurb "* mark suspect terrain\nThis setting affects the ongoing and the next games. It determines which suspect terrain is marked in special color on the map: none, untried (not searched nor revealed), all. It correspondingly determines which, if any, suspect tiles are considered for mouse go-to, auto-explore and for the command that marks the nearest unexplored position." )
              , ( tvisible, MarkVision 1, Just (MarkVision (-1))
                , textToBlurb "* show visible zone\nThis setting affects the ongoing and the next games. It determines the conditions under which the area visible to the party is marked on the map via a gray background: never, when aiming, always." )
              , ( tsmell, MarkSmell, Just MarkSmell
                , textToBlurb "* display smell clues\nThis setting affects the ongoing and the next games. It determines whether the map displays any smell traces (regardless of who left them) detected by a party member that can track via smell (as determined by the smell radius skill; not common among humans)." )
              , ( tanim, MarkAnim, Just MarkAnim
                , textToBlurb "* play animations\nThis setting affects the ongoing and the next games. It determines whether important events, such combat, are highlighted by animations. This overrides the corresponding config file setting." )
              , ( tdoctrine, Doctrine, Nothing
                , textToBlurb "* squad doctrine\nThis setting affects the ongoing game, but does not persist to the next games. It determines the behaviour of henchmen (non-pointman characters) in the party and, in particular, if they are permitted to move autonomously or fire opportunistically (assuming they are able to, usually due to rare equipment). This setting has a poor UI that will be improved in the future." )
              , ( toverride, OverrideTut 1, Just (OverrideTut (-1))
                , textToBlurb "* override tutorial hints\nThis setting affects the ongoing and the next games. It determines whether tutorial hints are, respectively, not overridden with respect to the default game mode setting, forced to be off, forced to be on. Tutorial hints are rendered as pink messages and can afterwards be re-read from message history." )
              , ( "^ back to main menu", MainMenu, Nothing, Just EM.empty ) ]
        gameInfo = map T.unpack
                     [ "Tweak convenience settings:"
                     , "" ]
    generateMenu cmdSemInCxtOfKM EM.empty kds gameInfo "settings"
  
  -- * ChallengeMenu
  
  -- | Display the challenge menu.
  challengeMenuHuman :: MonadClientUI m
                     => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                     -> m (Either MError ReqUI)
  challengeMenuHuman cmdSemInCxtOfKM = do
    cops <- getsState scops
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    UIOptions{uMsgWrapColumn} <- getsSession sUIOptions
    FontSetup{..} <- getFontSetup
    svictories <- getsSession svictories
    snxtScenario <- getsSession snxtScenario
    nxtChal <- getsClient snxtChal
    let (gameModeId, gameMode) = nxtGameMode cops snxtScenario
        victories = case EM.lookup gameModeId svictories of
          Nothing -> 0
          Just cm -> fromMaybe 0 (M.lookup nxtChal cm)
        star t = if victories > 0 then "*" <> t else t
        tnextScenario = "@ adventure:" <+> star (MK.mname gameMode)
        offOn b = if b then "on" else "off"
        tnextDiff = "@ difficulty level:" <+> tshow (cdiff nxtChal)
        tnextFish = "@ cold fish (rather hard):" <+> offOn (cfish nxtChal)
        tnextGoods = "@ ready goods (hard):" <+> offOn (cgoods nxtChal)
        tnextWolf = "@ lone wolf (very hard):" <+> offOn (cwolf nxtChal)
        tnextKeeper = "@ finder keeper (hard):" <+> offOn (ckeeper nxtChal)
        width = if isSquareFont propFont
                then rwidth `div` 2
                else min uMsgWrapColumn (rwidth - 2)
        widthFull = if isSquareFont propFont
                    then rwidth `div` 2
                    else rwidth - 2
        duplicateEOL '\n' = "\n\n"
        duplicateEOL c = T.singleton c
        blurb = Just $ attrLinesToFontMap
          [ ( propFont
            , splitAttrString width width
              $ textFgToAS Color.BrBlack
              $ T.concatMap duplicateEOL (MK.mdesc gameMode)
                <> "\n\n" )
          , ( propFont
            , splitAttrString widthFull widthFull
              $ textToAS
              $ MK.mrules gameMode
                <> "\n\n" )
          , ( propFont
            , splitAttrString width width
              $ textToAS
              $ T.concatMap duplicateEOL (MK.mreason gameMode) )
          ]
        textToBlurb t = Just $ attrLinesToFontMap
          [ ( propFont
            , splitAttrString width width  -- not widthFull!
              $ textToAS t ) ]
        -- Key-description-command-text tuples.
        kds = [ ( tnextScenario, GameScenarioIncr 1, Just (GameScenarioIncr (-1))
                , blurb )
              , ( tnextDiff, GameDifficultyIncr 1, Just (GameDifficultyIncr (-1))
                , textToBlurb "* difficulty level\nThis determines the difficulty of survival in the next game that's about to be started. Lower numbers result in easier game. In particular, difficulty below 5 multiplies hitpoints of player characters and difficulty over 5 multiplies hitpoints of their enemies. Game score scales with difficulty.")
              , ( tnextFish, GameFishToggle, Just GameFishToggle
                , textToBlurb "* cold fish\nThis challenge mode setting will affect the next game that's about to be started. When on, it makes it impossible for player characters to be healed by actors from other factions (this is a significant restriction in the long crawl adventure).")
              , ( tnextGoods, GameGoodsToggle, Just GameGoodsToggle
                , textToBlurb "* ready goods\nThis challenge mode setting will affect the next game that's about to be started. When on, it disables crafting for the player, making the selection of equipment, especially melee weapons, very limited, unless the player has the luck to find the rare powerful ready weapons (this applies only if the chosen adventure supports crafting at all).")
              , ( tnextWolf, GameWolfToggle, Just GameWolfToggle
                , textToBlurb "* lone wolf\nThis challenge mode setting will affect the next game that's about to be started. When on, it reduces player's starting actors to exactly one, though later on new heroes may join the party. This makes the game very hard in the long run.")
              , ( tnextKeeper, GameKeeperToggle, Just GameKeeperToggle
                , textToBlurb "* finder keeper\nThis challenge mode setting will affect the next game that's about to be started. When on, it completely disables flinging projectiles by the player, which affects not only ranged damage dealing, but also throwing of consumables that buff teammates engaged in melee combat, weaken and distract enemies, light dark corners, etc.")
              , ( "@ start new game", GameRestart, Nothing, blurb )
              , ( "^ back to main menu", MainMenu, Nothing, Nothing ) ]
        gameInfo = map T.unpack [ "Setup and start new game:"
                                , "" ]
    generateMenu cmdSemInCxtOfKM EM.empty kds gameInfo "challenge"
  
  -- * GameDifficultyIncr
  
  gameDifficultyIncr :: MonadClient m => Int -> m ()
  gameDifficultyIncr delta = do
    nxtDiff <- getsClient $ cdiff . snxtChal
    let d | nxtDiff + delta > difficultyBound = 1
          | nxtDiff + delta < 1 = difficultyBound
          | otherwise = nxtDiff + delta
    modifyClient $ \cli -> cli {snxtChal = (snxtChal cli) {cdiff = d} }
  
  -- * GameFishToggle
  
  gameFishToggle :: MonadClient m => m ()
  gameFishToggle =
    modifyClient $ \cli ->
      cli {snxtChal = (snxtChal cli) {cfish = not (cfish (snxtChal cli))} }
  
  -- * GameGoodsToggle
  
  gameGoodsToggle :: MonadClient m => m ()
  gameGoodsToggle =
    modifyClient $ \cli ->
      cli {snxtChal = (snxtChal cli) {cgoods = not (cgoods (snxtChal cli))} }
  
  -- * GameWolfToggle
  
  gameWolfToggle :: MonadClient m => m ()
  gameWolfToggle =
    modifyClient $ \cli ->
      cli {snxtChal = (snxtChal cli) {cwolf = not (cwolf (snxtChal cli))} }
  
  -- * GameKeeperToggle
  
  gameKeeperToggle :: MonadClient m => m ()
  gameKeeperToggle =
    modifyClient $ \cli ->
      cli {snxtChal = (snxtChal cli) {ckeeper = not (ckeeper (snxtChal cli))} }
  
  -- * GameScenarioIncr
  
  gameScenarioIncr :: MonadClientUI m => Int -> m ()
  gameScenarioIncr delta = do
    cops <- getsState scops
    oldScenario <- getsSession snxtScenario
    let snxtScenario = oldScenario + delta
        snxtTutorial = MK.mtutorial $ snd $ nxtGameMode cops snxtScenario
    modifySession $ \sess -> sess {snxtScenario, snxtTutorial}
  
  -- * GameRestart & GameQuit
  
  data ExitStrategy = Restart | Quit
  
  gameExitWithHuman :: MonadClientUI m => ExitStrategy -> m (FailOrCmd ReqUI)
  gameExitWithHuman exitStrategy = do
    snxtChal       <- getsClient snxtChal
    cops           <- getsState scops
    noConfirmsGame <- isNoConfirmsGame
    gameMode       <- getGameMode
    snxtScenario   <- getsSession snxtScenario
    let nxtGameName = MK.mname $ snd $ nxtGameMode cops snxtScenario
        exitReturn x = return $ Right $ ReqUIGameRestart x snxtChal
        displayExitMessage diff =
          displayYesNo ColorBW
          $ diff <+> "progress of the ongoing"
            <+> MK.mname gameMode <+> "game will be lost! Are you sure?"
    ifM (if' noConfirmsGame
             (return True)  -- true case
             (displayExitMessage $ case exitStrategy of  -- false case
                Restart -> "You just requested a new" <+> nxtGameName
                           <+> "game. The "
                Quit -> "If you quit, the "))
        (exitReturn $ case exitStrategy of  -- ifM true case
           Restart ->
             let (mainName, _) = T.span (\c -> Char.isAlpha c || c == ' ')
                                        nxtGameName
             in DefsInternal.GroupName $ T.intercalate " "
                $ take 2 $ T.words mainName
           Quit -> MK.INSERT_COIN)
        (rndToActionUI (oneOf  -- ifM false case
                          [ "yea, would be a pity to leave them to die"
                          , "yea, a shame to get your team stranded" ])
         >>= failWith)
  
  ifM :: Monad m => m Bool -> m b -> m b -> m b
  ifM b t f = do b' <- b; if b' then t else f
  
  if' :: Bool -> p -> p -> p
  if' b t f = if b then t else f
  
  -- * GameDrop
  
  gameDropHuman :: MonadClientUI m => m ReqUI
  gameDropHuman = do
    modifySession $ \sess -> sess {sallNframes = -1}  -- hack, but we crash anyway
    msgAdd MsgPromptGeneric "Interrupt! Trashing the unsaved game. The program exits now."
    clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now."
      -- this is not shown by ANSI frontend, but at least shown by sdl2 one
    return ReqUIGameDropAndExit
  
  -- * GameExit
  
  gameExitHuman :: Monad m => m ReqUI
  gameExitHuman =
    return ReqUIGameSaveAndExit
  
  -- * GameSave
  
  gameSaveHuman :: MonadClientUI m => m ReqUI
  gameSaveHuman = do
    -- Announce before the saving started, since it can take a while.
    msgAdd MsgInnerWorkSpam "Saving game backup."
    return ReqUIGameSave
  
  -- * Doctrine
  
  -- Note that the difference between seek-target and follow-the-leader doctrine
  -- can influence even a faction with passive actors. E.g., if a passive actor
  -- has an extra active skill from equipment, he moves every turn.
  doctrineHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
  doctrineHuman = do
    fid <- getsClient sside
    fromT <- getsState $ gdoctrine . (EM.! fid) . sfactionD
    let toT = if fromT == maxBound then minBound else succ fromT
    go <- displaySpaceEsc ColorFull
          $ "(Beware, work in progress!)"
            <+> "Current squad doctrine is '" <> Ability.nameDoctrine fromT <> "'"
            <+> "(" <> Ability.describeDoctrine fromT <> ")."
            <+> "Switching doctrine to '" <> Ability.nameDoctrine toT <> "'"
            <+> "(" <> Ability.describeDoctrine toT <> ")."
            <+> "This clears targets of all non-pointmen teammates."
            <+> "New targets will be picked according to new doctrine."
    if not go
    then failWith "squad doctrine change canceled"
    else return $ Right $ ReqUIDoctrine toT
  
  -- * Automate
  
  automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
  automateHuman = do
    clearAimMode
    proceed <- displayYesNo ColorBW "Do you really want to cede control to AI?"
    if not proceed
    then failWith "automation canceled"
    else return $ Right ReqUIAutomate
  
  -- * AutomateToggle
  
  automateToggleHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
  automateToggleHuman = do
    swasAutomated <- getsSession swasAutomated
    if swasAutomated
    then failWith "automation canceled"
    else automateHuman
  
  -- * AutomateBack
  
  automateBackHuman :: MonadClientUI m => m (Either MError ReqUI)
  automateBackHuman = do
    swasAutomated <- getsSession swasAutomated
    return $! if swasAutomated
              then Right ReqUIAutomate
              else Left Nothing
  