    -- | 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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI)
    byAreaHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM [(CmdArea, HumanCmd)]
    l = do
      CCUI{coinput=InputContent{brevMap}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      pUI <- getsSession spointer
      let PointSquare px py = uiToSquare pUI
          p = Point {Int
    px :: Int
    py :: Int
    py :: Int
    px :: Int
    ..}  -- abuse of convention: @Point@, not @PointSquare@ used
                          -- for the whole UI screen in square font coordinates
          pointerInArea CmdArea
    a = do
            rs <- CmdArea -> m [Maybe Area]
    forall (m :: * -> *). MonadClientUI m => CmdArea -> m [Maybe Area]
    areaToRectangles CmdArea
    a
            return $! any (`inside` p) $ catMaybes rs
      cmds <- filterM (pointerInArea . fst) l
      case cmds of
        [] -> do
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    stopPlayBack
          Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
        (CmdArea
    _, HumanCmd
    cmd) : [(CmdArea, HumanCmd)]
    _ -> do
          let kmFound :: KM
    kmFound = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup HumanCmd
    cmd Map HumanCmd [KM]
    brevMap of
                Just (KM
    km : [KM]
    _) -> KM
    km
                Maybe [KM]
    _ -> KM
    K.escKM
          KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    kmFound HumanCmd
    cmd

    -- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM".
    areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]
    areaToRectangles :: forall (m :: * -> *). MonadClientUI m => CmdArea -> m [Maybe Area]
    areaToRectangles CmdArea
    ca = ((Int, Int, Int, Int) -> Maybe Area)
    -> [(Int, Int, Int, Int)] -> [Maybe Area]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Int, Int, Int) -> Maybe Area
    toArea ([(Int, Int, Int, Int)] -> [Maybe Area])
    -> m [(Int, Int, Int, Int)] -> m [Maybe Area]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
     CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
     case ca of
      CmdArea
    CaMessage -> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    0, Int
    0, Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    0)]
      CmdArea
    CaMapLeader -> do  -- takes preference over @CaMapParty@ and @CaMap@
        mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> Maybe ActorId
    sleader
        case mleader of
          Maybe ActorId
    Nothing -> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          Just ActorId
    leader -> do
            b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
            let PointSquare x y = mapToSquare $ bpos b
            return [(x, y, x, y)]
      CmdArea
    CaMapParty -> do  -- takes preference over @CaMap@
        lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
        side <- getsClient sside
        ours <- getsState $ filter (not . bproj) . map snd
                            . actorAssocs (== side) lidV
        let rectFromB Point
    p = let PointSquare Int
    x Int
    y = Point -> PointSquare
    mapToSquare Point
    p
                          in (Int
    x, Int
    y, Int
    x, Int
    y)
        return $! map (rectFromB . bpos) ours
      CmdArea
    CaMap ->
        let PointSquare Int
    xo Int
    yo = Point -> PointSquare
    mapToSquare Point
    originPoint
            PointSquare Int
    xe Int
    ye = Point -> PointSquare
    mapToSquare (Point -> PointSquare) -> Point -> PointSquare
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Point
    Point (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4)
        in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    xo, Int
    yo, Int
    xe, Int
    ye)]
      CmdArea
    CaLevelNumber -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
                       in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    0, Int
    y, Int
    1, Int
    y)]
      CmdArea
    CaArenaName -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
                         x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    11
                     in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    3, Int
    y, Int
    x, Int
    y)]
      CmdArea
    CaPercentSeen -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
                           x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                       in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    9, Int
    y, Int
    x, Int
    y)]
      CmdArea
    CaXhairDesc -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
                         x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                     in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x, Int
    y, Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    y)]
      CmdArea
    CaSelected -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                        x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                    in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    0, Int
    y, Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    24, Int
    y)]
      CmdArea
    CaCalmGauge -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                         x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                     in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    22, Int
    y, Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    18, Int
    y)]
      CmdArea
    CaCalmValue -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                         x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                     in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    17, Int
    y, Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    11, Int
    y)]
      CmdArea
    CaHPGauge -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                       x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                   in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    9, Int
    y, Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    6, Int
    y)]
      CmdArea
    CaHPValue -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                       x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                   in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    6, Int
    y, Int
    x, Int
    y)]
      CmdArea
    CaLeaderDesc -> let y :: Int
    y = Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                          x :: Int
    x = (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                      in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Int
    x, Int
    y, Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    y)]

    -- * ByAimMode

    byAimModeHuman :: MonadClientUI m
                   => m (Either MError ReqUI) -> m (Either MError ReqUI)
                   -> m (Either MError ReqUI)
    byAimModeHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI)
    -> m (Either MError ReqUI) -> m (Either MError ReqUI)
    byAimModeHuman m (Either MError ReqUI)
    cmdNotAimingM m (Either MError ReqUI)
    cmdAimingM = do
      aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      if isNothing aimMode then cmdNotAimingM else cmdAimingM

    -- * ComposeIfLocal

    composeIfLocalHuman :: MonadClientUI m
                        => m (Either MError ReqUI) -> m (Either MError ReqUI)
                        -> m (Either MError ReqUI)
    composeIfLocalHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI)
    -> m (Either MError ReqUI) -> m (Either MError ReqUI)
    composeIfLocalHuman m (Either MError ReqUI)
    c1 m (Either MError ReqUI)
    c2 = do
      slideOrCmd1 <- m (Either MError ReqUI)
    c1
      case slideOrCmd1 of
        Left MError
    merr1 -> do
          slideOrCmd2 <- m (Either MError ReqUI)
    c2
          case slideOrCmd2 of
            Left MError
    merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
    forall a b. (a -> b) -> a -> b
    $ MError -> MError -> MError
    mergeMError MError
    merr1 MError
    merr2
            Either MError ReqUI
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    slideOrCmd2
        Either MError ReqUI
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    slideOrCmd1

    -- * ComposeUnlessError

    composeUnlessErrorHuman :: MonadClientUI m
                            => m (Either MError ReqUI) -> m (Either MError ReqUI)
                            -> m (Either MError ReqUI)
    composeUnlessErrorHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI)
    -> m (Either MError ReqUI) -> m (Either MError ReqUI)
    composeUnlessErrorHuman m (Either MError ReqUI)
    c1 m (Either MError ReqUI)
    c2 = do
      slideOrCmd1 <- m (Either MError ReqUI)
    c1
      case slideOrCmd1 of
        Left MError
    Nothing -> m (Either MError ReqUI)
    c2
        Either MError ReqUI
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    slideOrCmd1

    -- * Compose2ndLocal

    compose2ndLocalHuman :: MonadClientUI m
                         => m (Either MError ReqUI) -> m (Either MError ReqUI)
                         -> m (Either MError ReqUI)
    compose2ndLocalHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI)
    -> m (Either MError ReqUI) -> m (Either MError ReqUI)
    compose2ndLocalHuman m (Either MError ReqUI)
    c1 m (Either MError ReqUI)
    c2 = do
      slideOrCmd1 <- m (Either MError ReqUI)
    c1
      case slideOrCmd1 of
        Left MError
    merr1 -> do
          slideOrCmd2 <- m (Either MError ReqUI)
    c2
          case slideOrCmd2 of
            Left MError
    merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
    forall a b. (a -> b) -> a -> b
    $ MError -> MError -> MError
    mergeMError MError
    merr1 MError
    merr2
            Either MError ReqUI
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    slideOrCmd1  -- ignore second request, keep effect
        Either MError ReqUI
    req -> do
          m (Either MError ReqUI) -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void m (Either MError ReqUI)
    c2  -- ignore second request, keep effect
          Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    req

    -- * LoopOnNothing

    loopOnNothingHuman :: MonadClientUI m
                       => m (Either MError ReqUI)
                       -> m (Either MError ReqUI)
    loopOnNothingHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI) -> m (Either MError ReqUI)
    loopOnNothingHuman m (Either MError ReqUI)
    cmd = do
      res <- m (Either MError ReqUI)
    cmd
      case res of
        Left MError
    Nothing -> m (Either MError ReqUI) -> m (Either MError ReqUI)
    forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI) -> m (Either MError ReqUI)
    loopOnNothingHuman m (Either MError ReqUI)
    cmd
        Either MError ReqUI
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either MError ReqUI
    res

    -- * ExecuteIfClear

    executeIfClearHuman :: MonadClientUI m
                        => m (Either MError ReqUI)
                        -> m (Either MError ReqUI)
    executeIfClearHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    m (Either MError ReqUI) -> m (Either MError ReqUI)
    executeIfClearHuman m (Either MError ReqUI)
    c1 = do
      sreportNull <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    waitHuman ActorId
    leader = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      if Ability.getSk Ability.SkWait actorCurAndMaxSk > 0 then do
        modifySession $ \SessionUI
    sess -> SessionUI
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    waitHuman10 ActorId
    leader = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      if Ability.getSk Ability.SkWait actorCurAndMaxSk >= 4 then do
        modifySession $ \SessionUI
    sess -> SessionUI
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    yellHuman ActorId
    leader = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      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 :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    moveRunHuman ActorId
    leader Bool
    initialStep Bool
    finalGoal Bool
    run Bool
    runAhead Vector
    dir = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      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 Bool
    runAhead Bool -> Bool -> Bool
    || Faction -> Bool
    noRunWithMulti Faction
    fact
                       then [ActorId
    leader]
                       else EnumSet ActorId -> [ActorId]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (ActorId -> EnumSet ActorId -> EnumSet ActorId
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.delete ActorId
    leader EnumSet ActorId
    sel) [ActorId] -> [ActorId] -> [ActorId]
    forall a. [a] -> [a] -> [a]
    ++ [ActorId
    leader]
          runParams = RunParams { runLeader :: ActorId
    runLeader = ActorId
    leader
                                , [ActorId]
    runMembers :: [ActorId]
    runMembers :: [ActorId]
    runMembers
                                , runInitial :: Bool
    runInitial = Bool
    True
                                , runStopMsg :: Maybe Text
    runStopMsg = Maybe Text
    forall a. Maybe a
    Nothing
                                , runWaiting :: Int
    runWaiting = Int
    0 }
          initRunning = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    initialStep Bool -> Bool -> Bool
    && Bool
    run) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
              SessionUI
    sess {srunning = Just runParams}
            Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    runAhead (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> m ()
    forall (m :: * -> *). MonadClientUI m => [String] -> m ()
    macroHuman [String]
    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 = Actor -> Point
    bpos Actor
    sb Point -> Vector -> Point
    `shift` Vector
    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 <- ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
    moveSearchAlter ActorId
    leader Bool
    run Vector
    dir
          case runStopOrCmd of
            Left FailError
    stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd RequestTimed
    forall a b. a -> Either a b
    Left FailError
    stopMsg
            Right RequestTimed
    runCmd -> do
              -- Don't check @initialStep@ and @finalGoal@
              -- and don't stop going to target: door opening is mundane enough.
              m ()
    initRunning
              FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right RequestTimed
    runCmd
        [(ActorId
    target, Actor
    _)] | Bool
    run
                        Bool -> Bool -> Bool
    && Bool
    initialStep
                        Bool -> Bool -> Bool
    && Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkDisplace Skills
    actorCurAndMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->
          -- No @stopPlayBack@: initial displace is benign enough.
          -- Displacing requires accessibility, but it's checked later on.
          ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    displaceAid ActorId
    leader ActorId
    target
        (ActorId, Actor)
    _ : (ActorId, Actor)
    _ : [(ActorId, Actor)]
    _ | Bool
    run
                    Bool -> Bool -> Bool
    && Bool
    initialStep
                    Bool -> Bool -> Bool
    && Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkDisplace Skills
    actorCurAndMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->
          ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    DisplaceMultiple
        (ActorId
    target, Actor
    tb) : [(ActorId, Actor)]
    _ | Bool -> Bool
    not Bool
    run
                           Bool -> Bool -> Bool
    && Bool
    initialStep Bool -> Bool -> Bool
    && Bool
    finalGoal
                           Bool -> Bool -> Bool
    && Actor -> FactionId
    bfid Actor
    tb FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> FactionId
    bfid Actor
    sb Bool -> Bool -> Bool
    && Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    tb) -> do
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    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 <- Bool -> ActorId -> m Bool
    forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
    pickLeader Bool
    True ActorId
    target
          let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool
    success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "bump self"
                                    String
    -> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    leader, ActorId
    target, Actor
    tb)) ()
          failWith "the pointman switched by bumping"
        (ActorId
    target, Actor
    tb) : [(ActorId, Actor)]
    _ | Bool -> Bool
    not Bool
    run
                           Bool -> Bool -> Bool
    && Bool
    initialStep Bool -> Bool -> Bool
    && Bool
    finalGoal
                           Bool -> Bool -> Bool
    && (Actor -> FactionId
    bfid Actor
    tb FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Actor -> FactionId
    bfid Actor
    sb Bool -> Bool -> Bool
    || Actor -> Bool
    bproj Actor
    tb) -> do
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    stopPlayBack  -- don't ever auto-repeat melee
          if Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMelee Skills
    actorCurAndMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
          then -- No problem if there are many projectiles at the spot. We just
               -- attack the first one.
               ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    meleeAid ActorId
    leader ActorId
    target
          else ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    MeleeUnskilled
        (ActorId, Actor)
    _ : [(ActorId, Actor)]
    _ -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "actor in the way"

    -- | Actor attacks an enemy actor or his own projectile.
    meleeAid :: (MonadClient m, MonadClientUI m)
             => ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    meleeAid :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    meleeAid ActorId
    leader ActorId
    target = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      tb <- getsState $ getActorBody target
      sfact <- getsState $ (EM.! side) . sfactionD
      mel <- pickWeaponClient leader target
      case mel of
        Maybe RequestTimed
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "nothing to melee with"
        Just RequestTimed
    wp -> do
          let returnCmd :: m (FailOrCmd RequestTimed)
    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.
                (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
    updateTarget ActorId
    leader ((Maybe Target -> Maybe Target) -> StateClient -> StateClient)
    -> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
    forall a b. (a -> b) -> a -> b
    $ Maybe Target -> Maybe Target -> Maybe Target
    forall a b. a -> b -> a
    const (Maybe Target -> Maybe Target -> Maybe Target)
    -> Maybe Target -> Maybe Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Target
    TEnemy ActorId
    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.
                (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sxhair = Just $ TEnemy target}
                FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right RequestTimed
    wp
              res :: m (FailOrCmd RequestTimed)
    res | Actor -> Bool
    bproj Actor
    tb Bool -> Bool -> Bool
    || FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    side Faction
    sfact (Actor -> FactionId
    bfid Actor
    tb) = m (FailOrCmd RequestTimed)
    returnCmd
                  | FactionId -> Faction -> FactionId -> Bool
    isFriend FactionId
    side Faction
    sfact (Actor -> FactionId
    bfid Actor
    tb) = do
                    let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (FactionId
    side FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Actor -> FactionId
    bfid Actor
    tb) ()
                    go1 <- ColorMode -> Text -> m Bool
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displayYesNo ColorMode
    ColorBW
                             Text
    "You are bound by an alliance. Really attack?"
                    if not go1 then failWith "attack canceled" else returnCmd
                  | Bool
    otherwise = do
                    go2 <- ColorMode -> Text -> m Bool
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displayYesNo ColorMode
    ColorBW
                             Text
    "This attack will start a war. Are you sure?"
                    if not go2 then failWith "attack canceled" else returnCmd
          m (FailOrCmd RequestTimed)
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> ActorId -> m (FailOrCmd RequestTimed)
    displaceAid ActorId
    leader ActorId
    target = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      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 = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMove Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0
          tpos = Actor -> Point
    bpos Actor
    tb
          adj = Actor -> Actor -> Bool
    checkAdjacent Actor
    sb Actor
    tb
          atWar = FactionId -> Faction -> FactionId -> Bool
    isFoe (Actor -> FactionId
    bfid Actor
    tb) Faction
    tfact (Actor -> FactionId
    bfid Actor
    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 = Actor -> LevelId
    blid Actor
    sb
           lvl <- getLevel lid
           -- Displacing requires full access.
           if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then
             case posToAidsLvl tpos lvl of
               [] -> String -> m (FailOrCmd RequestTimed)
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (FailOrCmd RequestTimed))
    -> String -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ActorId, Actor, ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    leader, Actor
    sb, ActorId
    target, Actor
    tb)
               [ActorId
    _] -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (RequestTimed -> FailOrCmd RequestTimed)
    -> RequestTimed -> FailOrCmd RequestTimed
    forall a b. (a -> b) -> a -> b
    $ ActorId -> RequestTimed
    ReqDisplace ActorId
    target
               [ActorId]
    _ -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
    moveSearchAlter ActorId
    leader Bool
    run Vector
    dir = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      sb <- getsState $ getActorBody leader
      let moveSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMove Skills
    actorCurAndMaxSk
          spos = Actor -> Point
    bpos Actor
    sb           -- source position
          tpos = Point
    spos Point -> Vector -> Point
    `shift` Vector
    dir  -- target position
      alterable <- getsState $ tileAlterable (blid sb) tpos
      lvl <- getLevel $ blid sb
      let t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    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 = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown (Actor -> LevelId
    blid Actor
    sb) Point
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
    alterCommon ActorId
    leader Bool
    bumping Point
    tpos = do
      CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      cops@COps{cotile, coTileSpeedup} <- getsState scops
      side <- getsClient sside
      factionD <- getsState sfactionD
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      sb <- getsState $ getActorBody leader
      let alterSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkAlter Skills
    actorCurAndMaxSk
          spos = Actor -> Point
    bpos Actor
    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 = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          underFeet = Point
    tpos Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    spos  -- if enter and alter, be more permissive
          modificationFailureHint = MsgClassShowAndSave -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShowAndSave
    MsgTutorialHint Text
    "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 = Text -> Part
    MU.Text (Text -> Part) -> Text -> Part
    forall a b. (a -> b) -> a -> b
    $ TileKind -> Text
    TK.tname (TileKind -> Text) -> TileKind -> Text
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    t
                 itemLook (ItemId
    iid, kit :: (Int, ItemTimers)
    kit@(Int
    k, ItemTimers
    _)) =
                   let itemFull :: ItemFull
    itemFull = ItemId -> ItemFull
    itemToF ItemId
    iid
                   in Int
    -> FactionId
    -> EnumMap FactionId Faction
    -> Int
    -> Time
    -> ItemFull
    -> (Int, ItemTimers)
    -> Part
    partItemWsShort Int
    rwidth FactionId
    side EnumMap FactionId Faction
    factionD Int
    k Time
    localTime ItemFull
    itemFull (Int, ItemTimers)
    kit
                 embedKindList =
                   ((ItemId, (Int, ItemTimers))
     -> (ItemKind, (ItemId, (Int, ItemTimers))))
    -> [(ItemId, (Int, ItemTimers))]
    -> [(ItemKind, (ItemId, (Int, ItemTimers)))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ItemId
    iid, (Int, ItemTimers)
    kit) -> (ItemId -> ItemKind
    getKind ItemId
    iid, (ItemId
    iid, (Int, ItemTimers)
    kit))) (ItemBag -> [(ItemId, (Int, ItemTimers))]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs ItemBag
    embeds)
                 ilooks = ((ItemId, (Int, ItemTimers)) -> Part)
    -> [(ItemId, (Int, ItemTimers))] -> [Part]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemId, (Int, ItemTimers)) -> Part
    itemLook ([(ItemId, (Int, ItemTimers))] -> [Part])
    -> [(ItemId, (Int, ItemTimers))] -> [Part]
    forall a b. (a -> b) -> a -> b
    $ COps
    -> ContentId TileKind
    -> [(ItemKind, (ItemId, (Int, ItemTimers)))]
    -> [(ItemId, (Int, ItemTimers))]
    sortEmbeds COps
    cops ContentId TileKind
    t [(ItemKind, (ItemId, (Int, ItemTimers)))]
    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 Bool
    bumping then
                   FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (RequestTimed -> FailOrCmd RequestTimed)
    -> RequestTimed -> FailOrCmd RequestTimed
    forall a b. (a -> b) -> a -> b
    $ Vector -> RequestTimed
    ReqMove (Vector -> RequestTimed) -> Vector -> RequestTimed
    forall a b. (a -> b) -> a -> b
    $ Point -> Point -> Vector
    vectorToFrom Point
    tpos Point
    spos
                 else do
                   Bool -> ActorId -> Point -> Text -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> ActorId -> Point -> Text -> m ()
    msgAddDone Bool
    False ActorId
    leader Point
    tpos Text
    "modify"
                   FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (RequestTimed -> FailOrCmd RequestTimed)
    -> RequestTimed -> FailOrCmd RequestTimed
    forall a b. (a -> b) -> a -> b
    $ Point -> RequestTimed
    ReqAlter Point
    tpos
               Left FailError
    err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd RequestTimed
    forall a b. a -> Either a b
    Left FailError
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (Either MError RequestTimed)
    runOnceAheadHuman ActorId
    leader = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      fact <- getsState $ (EM.! side) . sfactionD
      keyPressed <- anyKeyPressed
      srunning <- getsSession srunning
      -- When running, stop if disturbed. If not running, stop at once.
      case srunning of
        Maybe RunParams
    Nothing -> do
          MsgClassIgnore -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassIgnore
    MsgRunStopReason Text
    "run stop: nothing to do"
          Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError RequestTimed -> m (Either MError RequestTimed))
    -> Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError RequestTimed
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
        Just RunParams{[ActorId]
    runMembers :: RunParams -> [ActorId]
    runMembers :: [ActorId]
    runMembers}
          | Faction -> Bool
    noRunWithMulti Faction
    fact Bool -> Bool -> Bool
    && [ActorId]
    runMembers [ActorId] -> [ActorId] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [ActorId
    leader] -> do
          MsgClassIgnore -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassIgnore
    MsgRunStopReason Text
    "run stop: automatic pointman change"
          Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError RequestTimed -> m (Either MError RequestTimed))
    -> Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError RequestTimed
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
        Just RunParams
    _runParams | Bool
    keyPressed -> do
          m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    discardPressedKey
          MsgClassIgnore -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassIgnore
    MsgRunStopReason Text
    "run stop: key pressed"
          FailOrCmd RequestTimed -> Either MError RequestTimed
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd RequestTimed -> Either MError RequestTimed)
    -> m (FailOrCmd RequestTimed) -> m (Either MError RequestTimed)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "interrupted"
        Just RunParams
    runParams -> do
          arena <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    getArenaUI
          runOutcome <- continueRun arena runParams
          case runOutcome of
            Left Text
    stopMsg -> do
              MsgClassIgnore -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassIgnore
    MsgRunStopReason (Text
    "run stop:" Text -> Text -> Text
    <+> Text
    stopMsg)
              Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError RequestTimed -> m (Either MError RequestTimed))
    -> Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError RequestTimed
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
            Right RequestTimed
    runCmd ->
              Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError RequestTimed -> m (Either MError RequestTimed))
    -> Either MError RequestTimed -> m (Either MError RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> Either MError RequestTimed
    forall a b. b -> Either a b
    Right RequestTimed
    runCmd

    -- * MoveOnceToXhair

    moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                         => ActorId -> m (FailOrCmd RequestTimed)
    moveOnceToXhairHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m (FailOrCmd RequestTimed)
    moveOnceToXhairHuman ActorId
    leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhair ActorId
    leader Bool
    True Bool
    False

    goToXhair :: (MonadClient m, MonadClientUI m)
              => ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhair :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhair ActorId
    leader Bool
    initialStep Bool
    run = do
      aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe AimMode
    saimMode
      -- 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 :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhairExplorationMode ActorId
    leader Bool
    initialStep Bool
    run = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      sb <- getsState $ getActorBody leader
      let moveSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMove Skills
    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 $ \SessionUI
    sess -> SessionUI
    sess {sxhairGoTo = xhair}
               goToXhairGoTo leader initialStep run
           when (isLeft mfail) $
             modifySession $ \SessionUI
    sess -> SessionUI
    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 :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhairGoTo ActorId
    leader Bool
    initialStep Bool
    run = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      mxhairPos <- mxhairToPos
      case mxhairPos of
        Maybe Point
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "crosshair position invalid"
        Just Point
    c -> do
          running <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Maybe RunParams
    srunning
          case running of
            -- Don't use running params from previous run or goto-xhair.
            Just RunParams
    paramOld | Bool -> Bool
    not Bool
    initialStep -> do
              arena <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    getArenaUI
              runOutcome <- multiActorGoTo arena c paramOld
              case runOutcome of
                Left FailError
    stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd RequestTimed
    forall a b. a -> Either a b
    Left FailError
    stopMsg
                Right (Bool
    finalGoal, Vector
    dir) ->
                  ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    moveRunHuman ActorId
    leader Bool
    initialStep Bool
    finalGoal Bool
    run Bool
    False Vector
    dir
            Maybe RunParams
    _ | Point
    c Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    b -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "position reached"
            Maybe RunParams
    _ -> do
              let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool
    initialStep Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    run) ()
              (bfs, mpath) <- ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
    forall (m :: * -> *).
    MonadClient m =>
    ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
    getCacheBfsAndPath ActorId
    leader Point
    c
              xhairMoused <- getsSession sxhairMoused
              case mpath of
                Maybe AndPath
    _ | Bool
    xhairMoused Bool -> Bool -> Bool
    && Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isNothing (Array BfsDistance -> Point -> Maybe Int
    accessBfs Array BfsDistance
    bfs Point
    c) ->
                  Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith
                    Text
    "no route to crosshair (press again to go there anyway)"
                Maybe AndPath
    _ | Bool
    initialStep Bool -> Bool -> Bool
    && Point -> Point -> Bool
    adjacent (Actor -> Point
    bpos Actor
    b) Point
    c -> do
                  let dir :: Vector
    dir = Point -> Point -> Vector
    towards (Actor -> Point
    bpos Actor
    b) Point
    c
                  ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    moveRunHuman ActorId
    leader Bool
    initialStep Bool
    True Bool
    run Bool
    False Vector
    dir
                Maybe AndPath
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no route to crosshair"
                Just AndPath{pathList :: AndPath -> [Point]
    pathList=[]} -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "almost there"
                Just AndPath{pathList :: AndPath -> [Point]
    pathList = Point
    p1 : [Point]
    _} -> do
                  let finalGoal :: Bool
    finalGoal = Point
    p1 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    c
                      dir :: Vector
    dir = Point -> Point -> Vector
    towards (Actor -> Point
    bpos Actor
    b) Point
    p1
                  ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Vector
    -> m (FailOrCmd RequestTimed)
    moveRunHuman ActorId
    leader Bool
    initialStep Bool
    finalGoal Bool
    run Bool
    False Vector
    dir

    multiActorGoTo :: (MonadClient m, MonadClientUI m)
                   => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
    multiActorGoTo :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
    multiActorGoTo LevelId
    arena Point
    c RunParams
    paramOld =
      case RunParams
    paramOld of
        RunParams{runMembers :: RunParams -> [ActorId]
    runMembers = []} -> Text -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "selected actors no longer there"
        RunParams{runMembers :: RunParams -> [ActorId]
    runMembers = ActorId
    r : [ActorId]
    rs, Int
    runWaiting :: RunParams -> Int
    runWaiting :: Int
    runWaiting} -> do
          onLevel <- (State -> Bool) -> m Bool
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
    forall a b. (a -> b) -> a -> b
    $ ActorId -> LevelId -> State -> Bool
    memActor ActorId
    r LevelId
    arena
          b <- getsState $ getActorBody r
          mxhairPos <- mxhairToPos
          if not onLevel || mxhairPos == Just (bpos b) then do
            let paramNew = RunParams
    paramOld {runMembers = rs}
            multiActorGoTo arena c paramNew
          else do
            sL <- getState
            modifyClient $ updateLeader r sL
            let runMembersNew = [ActorId]
    rs [ActorId] -> [ActorId] -> [ActorId]
    forall a. [a] -> [a] -> [a]
    ++ [ActorId
    r]
                paramNew = RunParams
    paramOld { runMembers = runMembersNew
                                    , runWaiting = 0}
            (bfs, mpath) <- getCacheBfsAndPath r c
            xhairMoused <- getsSession sxhairMoused
            case mpath of
              Maybe AndPath
    _ | Bool
    xhairMoused Bool -> Bool -> Bool
    && Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isNothing (Array BfsDistance -> Point -> Maybe Int
    accessBfs Array BfsDistance
    bfs Point
    c) ->
                Text -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no route to crosshair (press again to go there anyway)"
              Maybe AndPath
    Nothing -> Text -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no route to crosshair"
              Just AndPath{pathList :: AndPath -> [Point]
    pathList=[]} -> Text -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "almost there"
              Just AndPath{pathList :: AndPath -> [Point]
    pathList = Point
    p1 : [Point]
    _} -> do
                let finalGoal :: Bool
    finalGoal = Point
    p1 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    c
                    dir :: Vector
    dir = Point -> Point -> Vector
    towards (Actor -> Point
    bpos Actor
    b) Point
    p1
                tgts <- (State -> [ActorId]) -> m [ActorId]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [ActorId]) -> m [ActorId])
    -> (State -> [ActorId]) -> m [ActorId]
    forall a b. (a -> b) -> a -> b
    $ Point -> LevelId -> State -> [ActorId]
    posToAids Point
    p1 LevelId
    arena
                case tgts of
                  [] -> do
                    (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {srunning = Just paramNew}
                    FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector)))
    -> FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
    forall a b. (a -> b) -> a -> b
    $ (Bool, Vector) -> FailOrCmd (Bool, Vector)
    forall a b. b -> Either a b
    Right (Bool
    finalGoal, Vector
    dir)
                  [ActorId
    target] | ActorId
    target ActorId -> [ActorId] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ActorId]
    rs Bool -> Bool -> Bool
    || Int
    runWaiting Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [ActorId] -> Int
    forall a. [a] -> Int
    length [ActorId]
    rs ->
                    -- Let r wait until all others move. Mark it in runWaiting
                    -- to avoid cycles. When all wait for each other, fail.
                    LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
    multiActorGoTo LevelId
    arena Point
    c RunParams
    paramNew{runWaiting=runWaiting + 1}
                  [ActorId]
    _ ->
                    Text -> m (FailOrCmd (Bool, Vector))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "collective running finished"  -- usually OK

    -- * RunOnceToXhair

    runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                        => ActorId -> m (FailOrCmd RequestTimed)
    runOnceToXhairHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m (FailOrCmd RequestTimed)
    runOnceToXhairHuman ActorId
    leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhair ActorId
    leader Bool
    True Bool
    True

    -- * ContinueToXhair

    continueToXhairHuman :: (MonadClient m, MonadClientUI m)
                         => ActorId -> m (FailOrCmd RequestTimed)
    continueToXhairHuman :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m (FailOrCmd RequestTimed)
    continueToXhairHuman ActorId
    leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
    goToXhair ActorId
    leader Bool
    False Bool
    False{-irrelevant-}

    -- * MoveItem

    moveItemHuman :: forall m. MonadClientUI m
                  => ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
                  -> m (FailOrCmd RequestTimed)
    moveItemHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    moveItemHuman ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto = do
      let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (CStore
    destCStore CStore -> [CStore] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [CStore]
    stores) ()
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    moveOrSelectItem ActorId
    leader [CStore]
    storesRaw CStore
    destCStore Maybe Text
    mverb Bool
    auto = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
          overStash = Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
          stores = case [CStore]
    storesRaw of
            CStore
    CEqp : rest :: [CStore]
    rest@(CStore
    _ : [CStore]
    _) | Bool -> Bool
    not Bool
    calmE -> [CStore]
    rest [CStore] -> [CStore] -> [CStore]
    forall a. [a] -> [a] -> [a]
    ++ [CStore
    CEqp]
            CStore
    CGround : rest :: [CStore]
    rest@(CStore
    _ : [CStore]
    _) | Bool
    overStash -> [CStore]
    rest [CStore] -> [CStore] -> [CStore]
    forall a. [a] -> [a] -> [a]
    ++ [CStore
    CGround]
            [CStore]
    _ -> [CStore]
    storesRaw
      itemSel <- getsSession sitemSel
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sitemSel = Nothing}  -- prevent surprise
      case itemSel of
        Maybe (ItemId, CStore, Bool)
    _ | [CStore]
    stores [CStore] -> [CStore] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [CStore
    CGround] Bool -> Bool -> Bool
    && Bool
    overStash ->
          Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "you can't loot items from your own stash"
        Just (ItemId
    _, fromCStore :: CStore
    fromCStore@CStore
    CEqp, Bool
    _) | CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    destCStore
                                       Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore]
    stores
                                       Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    calmE ->
          Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "neither the selected item nor any other can be unequipped"
        Just (ItemId
    _, fromCStore :: CStore
    fromCStore@CStore
    CGround, Bool
    _) | CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    destCStore
                                          Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore]
    stores
                                          Bool -> Bool -> Bool
    && Bool
    overStash ->
          Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "you vainly paw through your own hoard"
        Just (ItemId
    iid, CStore
    fromCStore, Bool
    _) | CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    destCStore
                                    Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore]
    stores -> do
          bag <- (State -> ItemBag) -> m ItemBag
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemBag) -> m ItemBag)
    -> (State -> ItemBag) -> m ItemBag
    forall a b. (a -> b) -> a -> b
    $ Actor -> CStore -> State -> ItemBag
    getBodyStoreBag Actor
    b CStore
    fromCStore
          case iid `EM.lookup` bag of
            Maybe (Int, ItemTimers)
    Nothing ->  -- the case of old selection or selection from another actor
              ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    moveOrSelectItem ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto
            Just (Int
    k, ItemTimers
    it) -> Bool -> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed))
    -> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ do
              let eqpFree :: Int
    eqpFree = Actor -> Int
    eqpFreeN Actor
    b
                  kToPick :: Int
    kToPick | CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    eqpFree Int
    k
                          | Bool
    otherwise = Int
    k
              if | CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    calmE -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    ItemNotCalm
                 | CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CGround Bool -> Bool -> Bool
    && Bool
    overStash -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    ItemOverStash
                 | Int
    kToPick Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no more items can be equipped"
                 | Bool
    otherwise -> do
                   socK <- Bool -> Int -> m (Either MError Int)
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> Int -> m (Either MError Int)
    pickNumber (Bool -> Bool
    not Bool
    auto) Int
    kToPick
                   case socK of
                     Left MError
    Nothing ->
                       ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    moveOrSelectItem ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto
                     Left (Just FailError
    err) -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd RequestTimed
    forall a b. a -> Either a b
    Left FailError
    err
                     Right Int
    kChosen ->
                       let is :: (CStore, [(ItemId, (Int, ItemTimers))])
    is = (CStore
    fromCStore, [(ItemId
    iid, (Int
    kChosen, Int -> ItemTimers -> ItemTimers
    forall a. Int -> [a] -> [a]
    take Int
    kChosen ItemTimers
    it))])
                       in RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (RequestTimed -> FailOrCmd RequestTimed)
    -> m RequestTimed -> m (FailOrCmd RequestTimed)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ActorId
    -> [CStore]
    -> (CStore, [(ItemId, (Int, ItemTimers))])
    -> CStore
    -> m RequestTimed
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> (CStore, [(ItemId, (Int, ItemTimers))])
    -> CStore
    -> m RequestTimed
    moveItems ActorId
    leader [CStore]
    stores (CStore, [(ItemId, (Int, ItemTimers))])
    is CStore
    destCStore
        Maybe (ItemId, CStore, Bool)
    _ -> do
          mis <- ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    selectItemsToMove ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto
          case mis of
            Left FailError
    err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd RequestTimed
    forall a b. a -> Either a b
    Left FailError
    err
            Right (CStore
    fromCStore, [(ItemId
    iid, (Int, ItemTimers)
    _)]) | [CStore]
    stores [CStore] -> [CStore] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [CStore
    CGround] -> do
              (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                SessionUI
    sess {sitemSel = Just (iid, fromCStore, False)}
              ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd RequestTimed)
    moveOrSelectItem ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto
            Right is :: (CStore, [(ItemId, (Int, ItemTimers))])
    is@(CStore
    fromCStore, [(ItemId, (Int, ItemTimers))]
    _) ->
              if | CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    calmE -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    ItemNotCalm
                 | CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CGround Bool -> Bool -> Bool
    && Bool
    overStash -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    ItemOverStash
                 | Bool
    otherwise -> RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (RequestTimed -> FailOrCmd RequestTimed)
    -> m RequestTimed -> m (FailOrCmd RequestTimed)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ActorId
    -> [CStore]
    -> (CStore, [(ItemId, (Int, ItemTimers))])
    -> CStore
    -> m RequestTimed
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> (CStore, [(ItemId, (Int, ItemTimers))])
    -> CStore
    -> m RequestTimed
    moveItems ActorId
    leader [CStore]
    stores (CStore, [(ItemId, (Int, ItemTimers))])
    is CStore
    destCStore

    selectItemsToMove :: forall m. MonadClientUI m
                      => ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
                      -> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))
    selectItemsToMove :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> CStore
    -> Maybe Text
    -> Bool
    -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    selectItemsToMove ActorId
    leader [CStore]
    stores CStore
    destCStore Maybe Text
    mverb Bool
    auto = do
      let verb :: Text
    verb = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (CStore -> Text
    verbCStore CStore
    destCStore) Maybe Text
    mverb
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      b <- getsState $ getActorBody leader
      mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> FactionId
    bfid Actor
    b
      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 = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
          overStash = Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
      if | destCStore == CEqp && not calmE -> failSer ItemNotCalm
         | destCStore == CGround && overStash -> failSer ItemOverStash
         | destCStore == CEqp && eqpOverfull b 1 -> failSer EqpOverfull
         | otherwise -> do
           let storesLast = case Maybe (CStore, CStore)
    lastItemMove of
                 Just (CStore
    lastFrom, CStore
    lastDest) | CStore
    lastDest CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    destCStore
                                             Bool -> Bool -> Bool
    && CStore
    lastFrom CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore]
    stores ->
                   CStore
    lastFrom CStore -> [CStore] -> [CStore]
    forall a. a -> [a] -> [a]
    : CStore -> [CStore] -> [CStore]
    forall a. Eq a => a -> [a] -> [a]
    delete CStore
    lastFrom [CStore]
    stores
                 Maybe (CStore, CStore)
    _ -> [CStore]
    stores
               prompt = Text
    "What to"
               promptEqp = Text
    "What consumable to"
               eqpItemsN Actor
    body =
                 let n :: Int
    n = [Int] -> Int
    forall a. Num a => [a] -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((Int, ItemTimers) -> Int) -> [(Int, ItemTimers)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, ItemTimers) -> Int
    forall a b. (a, b) -> a
    fst ([(Int, ItemTimers)] -> [Int]) -> [(Int, ItemTimers)] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ ItemBag -> [(Int, ItemTimers)]
    forall k a. EnumMap k a -> [a]
    EM.elems (ItemBag -> [(Int, ItemTimers)]) -> ItemBag -> [(Int, ItemTimers)]
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemBag
    beqp Actor
    body
                 in Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Part] -> Text
    makePhrase [Int -> Part -> Part
    MU.CarWs Int
    n Part
    "item"]
               ppItemDialogBody Actor
    body Skills
    actorSk ItemDialogMode
    cCur = case ItemDialogMode
    cCur of
                 MStore CStore
    CEqp | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Skills -> Bool
    calmEnough Actor
    body Skills
    actorSk ->
                   Text
    "distractedly paw at" Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeIn ItemDialogMode
    cCur
                 MStore CStore
    CGround | Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    body, Actor -> Point
    bpos Actor
    body) ->
                   Text
    "greedily fondle" Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeIn ItemDialogMode
    cCur
                 ItemDialogMode
    _ -> case CStore
    destCStore of
                   CStore
    CEqp | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> Skills -> Bool
    calmEnough Actor
    body Skills
    actorSk ->
                     Text
    "distractedly attempt to" Text -> Text -> Text
    <+> Text
    verb
                     Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeFrom ItemDialogMode
    cCur
                   CStore
    CEqp | Actor -> Int -> Bool
    eqpOverfull Actor
    body Int
    1 ->
                     Text
    "attempt to fit into equipment" Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeFrom ItemDialogMode
    cCur
                   CStore
    CGround | Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    body, Actor -> Point
    bpos Actor
    body) ->
                     Text
    "greedily attempt to" Text -> Text -> Text
    <+> Text
    verb Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeFrom ItemDialogMode
    cCur
                   CStore
    CEqp -> Text
    verb
                           Text -> Text -> Text
    <+> Actor -> Text
    eqpItemsN Actor
    body Text -> Text -> Text
    <+> Text
    "so far)"
                           Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeFrom ItemDialogMode
    cCur
                   CStore
    _ -> Text
    verb Text -> Text -> Text
    <+> ItemDialogMode -> Text
    ppItemDialogModeFrom ItemDialogMode
    cCur
                        Text -> Text -> Text
    <+> if ItemDialogMode
    cCur ItemDialogMode -> ItemDialogMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore -> ItemDialogMode
    MStore CStore
    CEqp
                            then Actor -> Text
    eqpItemsN Actor
    body Text -> Text -> Text
    <+> Text
    "now)"
                            else Text
    ""
               (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 $ \Maybe CStore
    _ ItemFull
    itemFull (Int, ItemTimers)
    _kit ->
                        AspectRecord -> Bool
    IA.goesIntoEqp (AspectRecord -> Bool) -> AspectRecord -> Bool
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull)
                 else (prompt, return SuitsEverything)
           ggi <-
             getFull leader psuit
                     (\Actor
    body ActorUI
    _ Skills
    actorSk ItemDialogMode
    cCur State
    _ ->
                        Text
    prompt Text -> Text -> Text
    <+> Actor -> Skills -> ItemDialogMode -> Text
    ppItemDialogBody Actor
    body Skills
    actorSk ItemDialogMode
    cCur)
                     (\Actor
    body ActorUI
    _ Skills
    actorSk ItemDialogMode
    cCur State
    _ ->
                        Text
    promptGeneric Text -> Text -> Text
    <+> Actor -> Skills -> ItemDialogMode -> Text
    ppItemDialogBody Actor
    body Skills
    actorSk ItemDialogMode
    cCur)
                     storesLast (not auto) True
           case ggi of
             Right (CStore
    fromCStore, [(ItemId, (Int, ItemTimers))]
    l) -> do
               (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                 SessionUI
    sess {slastItemMove = Just (fromCStore, destCStore)}
               FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
    -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
     -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])))
    -> FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
    -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    forall a b. (a -> b) -> a -> b
    $ (CStore, [(ItemId, (Int, ItemTimers))])
    -> FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
    forall a b. b -> Either a b
    Right (CStore
    fromCStore, [(ItemId, (Int, ItemTimers))]
    l)
             Left Text
    err -> Text -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    err

    moveItems :: forall m. MonadClientUI m
              => ActorId -> [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore
              -> m RequestTimed
    moveItems :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> [CStore]
    -> (CStore, [(ItemId, (Int, ItemTimers))])
    -> CStore
    -> m RequestTimed
    moveItems ActorId
    leader [CStore]
    stores (CStore
    fromCStore, [(ItemId, (Int, ItemTimers))]
    l) CStore
    destCStore = do
      let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    destCStore Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> [CStore] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CStore]
    stores) ()
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      b <- getsState $ getActorBody leader
      discoBenefit <- getsClient sdiscoBenefit
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
          ret4 :: [(ItemId, ItemQuant)] -> Int -> m [(ItemId, Int, CStore, CStore)]
          ret4 [] Int
    _ = [(ItemId, Int, CStore, CStore)]
    -> m [(ItemId, Int, CStore, CStore)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          ret4 ((ItemId
    iid, (Int
    k, ItemTimers
    _)) : [(ItemId, (Int, ItemTimers))]
    rest) Int
    oldN = do
            let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) ()
                retRec :: CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    toCStore = do
                  let n :: Int
    n = Int
    oldN Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + if CStore
    toCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp then Int
    k else Int
    0
                  l4 <- [(ItemId, (Int, ItemTimers))]
    -> Int -> m [(ItemId, Int, CStore, CStore)]
    ret4 [(ItemId, (Int, ItemTimers))]
    rest Int
    n
                  return $ (iid, k, fromCStore, toCStore) : l4
            if [CStore]
    stores [CStore] -> [CStore] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [CStore
    CGround] Bool -> Bool -> Bool
    && CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CStash  -- normal pickup
            then -- @CStash@ is the implicit default; refine:
                 if | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Benefit -> Bool
    benInEqp (Benefit -> Bool) -> Benefit -> Bool
    forall a b. (a -> b) -> a -> b
    $ DiscoveryBenefit
    discoBenefit DiscoveryBenefit -> ItemId -> Benefit
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid -> CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    CStash
                    | Actor -> Int -> Bool
    eqpOverfull Actor
    b (Int
    oldN Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) -> do
                      -- Action goes through, but changed, so keep in history.
                      MsgClassShowAndSave -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShowAndSave
    MsgActionWarning (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                        Text
    "Warning:" Text -> Text -> Text
    <+> ReqFailure -> Text
    showReqFailure ReqFailure
    EqpOverfull Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "."
                      CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    CStash
                    | Actor -> Int -> Bool
    eqpOverfull Actor
    b (Int
    oldN Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    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.
                      MsgClassShowAndSave -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShowAndSave
    MsgActionWarning (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                        Text
    "Warning:" Text -> Text -> Text
    <+> ReqFailure -> Text
    showReqFailure ReqFailure
    EqpStackFull Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "."
                      CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    CStash
                    | Bool -> Bool
    not Bool
    calmE -> do
                      MsgClassShowAndSave -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShowAndSave
    MsgActionWarning (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                        Text
    "Warning:" Text -> Text -> Text
    <+> ReqFailure -> Text
    showReqFailure ReqFailure
    ItemNotCalm Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "."
                      CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    CStash
                    | Bool
    otherwise ->
                      -- Prefer @CEqp@ if all conditions hold:
                      CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    CEqp
            else case CStore
    destCStore of  -- player forces store, so @benInEqp@ ignored
              CStore
    CEqp | Actor -> Int -> Bool
    eqpOverfull Actor
    b (Int
    oldN Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) -> do
                -- Action aborted, so different colour and not in history.
                MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptItems (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  Text
    "Failure:" Text -> Text -> Text
    <+> ReqFailure -> Text
    showReqFailure ReqFailure
    EqpOverfull Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "."
                -- No recursive call here, we exit item manipulation,
                -- but something is moved or else outer functions would not call us.
                [(ItemId, Int, CStore, CStore)]
    -> m [(ItemId, Int, CStore, CStore)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
              CStore
    CEqp | Actor -> Int -> Bool
    eqpOverfull Actor
    b (Int
    oldN Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    k) -> do
                MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptItems (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  Text
    "Failure:" Text -> Text -> Text
    <+> ReqFailure -> Text
    showReqFailure ReqFailure
    EqpStackFull Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "."
                [(ItemId, Int, CStore, CStore)]
    -> m [(ItemId, Int, CStore, CStore)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
              CStore
    _ -> CStore -> m [(ItemId, Int, CStore, CStore)]
    retRec CStore
    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 :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId -> m (FailOrCmd RequestTimed)
    projectHuman ActorId
    leader = do
      curChal <- (StateClient -> Challenge) -> m Challenge
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> Challenge
    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 (ItemId
    _, CStore
    COrgan, Bool
    _) -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "can't fling an organ"
             Just (ItemId
    iid, CStore
    fromCStore, Bool
    _) -> do
               b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
               bag <- getsState $ getBodyStoreBag b fromCStore
               case iid `EM.lookup` bag of
                 Maybe (Int, ItemTimers)
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no item to fling"
                 Just (Int, ItemTimers)
    _kit -> do
                   itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
                   let i = (CStore
    fromCStore, (ItemId
    iid, ItemFull
    itemFull))
                   projectItem leader i
             Maybe (ItemId, CStore, Bool)
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no item to fling"

    projectItem :: (MonadClient m, MonadClientUI m)
                => ActorId -> (CStore, (ItemId, ItemFull))
                -> m (FailOrCmd RequestTimed)
    projectItem :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    ActorId
    -> (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
    projectItem ActorId
    leader (CStore
    fromCStore, (ItemId
    iid, ItemFull
    itemFull)) = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      b <- getsState $ getActorBody leader
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
      if fromCStore == CEqp && not calmE then failSer ItemNotCalm
      else do
        mpsuitReq <- psuitReq leader
        case mpsuitReq of
          Left Text
    err -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    err
          Right ItemFull -> Either ReqFailure (Point, Bool)
    psuitReqFun ->
            case ItemFull -> Either ReqFailure (Point, Bool)
    psuitReqFun ItemFull
    itemFull of
              Left ReqFailure
    reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    reqFail
              Right (Point
    pos, Bool
    _) -> do
                Benefit{benFling} <- (StateClient -> Benefit) -> m Benefit
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Benefit) -> m Benefit)
    -> (StateClient -> Benefit) -> m Benefit
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryBenefit -> ItemId -> Benefit
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid) (DiscoveryBenefit -> Benefit)
    -> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> DiscoveryBenefit
    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 $ \SessionUI
    sess -> SessionUI
    sess {sitemSel = Nothing}
                  failWith "never mind"

    -- * Apply

    applyHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
    applyHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    applyHuman ActorId
    leader = do
      actorCurAndMaxSk <- (State -> Skills) -> m Skills
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Skills
    getActorMaxSkills ActorId
    leader
      if Ability.getSk Ability.SkApply
                       actorCurAndMaxSk <= 0 then  -- detailed check later
        failSer ApplyUnskilled
      else do
        itemSel <- getsSession sitemSel
        case itemSel of
          Just (ItemId
    iid, CStore
    fromCStore, Bool
    _) -> do
            b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
            bag <- getsState $ getBodyStoreBag b fromCStore
            case iid `EM.lookup` bag of
              Maybe (Int, ItemTimers)
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no item to trigger"
              Just (Int, ItemTimers)
    kit -> do
                itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
                applyItem leader (fromCStore, (iid, (itemFull, kit)))
          Maybe (ItemId, CStore, Bool)
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no item to trigger"

    applyItem :: MonadClientUI m
              => ActorId -> (CStore, (ItemId, ItemFullKit))
              -> m (FailOrCmd RequestTimed)
    applyItem :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
    applyItem ActorId
    leader (CStore
    fromCStore, (ItemId
    iid, (ItemFull
    itemFull, (Int, ItemTimers)
    kit))) = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      b <- getsState $ getActorBody leader
      localTime <- getsState $ getLocalTime (blid b)
      let skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorCurAndMaxSk
          calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
          arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
      if fromCStore == CEqp && not calmE then failSer ItemNotCalm
      else case permittedApply corule localTime skill calmE (Just fromCStore)
                               itemFull kit of
        Left ReqFailure
    reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    reqFail
        Right Bool
    _ -> do
          Benefit{benApply} <- (StateClient -> Benefit) -> m Benefit
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Benefit) -> m Benefit)
    -> (StateClient -> Benefit) -> m Benefit
    forall a b. (a -> b) -> a -> b
    $ (DiscoveryBenefit -> ItemId -> Benefit
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid) (DiscoveryBenefit -> Benefit)
    -> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> DiscoveryBenefit
    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 $ \SessionUI
    sess -> SessionUI
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    alterDirHuman ActorId
    leader = ActorId -> Text -> m (Maybe Point)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Text -> m (Maybe Point)
    pickPoint ActorId
    leader Text
    "modify" m (Maybe Point)
    -> (Maybe Point -> m (FailOrCmd RequestTimed))
    -> m (FailOrCmd RequestTimed)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Just Point
    p -> ActorId -> Point -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (FailOrCmd RequestTimed)
    alterTileAtPos ActorId
    leader Point
    p
      Maybe Point
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (FailOrCmd RequestTimed)
    alterTileAtPos ActorId
    leader Point
    pos = do
      sb <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      let sxhair = Target -> Maybe Target
    forall a. a -> Maybe a
    Just (Target -> Maybe Target) -> Target -> Maybe Target
    forall a b. (a -> b) -> a -> b
    $ TGoal -> LevelId -> Point -> Target
    TPoint TGoal
    TUnknown (Actor -> LevelId
    blid Actor
    sb) Point
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Point -> m (FailOrCmd ())
    verifyAlters ActorId
    leader Bool
    bumping Point
    tpos = do
      COps{cotile, coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    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 Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arItem
            then []  -- prevent embeds triggering each other in a loop
            else ((ItemId, (Int, ItemTimers))
     -> (ItemKind, (ItemId, (Int, ItemTimers))))
    -> [(ItemId, (Int, ItemTimers))]
    -> [(ItemKind, (ItemId, (Int, ItemTimers)))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ItemId
    iid, (Int, ItemTimers)
    kit) -> (ItemId -> ItemKind
    getKind ItemId
    iid, (ItemId
    iid, (Int, ItemTimers)
    kit))) (ItemBag -> [(ItemId, (Int, ItemTimers))]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs ItemBag
    embeds)
          underFeet = Point
    tpos Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    sb  -- if enter and alter, be more permissive
          blockedByItem = Point -> EnumMap Point ItemBag -> Bool
    forall k a. Enum k => k -> EnumMap k a -> Bool
    EM.member Point
    tpos (Level -> EnumMap Point ItemBag
    lfloor Level
    lvl)
          tile = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          feats = TileKind -> [Feature]
    TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    tile
          tileActions =
            (Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Bool
    -> Bool
    -> [(ItemKind, (ItemId, (Int, ItemTimers)))]
    -> Feature
    -> Maybe TileAction
    parseTileAction
                        (Actor -> Bool
    bproj Actor
    sb)
                        (Bool
    underFeet Bool -> Bool -> Bool
    || Bool
    blockedByItem)  -- avoids AlterBlockItem
                        [(ItemKind, (ItemId, (Int, ItemTimers)))]
    embedKindList)
                     [Feature]
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> Point -> [TileAction] -> m (FailOrCmd ())
    processTileActions ActorId
    leader Bool
    bumping Point
    tpos [TileAction]
    tas = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      getKind <- getsState $ flip getIidKind
      sb <- getsState $ getActorBody leader
      lvl <- getLevel $ blid sb
      sar <- getsState $ aspectRecordFromIid $ btrunk sb
      let leaderIsMist = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    sar
                         Bool -> Bool -> Bool
    && Dice -> Int
    Dice.infDice (ItemKind -> Dice
    IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
    forall a b. (a -> b) -> a -> b
    $ ItemId -> ItemKind
    getKind (ItemId -> ItemKind) -> ItemId -> ItemKind
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemId
    btrunk Actor
    sb) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0
          tileMinSkill = TileSpeedup -> ContentId TileKind -> Int
    Tile.alterMinSkill TileSpeedup
    coTileSpeedup (ContentId TileKind -> Int) -> ContentId TileKind -> Int
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          processTA :: Maybe Bool -> [TileAction] -> Bool
                    -> m (FailOrCmd (Maybe (Bool, Bool)))
          processTA Maybe Bool
    museResult [] Bool
    bumpFailed = do
            let useResult :: Bool
    useResult = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False Maybe Bool
    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.
            FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Maybe (Bool, Bool))
     -> m (FailOrCmd (Maybe (Bool, Bool))))
    -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a b. (a -> b) -> a -> b
    $ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. b -> Either a b
    Right (Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool)))
    -> Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. (a -> b) -> a -> b
    $ if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isSuspect TileSpeedup
    coTileSpeedup (Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos)
                                Bool -> Bool -> Bool
    || Bool
    useResult Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    bumpFailed
                             then Maybe (Bool, Bool)
    forall a. Maybe a
    Nothing  -- success of some kind
                             else (Bool, Bool) -> Maybe (Bool, Bool)
    forall a. a -> Maybe a
    Just (Bool
    useResult, Bool
    bumpFailed)  -- not quite
          processTA Maybe Bool
    museResult (TileAction
    ta : [TileAction]
    rest) Bool
    bumpFailed = case TileAction
    ta of
            EmbedAction (ItemId
    iid, (Int, ItemTimers)
    _) -> 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 :: Bool
    useResult = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False Maybe Bool
    museResult
              if | Bool
    leaderIsMist
                   Bool -> Bool -> Bool
    || Actor -> Bool
    bproj Actor
    sb Bool -> Bool -> Bool
    && Int
    tileMinSkill Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->  -- local skill check
                   Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    useResult) [TileAction]
    rest Bool
    bumpFailed
                     -- embed won't fire; try others
                 | (Bool -> Bool
    not (Bool -> Bool) -> ([Effect] -> Bool) -> [Effect] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Effect -> Bool) -> [Effect] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Effect -> Bool
    IK.isEffEscape) (ItemKind -> [Effect]
    IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
    forall a b. (a -> b) -> a -> b
    $ ItemId -> ItemKind
    getKind ItemId
    iid) ->
                   Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True) [TileAction]
    rest Bool
    False
                     -- no escape checking needed, effect found;
                     -- also bumpFailed reset, because must have been
                     -- marginal if an embed was following it
                 | Bool
    otherwise -> do
                   mfail <- m (FailOrCmd ())
    forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ())
    verifyEscape
                   case mfail of
                     Left FailError
    err -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Maybe (Bool, Bool))
     -> m (FailOrCmd (Maybe (Bool, Bool))))
    -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. a -> Either a b
    Left FailError
    err
                     Right () -> Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True) [TileAction]
    rest Bool
    False
                       -- effect found, bumpFailed reset
            ToAction{} ->
              if Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    True Maybe Bool
    museResult
                 Bool -> Bool -> Bool
    && Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    sb Bool -> Bool -> Bool
    && Int
    tileMinSkill Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0)  -- local skill check
              then FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Maybe (Bool, Bool))
     -> m (FailOrCmd (Maybe (Bool, Bool))))
    -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a b. (a -> b) -> a -> b
    $ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. b -> Either a b
    Right Maybe (Bool, Bool)
    forall a. Maybe a
    Nothing  -- tile changed, no more activations
              else Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA Maybe Bool
    museResult [TileAction]
    rest Bool
    bumpFailed
                     -- failed, but not due to bumping
            WithAction [(Int, GroupName ItemKind)]
    tools0 GroupName TileKind
    _ ->
              if Bool -> Bool
    not Bool
    bumping Bool -> Bool -> Bool
    || [(Int, GroupName ItemKind)] -> Bool
    forall a. [a] -> Bool
    null [(Int, GroupName ItemKind)]
    tools0 then
                if Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    True Maybe Bool
    museResult then do
                  -- UI requested, so this is voluntary, so item loss is fine.
                  kitAssG <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
    -> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
    forall a b. (a -> b) -> a -> b
    $ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
    kitAssocs ActorId
    leader [CStore
    CGround]
                  kitAssE <- getsState $ kitAssocs leader [CEqp]
                  let kitAss = [(ItemId, ItemFullKit)]
    -> [(ItemId, ItemFullKit)]
    -> [((CStore, Bool), (ItemId, ItemFullKit))]
    listToolsToConsume [(ItemId, ItemFullKit)]
    kitAssG [(ItemId, ItemFullKit)]
    kitAssE
                      grps0 = ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
    -> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int
    x, GroupName ItemKind
    y) -> (Bool
    False, Int
    x, GroupName ItemKind
    y)) [(Int, GroupName ItemKind)]
    tools0
                        -- apply if durable
                      (_, iidsToApply, grps) =
                        foldl' subtractIidfromGrps (EM.empty, [], grps0) kitAss
                  if null grps then do
                    let hasEffectOrDmg (a
    _, (a
    _, ItemFull{ItemKind
    itemKind :: ItemKind
    itemKind :: ItemFull -> ItemKind
    itemKind})) =
                          ItemKind -> Dice
    IK.idamage ItemKind
    itemKind Dice -> Dice -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Dice
    0
                          Bool -> Bool -> Bool
    || (Effect -> Bool) -> [Effect] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Effect -> Bool
    IK.forApplyEffect (ItemKind -> [Effect]
    IK.ieffects ItemKind
    itemKind)
                    mfail <- case filter hasEffectOrDmg iidsToApply of
                      [] -> FailOrCmd () -> m (FailOrCmd ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd () -> m (FailOrCmd ()))
    -> FailOrCmd () -> m (FailOrCmd ())
    forall a b. (a -> b) -> a -> b
    $ () -> FailOrCmd ()
    forall a b. b -> Either a b
    Right ()
                      (CStore
    store, (ItemId
    _, ItemFull
    itemFull)) : [(CStore, (ItemId, ItemFull))]
    _ ->
                        LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
    forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
    verifyToolEffect (Actor -> LevelId
    blid Actor
    sb) CStore
    store ItemFull
    itemFull
                    case mfail of
                      Left FailError
    err -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Maybe (Bool, Bool))
     -> m (FailOrCmd (Maybe (Bool, Bool))))
    -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. a -> Either a b
    Left FailError
    err
                      Right () -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd (Maybe (Bool, Bool))
     -> m (FailOrCmd (Maybe (Bool, Bool))))
    -> FailOrCmd (Maybe (Bool, Bool))
    -> m (FailOrCmd (Maybe (Bool, Bool)))
    forall a b. (a -> b) -> a -> b
    $ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
    forall a b. b -> Either a b
    Right Maybe (Bool, Bool)
    forall a. Maybe a
    Nothing  -- tile changed, done
                  else processTA museResult rest bumpFailed  -- not enough tools
                else Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA Maybe Bool
    museResult [TileAction]
    rest Bool
    bumpFailed  -- embeds failed
              else Maybe Bool
    -> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
    processTA Maybe Bool
    museResult [TileAction]
    rest Bool
    True  -- failed due to bumping
      mfail <- processTA Nothing tas False
      case mfail of
        Left FailError
    err -> FailOrCmd () -> m (FailOrCmd ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd () -> m (FailOrCmd ()))
    -> FailOrCmd () -> m (FailOrCmd ())
    forall a b. (a -> b) -> a -> b
    $ FailError -> FailOrCmd ()
    forall a b. a -> Either a b
    Left FailError
    err
        Right Maybe (Bool, Bool)
    Nothing -> FailOrCmd () -> m (FailOrCmd ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd () -> m (FailOrCmd ()))
    -> FailOrCmd () -> m (FailOrCmd ())
    forall a b. (a -> b) -> a -> b
    $ () -> FailOrCmd ()
    forall a b. b -> Either a b
    Right ()
        Right (Just (Bool
    useResult, Bool
    bumpFailed)) -> do
          let !_A :: ()
    _A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not Bool
    useResult Bool -> Bool -> Bool
    || Bool
    bumpFailed) ()
          blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
    forall (m :: * -> *).
    MonadClientUI m =>
    Point -> LevelId -> m [(MsgClassShow, Text)]
    lookAtPosition Point
    tpos (Actor -> LevelId
    blid Actor
    sb)
          mapM_ (uncurry msgAdd) blurb
          if bumpFailed then do
            revCmd <- revCmdMap
            let km = HumanCmd -> KM
    revCmd HumanCmd
    AlterDir
                msg = Text
    "bumping is not enough to transform this terrain; modify with the '"
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (KM -> String
    K.showKM KM
    km)
                      Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "' 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 :: forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ())
    verifyEscape = do
      side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      fact <- getsState $ (EM.! side) . sfactionD
      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 | Int
    dungeonTotal Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 =
                     Text
    "You finally reached your goal. Really leave now?"
                   | Int
    total Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 =
                     Text
    "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"
                   | Int
    total Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    dungeonTotal =
                     Text
    "You've finally found the way out, but you didn't gather all valuables rumoured to be laying around. Really leave already?"
                   | Bool
    otherwise =
                     Text
    "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 :: forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
    verifyToolEffect LevelId
    lid CStore
    store ItemFull
    itemFull = do
      CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      side <- getsClient sside
      localTime <- getsState $ getLocalTime lid
      factionD <- getsState sfactionD
      let (name1, powers) = partItemShort rwidth side factionD localTime
                                          itemFull quantSingle
          objectA = [Part] -> Text
    makePhrase [Part -> Part
    MU.AW Part
    name1, Part
    powers]
          -- "Potentially", because an unidentified items on the ground can take
          -- precedence (perhaps placed there in order to get identified!).
          prompt = Text
    "Do you really want to transform the terrain potentially using"
                   Text -> Text -> Text
    <+> Text
    objectA Text -> Text -> Text
    <+> CStore -> Text
    ppCStoreIn CStore
    store
                   Text -> Text -> Text
    <+> Text
    "that may cause substantial side-effects?"
          objectThe = [Part] -> Text
    makePhrase [Part
    "the", Part
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    alterWithPointerHuman ActorId
    leader = do
      COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      pUI <- getsSession spointer
      let p = PointSquare -> Point
    squareToMap (PointSquare -> Point) -> PointSquare -> Point
    forall a b. (a -> b) -> a -> b
    $ PointUI -> PointSquare
    uiToSquare PointUI
    pUI
      if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
      then 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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> m (FailOrCmd RequestTimed)
    closeDirHuman ActorId
    leader = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      b <- getsState $ getActorBody leader
      lvl <- getLevel $ blid b
      let vPts = Point -> [Point]
    vicinityUnsafe (Point -> [Point]) -> Point -> [Point]
    forall a b. (a -> b) -> a -> b
    $ Actor -> Point
    bpos Actor
    b
          openPts = (Point -> Bool) -> [Point] -> [Point]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isClosable TileSpeedup
    coTileSpeedup (ContentId TileKind -> Bool)
    -> (Point -> ContentId TileKind) -> Point -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Level -> Point -> ContentId TileKind
    at Level
    lvl) [Point]
    vPts
      case openPts of
        []  -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    CloseNothing
        [Point
    o] -> ActorId -> Point -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (FailOrCmd RequestTimed)
    closeTileAtPos ActorId
    leader Point
    o
        [Point]
    _   -> ActorId -> Text -> m (Maybe Point)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Text -> m (Maybe Point)
    pickPoint ActorId
    leader Text
    "close" m (Maybe Point)
    -> (Maybe Point -> m (FailOrCmd RequestTimed))
    -> m (FailOrCmd RequestTimed)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Maybe Point
    Nothing -> Text -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
          Just Point
    p -> ActorId -> Point -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (FailOrCmd RequestTimed)
    closeTileAtPos ActorId
    leader Point
    p

    -- | Close tile at given position.
    closeTileAtPos :: MonadClientUI m
                   => ActorId -> Point -> m (FailOrCmd RequestTimed)
    closeTileAtPos :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Point -> m (FailOrCmd RequestTimed)
    closeTileAtPos ActorId
    leader Point
    tpos = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
      b <- getsState $ getActorBody leader
      alterable <- getsState $ tileAlterable (blid b) tpos
      lvl <- getLevel $ blid b
      let alterSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkAlter Skills
    actorCurAndMaxSk
          t = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          isOpen = TileSpeedup -> ContentId TileKind -> Bool
    Tile.isClosable TileSpeedup
    coTileSpeedup ContentId TileKind
    t
          isClosed = TileSpeedup -> ContentId TileKind -> Bool
    Tile.isOpenable TileSpeedup
    coTileSpeedup ContentId TileKind
    t
      case (alterable, isClosed, isOpen) of
        (Bool
    False, Bool
    _, Bool
    _) -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    CloseNothing
        (Bool
    True, Bool
    False, Bool
    False) -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    CloseNonClosable
        (Bool
    True, Bool
    True,  Bool
    False) -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    CloseClosed
        (Bool
    True, Bool
    True,  Bool
    True) -> String -> m (FailOrCmd RequestTimed)
    forall a. (?callStack::CallStack) => String -> a
    error String
    "TileKind content validation"
        (Bool
    True, Bool
    False, Bool
    True) ->
          if | Point
    tpos Point -> Point -> Int
    `chessDist` Actor -> Point
    bpos Actor
    b Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
              -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    CloseDistant
             | Int
    alterSkill Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
              -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    AlterUnskilled
             | Point -> EnumMap Point ItemBag -> Bool
    forall k a. Enum k => k -> EnumMap k a -> Bool
    EM.member Point
    tpos (EnumMap Point ItemBag -> Bool) -> EnumMap Point ItemBag -> Bool
    forall a b. (a -> b) -> a -> b
    $ Level -> EnumMap Point ItemBag
    lfloor Level
    lvl
              -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    AlterBlockItem
             | Point -> Level -> Bool
    occupiedBigLvl Point
    tpos Level
    lvl Bool -> Bool -> Bool
    || Point -> Level -> Bool
    occupiedProjLvl Point
    tpos Level
    lvl
              -> ReqFailure -> m (FailOrCmd RequestTimed)
    forall (m :: * -> *) a.
    MonadClientUI m =>
    ReqFailure -> m (FailOrCmd a)
    failSer ReqFailure
    AlterBlockActor
             | Bool
    otherwise
              -> do
                 Bool -> ActorId -> Point -> Text -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> ActorId -> Point -> Text -> m ()
    msgAddDone Bool
    True ActorId
    leader Point
    tpos Text
    "close"
                 FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
    -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> FailOrCmd RequestTimed
    forall a b. b -> Either a b
    Right (Point -> RequestTimed
    ReqAlter Point
    tpos)

    -- | Adds message with proper names.
    msgAddDone :: MonadClientUI m => Bool -> ActorId -> Point -> Text -> m ()
    msgAddDone :: forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> ActorId -> Point -> Text -> m ()
    msgAddDone Bool
    mentionTile ActorId
    leader Point
    p Text
    verb = do
      COps{cotile} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      b <- getsState $ getActorBody leader
      lvl <- getLevel $ blid b
      let tname = TileKind -> Text
    TK.tname (TileKind -> Text) -> TileKind -> Text
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    p
          s = case Text -> [Text]
    T.words Text
    tname of
                [] -> Text
    "thing"
                (Text
    "open" : [Text]
    xs) -> [Text] -> Text
    T.unwords [Text]
    xs
                [Text]
    _ -> Text
    tname
          object | Bool
    mentionTile = Text
    "the" Text -> Text -> Text
    <+> Text
    s
                 | Bool
    otherwise = Text
    ""
          v = Point
    p Point -> Point -> Vector
    `vectorToFrom` Actor -> Point
    bpos Actor
    b
          dir | Vector
    v Vector -> Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Int -> Vector
    Vector Int
    0 Int
    0 = Text
    "underneath"
              | Bool
    otherwise = Vector -> Text
    compassText Vector
    v
      msgAdd MsgActionComplete $ "You" <+> verb <+> object <+> dir <> "."

    -- | Prompts user to pick a point.
    pickPoint :: MonadClientUI m => ActorId -> Text -> m (Maybe Point)
    pickPoint :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Text -> m (Maybe Point)
    pickPoint ActorId
    leader Text
    verb = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
      UIOptions{uVi, uLeftHand} <- getsSession sUIOptions
      let dirKeys = Bool -> Bool -> [Key]
    K.dirAllKey Bool
    uVi Bool
    uLeftHand
          keys = KM
    K.escKM
               KM -> [KM] -> [KM]
    forall a. a -> [a] -> [a]
    : KM
    K.leftButtonReleaseKM
               KM -> [KM] -> [KM]
    forall a. a -> [a] -> [a]
    : (Key -> KM) -> [Key] -> [KM]
    forall a b. (a -> b) -> [a] -> [b]
    map (Modifier -> Key -> KM
    K.KM Modifier
    K.NoModifier) [Key]
    dirKeys
      msgAdd MsgPromptGeneric $ "Where to" <+> verb <> "? [movement key] [pointer]"
      slides <- reportToSlideshow [K.escKM]
      km <- getConfirms ColorFull keys slides
      case K.key km of
        Key
    K.LeftButtonRelease -> do
          pUI <- (SessionUI -> PointUI) -> m PointUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> PointUI
    spointer
          let p = PointSquare -> Point
    squareToMap (PointSquare -> Point) -> PointSquare -> Point
    forall a b. (a -> b) -> a -> b
    $ PointUI -> PointSquare
    uiToSquare PointUI
    pUI
          return $ Just p
        Key
    _ -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Vector -> Point
    shift (Actor -> Point
    bpos Actor
    b) (Vector -> Point) -> Maybe Vector -> Maybe Point
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Key] -> KM -> Maybe Vector
    K.handleDir [Key]
    dirKeys KM
    km

    -- * Help

    -- | Display command help.
    helpHuman :: MonadClientUI m
              => (K.KM -> HumanCmd -> m (Either MError ReqUI))
              -> m (Either MError ReqUI)
    helpHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    helpHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      ccui@CCUI{coinput, coscreen=ScreenContent{rwidth, rheight, rintroScreen}}
        <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      fontSetup@FontSetup{..} <- getFontSetup
      gameModeId <- getsState sgameModeId
      modeOv <- describeMode True gameModeId
      curTutorial <- getsSession scurTutorial
      overrideTut <- getsSession soverrideTut
      let displayTutorialHints = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    overrideTut
          modeH = ( Text
    "Press SPACE or PGDN to advance or ESC to see the map again."
                  , (EnumMap DisplayFont Overlay
    modeOv, []) )
          keyH = CCUI -> FontSetup -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    keyHelp CCUI
    ccui FontSetup
    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 [] [[String]]
    acc Int
    _ = [[String] -> [[String]] -> [String]
    forall a. [a] -> [[a]] -> [a]
    intercalate [String
    ""] ([[String]] -> [[String]]
    forall a. [a] -> [a]
    reverse [[String]]
    acc)]
          packIntoScreens ([] : [[String]]
    ls) [] Int
    _  =
            -- Ignore empty paragraphs at the start of screen.
            [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens [[String]]
    ls [] Int
    0
          packIntoScreens ([String]
    l : [[String]]
    ls) [] Int
    h = Bool -> [[String]] -> [[String]]
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    h Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
    forall a b. (a -> b) -> a -> b
    $
            -- If a paragraph, even alone, is longer than screen height, it's split.
            if [String] -> Int
    forall a. [a] -> Int
    length [String]
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3
            then [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens [[String]]
    ls [[String]
    l] ([String] -> Int
    forall a. [a] -> Int
    length [String]
    l)
            else let ([String]
    screen, [String]
    rest) = Int -> [String] -> ([String], [String])
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) [String]
    l
                 in [String]
    screen [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens ([String]
    rest [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [[String]]
    ls) [] Int
    0
          packIntoScreens ([String]
    l : [[String]]
    ls) [[String]]
    acc Int
    h =
            -- The extra @+ 1@ comes from the empty line separating paragraphs,
            -- as added in @intercalate@.
            if [String] -> Int
    forall a. [a] -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3
            then [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens [[String]]
    ls ([String]
    l [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [[String]]
    acc) ([String] -> Int
    forall a. [a] -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h)
            else [String] -> [[String]] -> [String]
    forall a. [a] -> [[a]] -> [a]
    intercalate [String
    ""] ([[String]] -> [[String]]
    forall a. [a] -> [a]
    reverse [[String]]
    acc) [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens ([String]
    l [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [[String]]
    ls) [] Int
    0
          manualScreens = [[String]] -> [[String]] -> Int -> [[String]]
    packIntoScreens (([String], [[String]]) -> [[String]]
    forall a b. (a, b) -> b
    snd ([String], [[String]])
    rintroScreen) [] Int
    0
          sideBySide =
            if DisplayFont -> Bool
    isSquareFont DisplayFont
    monoFont
            then \([AttrLine]
    screen1, [AttrLine]
    screen2) ->  -- single column, two screens
              ([AttrLine] -> Overlay) -> [[AttrLine]] -> [Overlay]
    forall a b. (a -> b) -> [a] -> [b]
    map [AttrLine] -> Overlay
    offsetOverlay ([[AttrLine]] -> [Overlay]) -> [[AttrLine]] -> [Overlay]
    forall a b. (a -> b) -> a -> b
    $ ([AttrLine] -> Bool) -> [[AttrLine]] -> [[AttrLine]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([AttrLine] -> Bool) -> [AttrLine] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [AttrLine] -> Bool
    forall a. [a] -> Bool
    null) [[AttrLine]
    screen1, [AttrLine]
    screen2]
            else \([AttrLine]
    screen1, [AttrLine]
    screen2) ->  -- two columns, single screen
              [[AttrLine] -> Overlay
    offsetOverlay [AttrLine]
    screen1
               Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    ++ Int -> Overlay -> Overlay
    xtranslateOverlay Int
    rwidth ([AttrLine] -> Overlay
    offsetOverlay [AttrLine]
    screen2)]
          listPairs ([a]
    a : [a]
    b : [[a]]
    rest) = ([a]
    a, [a]
    b) ([a], [a]) -> [([a], [a])] -> [([a], [a])]
    forall a. a -> [a] -> [a]
    : [[a]] -> [([a], [a])]
    listPairs [[a]]
    rest
          listPairs [[a]
    a] = [([a]
    a, [])]
          listPairs [] = []
          -- Each screen begins with an empty line, to separate the header.
          manualOvs = (Overlay -> EnumMap DisplayFont Overlay)
    -> [Overlay] -> [EnumMap DisplayFont Overlay]
    forall a b. (a -> b) -> [a] -> [b]
    map (DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    monoFont)
                      ([Overlay] -> [EnumMap DisplayFont Overlay])
    -> [Overlay] -> [EnumMap DisplayFont Overlay]
    forall a b. (a -> b) -> a -> b
    $ (([AttrLine], [AttrLine]) -> [Overlay])
    -> [([AttrLine], [AttrLine])] -> [Overlay]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([AttrLine], [AttrLine]) -> [Overlay]
    sideBySide ([([AttrLine], [AttrLine])] -> [Overlay])
    -> [([AttrLine], [AttrLine])] -> [Overlay]
    forall a b. (a -> b) -> a -> b
    $ [[AttrLine]] -> [([AttrLine], [AttrLine])]
    forall {a}. [[a]] -> [([a], [a])]
    listPairs
                      ([[AttrLine]] -> [([AttrLine], [AttrLine])])
    -> [[AttrLine]] -> [([AttrLine], [AttrLine])]
    forall a b. (a -> b) -> a -> b
    $ ([String] -> [AttrLine]) -> [[String]] -> [[AttrLine]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((AttrLine
    emptyAttrLine AttrLine -> [AttrLine] -> [AttrLine]
    forall a. a -> [a] -> [a]
    :) ([AttrLine] -> [AttrLine])
    -> ([String] -> [AttrLine]) -> [String] -> [AttrLine]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> AttrLine) -> [String] -> [AttrLine]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> AttrLine
    stringToAL) [[String]]
    manualScreens
          addMnualHeader a
    ov =
            ( a
    "Showing PLAYING.md (best viewed in the browser)."
            , (a
    ov, []) )
          manualH = (EnumMap DisplayFont Overlay
     -> (Text, (EnumMap DisplayFont Overlay, [KYX])))
    -> [EnumMap DisplayFont Overlay]
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    forall a b. (a -> b) -> [a] -> [b]
    map EnumMap DisplayFont Overlay
    -> (Text, (EnumMap DisplayFont Overlay, [KYX]))
    forall {a} {a} {a}. IsString a => a -> (a, (a, [a]))
    addMnualHeader [EnumMap DisplayFont Overlay]
    manualOvs
          splitHelp (Text
    t, (EnumMap DisplayFont Overlay, [KYX])
    okx) =
            FontSetup
    -> Bool
    -> Int
    -> Int
    -> Int
    -> AttrString
    -> [KM]
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitOKX FontSetup
    fontSetup Bool
    True Int
    rwidth Int
    rheight Int
    rwidth (Text -> AttrString
    textToAS Text
    t)
                     [KM
    K.spaceKM, KM
    K.returnKM, KM
    K.escKM] (EnumMap DisplayFont Overlay, [KYX])
    okx
          sli = FontSetup
    -> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    toSlideshow FontSetup
    fontSetup Bool
    displayTutorialHints
                ([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
    -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    forall a b. (a -> b) -> a -> b
    $ ((Text, (EnumMap DisplayFont Overlay, [KYX]))
     -> [(EnumMap DisplayFont Overlay, [KYX])])
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text, (EnumMap DisplayFont Overlay, [KYX]))
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitHelp ([(Text, (EnumMap DisplayFont Overlay, [KYX]))]
     -> [(EnumMap DisplayFont Overlay, [KYX])])
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    forall a b. (a -> b) -> a -> b
    $ (Text, (EnumMap DisplayFont Overlay, [KYX]))
    modeH (Text, (EnumMap DisplayFont Overlay, [KYX]))
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    forall a. a -> [a] -> [a]
    : [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    keyH [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    forall a. [a] -> [a] -> [a]
    ++ [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
    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 | KM
    km KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM
    K.escKM, KM
    K.spaceKM] -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
        Left KM
    km | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.returnKM -> do
          MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Press RET when a command help text is selected to invoke the command."
          Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
        Left KM
    km -> case KM
    km KM -> Map KM CmdTriple -> Maybe CmdTriple
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` InputContent -> Map KM CmdTriple
    bcmdMap InputContent
    coinput of
          Just ([CmdCategory]
    _desc, Text
    _cats, HumanCmd
    cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
          Maybe CmdTriple
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
        Right MenuSlot
    _slot -> String -> m (Either MError ReqUI)
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (Either MError ReqUI))
    -> String -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    hintHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      sreportNull <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    dashboardHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      CCUI{coinput, coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      fontSetup@FontSetup{..} <- getFontSetup
      curTutorial <- getsSession scurTutorial
      overrideTut <- getsSession soverrideTut
      let displayTutorialHints = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    overrideTut
          offsetCol2 = Int
    3
          (ov0, kxs0) = okxsN coinput monoFont propFont offsetCol2 (const False)
                              False CmdDashboard ([], [], []) ([], [])
          al1 = Text -> AttrString
    textToAS Text
    "Dashboard"
          splitHelp (AttrString
    al, (EnumMap DisplayFont Overlay, [KYX])
    okx) = FontSetup
    -> Bool
    -> Int
    -> Int
    -> Int
    -> AttrString
    -> [KM]
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitOKX FontSetup
    fontSetup Bool
    False Int
    rwidth (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Int
    rwidth
                                         AttrString
    al [KM
    K.returnKM, KM
    K.escKM] (EnumMap DisplayFont Overlay, [KYX])
    okx
          sli = FontSetup
    -> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    toSlideshow FontSetup
    fontSetup Bool
    displayTutorialHints
                ([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
    -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    forall a b. (a -> b) -> a -> b
    $ (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitHelp (AttrString
    al1, (EnumMap DisplayFont Overlay
    ov0, [KYX]
    kxs0))
          extraKeys = [KM
    K.returnKM, KM
    K.escKM]
      ekm <- displayChoiceScreen "dashboard" ColorFull False sli extraKeys
      case ekm of
        Left KM
    km -> case KM
    km KM -> Map KM CmdTriple -> Maybe CmdTriple
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` InputContent -> Map KM CmdTriple
    bcmdMap InputContent
    coinput of
          Maybe CmdTriple
    _ | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
          Maybe CmdTriple
    _ | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.returnKM -> do
            MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Press RET when a menu name is selected to browse the menu."
            Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left MError
    forall a. Maybe a
    Nothing
          Just ([CmdCategory]
    _desc, Text
    _cats, HumanCmd
    cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
          Maybe CmdTriple
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
        Right MenuSlot
    _slot -> String -> m (Either MError ReqUI)
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (Either MError ReqUI))
    -> String -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    ekm

    -- * ItemMenu

    itemMenuHuman :: MonadClientUI m
                  => ActorId
                  -> (K.KM -> HumanCmd -> m (Either MError ReqUI))
                  -> m (Either MError ReqUI)
    itemMenuHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    itemMenuHuman ActorId
    leader KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      itemSel <- getsSession sitemSel
      fontSetup@FontSetup{..} <- getFontSetup
      case itemSel of
        Just (ItemId
    iid, CStore
    fromCStore, Bool
    _) -> do
          side <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
          b <- getsState $ getActorBody leader
          bUI <- getsSession $ getActorUI leader
          bag <- getsState $ getBodyStoreBag b fromCStore
          case iid `EM.lookup` bag of
            Maybe (Int, ItemTimers)
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "no item to open item menu for"
            Just (Int, ItemTimers)
    kit -> do
              CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
              actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
              itemFull <- getsState $ itemToFull iid
              localTime <- getsState $ getLocalTime (blid b)
              found <- getsState $ findIid leader side iid
              let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not ([(ActorId, (Actor, CStore))] -> Bool
    forall a. [a] -> Bool
    null [(ActorId, (Actor, CStore))]
    found) Bool -> Bool -> Bool
    || CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CGround
                                Bool -> (ItemId, ActorId) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (ItemId
    iid, ActorId
    leader)) ()
                  fAlt (ActorId
    aid, (Actor
    _, CStore
    store)) = ActorId
    aid ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ActorId
    leader Bool -> Bool -> Bool
    || CStore
    store CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CStore
    fromCStore
                  foundAlt = ((ActorId, (Actor, CStore)) -> Bool)
    -> [(ActorId, (Actor, CStore))] -> [(ActorId, (Actor, CStore))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ActorId, (Actor, CStore)) -> Bool
    fAlt [(ActorId, (Actor, CStore))]
    found
                  markParagraphs = Int
    rheight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    45
                  meleeSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkHurtMelee Skills
    actorCurAndMaxSk
                  partRawActor ActorId
    aid = (SessionUI -> Part) -> m Part
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession (ActorUI -> Part
    partActor (ActorUI -> Part) -> (SessionUI -> ActorUI) -> SessionUI -> Part
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActorId -> SessionUI -> ActorUI
    getActorUI ActorId
    aid)
                  ppLoc ActorId
    aid CStore
    store = do
                    parts <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
    forall (m :: * -> *).
    MonadClientUI m =>
    (ActorId -> m Part) -> Bool -> Container -> m [Part]
    ppContainerWownW ActorId -> m Part
    forall {m :: * -> *}. MonadClientUI m => ActorId -> m Part
    partRawActor
                                              Bool
    False
                                              (ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    store)
                    return $! "[" ++ T.unpack (makePhrase parts) ++ "]"
                  dmode = CStore -> ItemDialogMode
    MStore CStore
    fromCStore
              foundTexts <- mapM (\(ActorId
    aid, (Actor
    _, CStore
    store)) -> ActorId -> CStore -> m String
    forall {m :: * -> *}.
    MonadClientUI m =>
    ActorId -> CStore -> m String
    ppLoc ActorId
    aid CStore
    store) foundAlt
              (ovLab, ovDesc) <-
                itemDescOverlays markParagraphs meleeSkill dmode iid kit
                                 itemFull rwidth
              let foundPrefix = Text -> AttrString
    textToAS (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $
                    if [String] -> Bool
    forall a. [a] -> Bool
    null [String]
    foundTexts then Text
    "" else Text
    "The item is also in:"
                  ovPrefix = Int -> Overlay -> Overlay
    ytranslateOverlay (Overlay -> Int
    forall a. [a] -> Int
    length Overlay
    ovDesc)
                             (Overlay -> Overlay) -> Overlay -> Overlay
    forall a b. (a -> b) -> a -> b
    $ [AttrLine] -> Overlay
    offsetOverlay
                             ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    rwidth Int
    rwidth AttrString
    foundPrefix
                  ystart = Overlay -> Int
    forall a. [a] -> Int
    length Overlay
    ovDesc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Overlay -> Int
    forall a. [a] -> Int
    length Overlay
    ovPrefix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                  xstart = DisplayFont -> AttrString -> Int
    forall a. DisplayFont -> [a] -> Int
    textSize DisplayFont
    monoFont (AttrCharW32
    Color.spaceAttrW32
                                              AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrLine -> AttrString
    attrLine ((PointUI, AttrLine) -> AttrLine
    forall a b. (a, b) -> b
    snd ((PointUI, AttrLine) -> AttrLine)
    -> (PointUI, AttrLine) -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ Overlay -> (PointUI, AttrLine)
    forall a. (?callStack::CallStack) => [a] -> a
    last Overlay
    ovPrefix))
                  foundKeys = (Int -> KM) -> [Int] -> [KM]
    forall a b. (a -> b) -> [a] -> [b]
    map (Modifier -> Key -> KM
    K.KM Modifier
    K.NoModifier (Key -> KM) -> (Int -> Key) -> Int -> KM
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Key
    K.Fun)
                                  [Int
    1 .. [(ActorId, (Actor, CStore))] -> Int
    forall a. [a] -> Int
    length [(ActorId, (Actor, CStore))]
    foundAlt]  -- starting from 1!
              let ks = [KM] -> [String] -> [(KM, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [KM]
    foundKeys [String]
    foundTexts
                  width = if DisplayFont -> Bool
    isSquareFont DisplayFont
    monoFont then Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    rwidth else Int
    rwidth
                  (ovFoundRaw, kxsFound) = wrapOKX monoFont ystart xstart width ks
                  ovFound = Overlay
    ovPrefix Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    ++ Overlay
    ovFoundRaw
              report <- getReportUI True
              CCUI{coinput} <- getsSession sccui
              mstash <- getsState $ \State
    s -> Faction -> Maybe (LevelId, Point)
    gstash (Faction -> Maybe (LevelId, Point))
    -> Faction -> Maybe (LevelId, Point)
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap FactionId Faction
    sfactionD State
    s EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    side
              curTutorial <- getsSession scurTutorial
              overrideTut <- getsSession soverrideTut
              let displayTutorialHints = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    overrideTut
                  calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorCurAndMaxSk
                  greyedOut HumanCmd
    cmd = Bool -> Bool
    not Bool
    calmE Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp
                                  Bool -> Bool -> Bool
    || Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
                                     Bool -> Bool -> Bool
    && CStore
    fromCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CGround
                                  Bool -> Bool -> Bool
    || case HumanCmd
    cmd of
                    ByAimMode AimModeCmd{HumanCmd
    exploration :: HumanCmd
    aiming :: HumanCmd
    aiming :: AimModeCmd -> HumanCmd
    exploration :: AimModeCmd -> HumanCmd
    ..} ->
                      HumanCmd -> Bool
    greyedOut HumanCmd
    exploration Bool -> Bool -> Bool
    || HumanCmd -> Bool
    greyedOut HumanCmd
    aiming
                    ComposeIfLocal HumanCmd
    cmd1 HumanCmd
    cmd2 -> HumanCmd -> Bool
    greyedOut HumanCmd
    cmd1 Bool -> Bool -> Bool
    || HumanCmd -> Bool
    greyedOut HumanCmd
    cmd2
                    ComposeUnlessError HumanCmd
    cmd1 HumanCmd
    cmd2 -> HumanCmd -> Bool
    greyedOut HumanCmd
    cmd1 Bool -> Bool -> Bool
    || HumanCmd -> Bool
    greyedOut HumanCmd
    cmd2
                    Compose2ndLocal HumanCmd
    cmd1 HumanCmd
    cmd2 -> HumanCmd -> Bool
    greyedOut HumanCmd
    cmd1 Bool -> Bool -> Bool
    || HumanCmd -> Bool
    greyedOut HumanCmd
    cmd2
                    MoveItem [CStore]
    stores CStore
    destCStore Maybe Text
    _ Bool
    _ ->
                      CStore
    fromCStore CStore -> [CStore] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [CStore]
    stores
                      Bool -> Bool -> Bool
    || CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CEqp Bool -> Bool -> Bool
    && (Bool -> Bool
    not Bool
    calmE Bool -> Bool -> Bool
    || Actor -> Int -> Bool
    eqpOverfull Actor
    b Int
    1)
                      Bool -> Bool -> Bool
    || CStore
    destCStore CStore -> CStore -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStore
    CGround Bool -> Bool -> Bool
    && Maybe (LevelId, Point)
    mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b)
                    Apply{} ->
                      let skill :: Int
    skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorCurAndMaxSk
                      in Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Either ReqFailure Bool -> Bool
    forall b a. b -> Either a b -> b
    fromRight Bool
    False
                             (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ RuleContent
    -> Time
    -> Int
    -> Bool
    -> Maybe CStore
    -> ItemFull
    -> (Int, ItemTimers)
    -> Either ReqFailure Bool
    permittedApply RuleContent
    corule Time
    localTime Int
    skill Bool
    calmE
                                              (CStore -> Maybe CStore
    forall a. a -> Maybe a
    Just CStore
    fromCStore) ItemFull
    itemFull (Int, ItemTimers)
    kit
                    Project{} ->
                      let skill :: Int
    skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkProject Skills
    actorCurAndMaxSk
                      in Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Either ReqFailure Bool -> Bool
    forall b a. b -> Either a b -> b
    fromRight Bool
    False
                             (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
    permittedProject Bool
    False Int
    skill Bool
    calmE ItemFull
    itemFull
                    HumanCmd
    _ -> Bool
    False
                  fmt Int
    n Text
    k Text
    h = Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Char -> Text -> Text
    T.justifyLeft Int
    n Char
    ' ' Text
    k Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    h
                  offsetCol2 = Int
    11
                  keyCaption = Int -> Text -> Text -> Text
    fmt Int
    offsetCol2 Text
    "keys" Text
    "command"
                  offset = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Overlay -> Int
    maxYofOverlay (Overlay
    ovDesc Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    ++ Overlay
    ovFound)
                  (ov0, kxs0) = xytranslateOKX 0 offset $
                     okxsN coinput monoFont propFont offsetCol2 greyedOut
                           True CmdItemMenu ([], [], ["", keyCaption]) ([], [])
                  t0 = [Part] -> Text
    makeSentence [ Part -> Part -> Part
    MU.SubjectVerbSg (ActorUI -> Part
    partActor ActorUI
    bUI) Part
    "choose"
                                    , Part
    "an item", Text -> Part
    MU.Text (Text -> Part) -> Text -> Part
    forall a b. (a -> b) -> a -> b
    $ CStore -> Text
    ppCStoreIn CStore
    fromCStore ]
                  alRep = (AttrString -> AttrString -> AttrString)
    -> AttrString -> [AttrString] -> AttrString
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr AttrString -> AttrString -> AttrString
    (<+:>) [] ([AttrString] -> AttrString) -> [AttrString] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Bool -> Report -> [AttrString]
    renderReport Bool
    True Report
    report
                  al1 | AttrString -> Bool
    forall a. [a] -> Bool
    null AttrString
    alRep = Text -> AttrString
    textToAS Text
    t0
                      | Bool
    otherwise = AttrString
    alRep AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ String -> AttrString
    stringToAS String
    "\n" AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ Text -> AttrString
    textToAS Text
    t0
                  splitHelp (AttrString
    al, (EnumMap DisplayFont Overlay, [KYX])
    okx) =
                    FontSetup
    -> Bool
    -> Int
    -> Int
    -> Int
    -> AttrString
    -> [KM]
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitOKX FontSetup
    fontSetup Bool
    False Int
    rwidth (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Int
    rwidth AttrString
    al
                             [KM
    K.spaceKM, KM
    K.escKM] (EnumMap DisplayFont Overlay, [KYX])
    okx
                  sli = FontSetup
    -> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    toSlideshow FontSetup
    fontSetup Bool
    displayTutorialHints
                        ([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
    -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
    forall a b. (a -> b) -> a -> b
    $ (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
    -> [(EnumMap DisplayFont Overlay, [KYX])]
    splitHelp ( AttrString
    al1
                                    , ( (Overlay -> Overlay -> Overlay)
    -> DisplayFont
    -> Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++) DisplayFont
    squareFont Overlay
    ovLab
                                        (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ (Overlay -> Overlay -> Overlay)
    -> DisplayFont
    -> Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++) DisplayFont
    propFont Overlay
    ovDesc
                                        (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ (Overlay -> Overlay -> Overlay)
    -> DisplayFont
    -> Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall k a.
    Enum k =>
    (a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
    EM.insertWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++) DisplayFont
    monoFont Overlay
    ovFound EnumMap DisplayFont Overlay
    ov0
                                            -- mono font, because there are buttons
                                      , [KYX]
    kxsFound [KYX] -> [KYX] -> [KYX]
    forall a. [a] -> [a] -> [a]
    ++ [KYX]
    kxs0 ))
                  extraKeys = [KM
    K.spaceKM, KM
    K.escKM] [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM]
    foundKeys
              recordHistory  -- report shown (e.g., leader switch), save to history
              ekm <- displayChoiceScreen "item menu" ColorFull False sli extraKeys
              case ekm of
                Left KM
    km -> case KM
    km KM -> Map KM CmdTriple -> Maybe CmdTriple
    forall k a. Ord k => k -> Map k a -> Maybe a
    `M.lookup` InputContent -> Map KM CmdTriple
    bcmdMap InputContent
    coinput of
                  Maybe CmdTriple
    _ | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
                  Maybe CmdTriple
    _ | KM
    km KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.spaceKM ->
                    ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> ItemDialogMode
    -> m (Either MError ReqUI)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> ItemDialogMode
    -> m (Either MError ReqUI)
    chooseItemMenuHuman ActorId
    leader KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM ItemDialogMode
    dmode
                  Maybe CmdTriple
    _ | KM
    km KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    foundKeys -> case KM
    km of
                    K.KM{key :: KM -> Key
    key=K.Fun Int
    n} -> do
                      let (ActorId
    newAid, (Actor
    bNew, CStore
    newCStore)) = [(ActorId, (Actor, CStore))]
    foundAlt [(ActorId, (Actor, CStore))] -> Int -> (ActorId, (Actor, CStore))
    forall a. (?callStack::CallStack) => [a] -> Int -> a
    !! (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                      fact <- (State -> Faction) -> m Faction
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Faction) -> m Faction)
    -> (State -> Faction) -> m Faction
    forall a b. (a -> b) -> a -> b
    $ (EnumMap FactionId Faction -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    side) (EnumMap FactionId Faction -> Faction)
    -> (State -> EnumMap FactionId Faction) -> State -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> EnumMap FactionId Faction
    sfactionD
                      let banned = Faction -> Bool
    bannedPointmanSwitchBetweenLevels Faction
    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 $ \SessionUI
    sess ->
                          SessionUI
    sess {sitemSel = Just (iid, newCStore, False)}
                        itemMenuHuman newAid cmdSemInCxtOfKM
                    KM
    _ -> String -> m (Either MError ReqUI)
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (Either MError ReqUI))
    -> String -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KM -> String
    forall v. Show v => String -> v -> String
    `showFailure` KM
    km
                  Just ([CmdCategory]
    _desc, Text
    _cats, HumanCmd
    cmd) -> do
                    (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                      SessionUI
    sess {sitemSel = Just (iid, fromCStore, True)}
                    KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
                  Maybe CmdTriple
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
                Right MenuSlot
    _slot -> String -> m (Either MError ReqUI)
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (Either MError ReqUI))
    -> String -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    ekm
        Maybe (ItemId, CStore, Bool)
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> ItemDialogMode
    -> m (Either MError ReqUI)
    chooseItemMenuHuman ActorId
    leader1 KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM ItemDialogMode
    c1 = do
      res2 <- ActorId -> Bool -> ItemDialogMode -> m (FailOrCmd ActorId)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId -> Bool -> ItemDialogMode -> m (FailOrCmd ActorId)
    chooseItemDialogMode ActorId
    leader1 Bool
    True ItemDialogMode
    c1
      case res2 of
        Right ActorId
    leader2 -> ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    forall (m :: * -> *).
    MonadClientUI m =>
    ActorId
    -> (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    itemMenuHuman ActorId
    leader2 KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM
        Left FailError
    err -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either MError ReqUI -> m (Either MError ReqUI))
    -> Either MError ReqUI -> m (Either MError ReqUI)
    forall a b. (a -> b) -> a -> b
    $ MError -> Either MError ReqUI
    forall a b. a -> Either a b
    Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
    forall a b. (a -> b) -> a -> b
    $ FailError -> MError
    forall a. a -> Maybe a
    Just FailError
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> EnumMap DisplayFont Overlay
    -> [(Text, HumanCmd, Maybe HumanCmd,
         Maybe (EnumMap DisplayFont Overlay))]
    -> [String]
    -> String
    -> m (Either MError ReqUI)
    generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM EnumMap DisplayFont Overlay
    blurb [(Text, HumanCmd, Maybe HumanCmd,
      Maybe (EnumMap DisplayFont Overlay))]
    kdsRaw [String]
    gameInfo String
    menuName = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      CCUI{ coinput=InputContent{brevMap}
          , coscreen=ScreenContent{rheight, rwebAddress} } <- getsSession sccui
      FontSetup{..} <- getFontSetup
      let matchKM MenuSlot
    slot kd :: (Text, HumanCmd, Maybe HumanCmd,
     Maybe (EnumMap DisplayFont Overlay))
    kd@(Text
    _, HumanCmd
    cmd, Maybe HumanCmd
    _, Maybe (EnumMap DisplayFont Overlay)
    _) = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup HumanCmd
    cmd Map HumanCmd [KM]
    brevMap of
            Just (KM
    km : [KM]
    _) -> (KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left KM
    km, (Text, HumanCmd, Maybe HumanCmd,
     Maybe (EnumMap DisplayFont Overlay))
    kd)
            Maybe [KM]
    _ -> (MenuSlot -> KeyOrSlot
    forall a b. b -> Either a b
    Right MenuSlot
    slot, (Text, HumanCmd, Maybe HumanCmd,
     Maybe (EnumMap DisplayFont Overlay))
    kd)
          kds = (MenuSlot
     -> (Text, HumanCmd, Maybe HumanCmd,
         Maybe (EnumMap DisplayFont Overlay))
     -> (KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))))
    -> [MenuSlot]
    -> [(Text, HumanCmd, Maybe HumanCmd,
         Maybe (EnumMap DisplayFont Overlay))]
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith MenuSlot
    -> (Text, HumanCmd, Maybe HumanCmd,
        Maybe (EnumMap DisplayFont Overlay))
    -> (KeyOrSlot,
        (Text, HumanCmd, Maybe HumanCmd,
         Maybe (EnumMap DisplayFont Overlay)))
    matchKM [MenuSlot]
    natSlots [(Text, HumanCmd, Maybe HumanCmd,
      Maybe (EnumMap DisplayFont Overlay))]
    kdsRaw
          bindings =  -- key bindings to display
            let attrCursor :: Attr
    attrCursor = Attr
    Color.defAttr {Color.bg = Color.HighlightNoneCursor}
                highAttr :: AttrChar -> AttrChar
    highAttr AttrChar
    ac = AttrChar
    ac {Color.acAttr = attrCursor}
                highW32 :: AttrCharW32 -> AttrCharW32
    highW32 = AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrChar
    highAttr (AttrChar -> AttrChar)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> AttrChar
    Color.attrCharFromW32
                markFirst :: Text -> AttrString
    markFirst Text
    d = AttrString -> AttrString
    markFirstAS (AttrString -> AttrString) -> AttrString -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Text -> AttrString
    textToAS Text
    d
                markFirstAS :: AttrString -> AttrString
    markFirstAS [] = []
                markFirstAS (AttrCharW32
    ac : AttrString
    rest) = AttrCharW32 -> AttrCharW32
    highW32 AttrCharW32
    ac AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    rest
                fmt :: (a, (Text, b, c, d)) -> (a, AttrString)
    fmt (a
    ekm, (Text
    d, b
    _, c
    _, d
    _)) = (a
    ekm, Text -> AttrString
    markFirst Text
    d)
            in ((KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))
     -> (KeyOrSlot, AttrString))
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> [(KeyOrSlot, AttrString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (KeyOrSlot,
     (Text, HumanCmd, Maybe HumanCmd,
      Maybe (EnumMap DisplayFont Overlay)))
    -> (KeyOrSlot, AttrString)
    forall {a} {b} {c} {d}. (a, (Text, b, c, d)) -> (a, AttrString)
    fmt [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds
          generate :: Int -> (KeyOrSlot, AttrString) -> KYX
          generate Int
    y (KeyOrSlot
    ekm, AttrString
    binding) =
            (KeyOrSlot
    ekm, (Int -> Int -> PointUI
    PointUI Int
    0 Int
    y, DisplayFont -> Int -> ButtonWidth
    ButtonWidth DisplayFont
    squareFont (AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    binding)))
          okxBindings = ( DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    squareFont
                          (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ [AttrLine] -> Overlay
    offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
    forall a b. (a -> b) -> a -> b
    $ ((KeyOrSlot, AttrString) -> AttrLine)
    -> [(KeyOrSlot, AttrString)] -> [AttrLine]
    forall a b. (a -> b) -> [a] -> [b]
    map (AttrString -> AttrLine
    attrStringToAL (AttrString -> AttrLine)
    -> ((KeyOrSlot, AttrString) -> AttrString)
    -> (KeyOrSlot, AttrString)
    -> AttrLine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (KeyOrSlot, AttrString) -> AttrString
    forall a b. (a, b) -> b
    snd) [(KeyOrSlot, AttrString)]
    bindings
                        , (Int -> (KeyOrSlot, AttrString) -> KYX)
    -> [Int] -> [(KeyOrSlot, AttrString)] -> [KYX]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> (KeyOrSlot, AttrString) -> KYX
    generate [Int
    0..] [(KeyOrSlot, AttrString)]
    bindings )
          titleLine =
            RuleContent -> String
    rtitle RuleContent
    corule String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    showVersion (RuleContent -> Version
    rexeVersion RuleContent
    corule) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
          titleAndInfo = (String -> AttrLine) -> [String] -> [AttrLine]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> AttrLine
    stringToAL
                             ([ String
    ""
                              , String
    titleLine String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    rwebAddress String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
                              , String
    "" ]
                              [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    gameInfo)
          webButton = ( KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left (KM -> KeyOrSlot) -> KM -> KeyOrSlot
    forall a b. (a -> b) -> a -> b
    $ Char -> KM
    K.mkChar Char
    '@'  -- to start the menu not here
                      , ( Int -> Int -> PointUI
    PointUI (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * String -> Int
    forall a. [a] -> Int
    length String
    titleLine) Int
    1
                        , DisplayFont -> Int -> ButtonWidth
    ButtonWidth DisplayFont
    squareFont (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    length String
    rwebAddress) ) )
          okxTitle = ( DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    squareFont (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ [AttrLine] -> Overlay
    offsetOverlay [AttrLine]
    titleAndInfo
                     , [KYX
    webButton] )
          okx = Int
    -> Int
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> (EnumMap DisplayFont Overlay, [KYX])
    xytranslateOKX Int
    2 Int
    0
                ((EnumMap DisplayFont Overlay, [KYX])
     -> (EnumMap DisplayFont Overlay, [KYX]))
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> (EnumMap DisplayFont Overlay, [KYX])
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> (EnumMap DisplayFont Overlay, [KYX])
    -> (EnumMap DisplayFont Overlay, [KYX])
    sideBySideOKX Int
    2 ([AttrLine] -> Int
    forall a. [a] -> Int
    length [AttrLine]
    titleAndInfo) (EnumMap DisplayFont Overlay, [KYX])
    okxTitle (EnumMap DisplayFont Overlay, [KYX])
    okxBindings
          prepareBlurb EnumMap DisplayFont Overlay
    ovs =
            let introLen :: Int
    introLen = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + EnumMap DisplayFont Overlay -> Int
    maxYofFontOverlayMap EnumMap DisplayFont Overlay
    ovs
                start0 :: Int
    start0 = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    introLen
                                Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - if DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont then Int
    1 else Int
    2)
            in (Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (Int -> Int -> Overlay -> Overlay
    xytranslateOverlay (-Int
    2) (Int
    start0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)) EnumMap DisplayFont Overlay
    ovs
              -- subtracting 2 from X and Y to negate the indentation in
              -- @displayChoiceScreenWithRightPane@
          returnDefaultOKS = (EnumMap DisplayFont Overlay, [KYX])
    -> m (EnumMap DisplayFont Overlay, [KYX])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    prepareBlurb EnumMap DisplayFont Overlay
    blurb, [])
          displayInRightPane KeyOrSlot
    ekm = case KeyOrSlot
    ekm KeyOrSlot
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> Maybe
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds of
            Just (Text
    _, HumanCmd
    _, Maybe HumanCmd
    _, Maybe (EnumMap DisplayFont Overlay)
    mblurbRight) -> case Maybe (EnumMap DisplayFont Overlay)
    mblurbRight of
              Maybe (EnumMap DisplayFont Overlay)
    Nothing -> m (EnumMap DisplayFont Overlay, [KYX])
    returnDefaultOKS
              Just EnumMap DisplayFont Overlay
    blurbRight -> (EnumMap DisplayFont Overlay, [KYX])
    -> m (EnumMap DisplayFont Overlay, [KYX])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    prepareBlurb EnumMap DisplayFont Overlay
    blurbRight, [])
            Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing | KeyOrSlot
    ekm KeyOrSlot -> KeyOrSlot -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left (Char -> KM
    K.mkChar Char
    '@') -> m (EnumMap DisplayFont Overlay, [KYX])
    returnDefaultOKS
            Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing -> String -> m (EnumMap DisplayFont Overlay, [KYX])
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m (EnumMap DisplayFont Overlay, [KYX]))
    -> String -> m (EnumMap DisplayFont Overlay, [KYX])
    forall a b. (a -> b) -> a -> b
    $ String
    "generateMenu: unexpected key:"
                               String -> KeyOrSlot -> String
    forall v. Show v => String -> v -> String
    `showFailure` KeyOrSlot
    ekm
          keys = [KM
    K.leftKM, KM
    K.rightKM, KM
    K.escKM, Char -> KM
    K.mkChar Char
    '@']
          loop = do
            kmkm <- (KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX]))
    -> Bool
    -> String
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Either (KM, KeyOrSlot) MenuSlot)
    forall (m :: * -> *).
    MonadClientUI m =>
    (KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX]))
    -> Bool
    -> String
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Either (KM, KeyOrSlot) MenuSlot)
    displayChoiceScreenWithRightPaneKMKM KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX])
    displayInRightPane Bool
    True
                                                         String
    menuName ColorMode
    ColorFull Bool
    True
                                                         ((EnumMap DisplayFont Overlay, [KYX]) -> Slideshow
    menuToSlideshow (EnumMap DisplayFont Overlay, [KYX])
    okx) [KM]
    keys
            case kmkm of
              Left (km :: KM
    km@(K.KM {key :: KM -> Key
    key=Key
    K.Left}), KeyOrSlot
    ekm) -> case KeyOrSlot
    ekm KeyOrSlot
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> Maybe
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds of
                Just (Text
    _, HumanCmd
    _, Maybe HumanCmd
    Nothing, Maybe (EnumMap DisplayFont Overlay)
    _) -> m (Either MError ReqUI)
    loop
                Just (Text
    _, HumanCmd
    _, Just HumanCmd
    cmdReverse, Maybe (EnumMap DisplayFont Overlay)
    _) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmdReverse
                Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Left (km :: KM
    km@(K.KM {key :: KM -> Key
    key=Key
    K.Right}), KeyOrSlot
    ekm) -> case KeyOrSlot
    ekm KeyOrSlot
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> Maybe
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds of
                Just (Text
    _, HumanCmd
    cmd, Maybe HumanCmd
    _, Maybe (EnumMap DisplayFont Overlay)
    _) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
                Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Left (K.KM {key :: KM -> Key
    key=K.Char Char
    '@'}, KeyOrSlot
    _)-> do
                success <- String -> m Bool
    forall (m :: * -> *). MonadClientUI m => String -> m Bool
    tryOpenBrowser String
    rwebAddress
                if success
                then generateMenu cmdSemInCxtOfKM blurb kdsRaw gameInfo menuName
                else weaveJust <$> failWith "failed to open web browser"
              Left (KM
    km, KeyOrSlot
    _) -> case KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left KM
    km KeyOrSlot
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> Maybe
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds of
                Just (Text
    _, HumanCmd
    cmd, Maybe HumanCmd
    _, Maybe (EnumMap DisplayFont Overlay)
    _) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
                Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
              Right MenuSlot
    slot -> case MenuSlot -> KeyOrSlot
    forall a b. b -> Either a b
    Right MenuSlot
    slot KeyOrSlot
    -> [(KeyOrSlot,
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay)))]
    -> Maybe
         (Text, HumanCmd, Maybe HumanCmd,
          Maybe (EnumMap DisplayFont Overlay))
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(KeyOrSlot,
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay)))]
    kds of
                Just (Text
    _, HumanCmd
    cmd, Maybe HumanCmd
    _, Maybe (EnumMap DisplayFont Overlay)
    _) -> KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    K.escKM HumanCmd
    cmd
                Maybe
      (Text, HumanCmd, Maybe HumanCmd,
       Maybe (EnumMap DisplayFont Overlay))
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
    forall a. FailOrCmd a -> Either MError a
    weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
    -> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> m (FailOrCmd ReqUI)
    forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
    failWith Text
    "never mind"
      loop

    -- | Display the main menu.
    mainMenuHuman :: MonadClientUI m
                  => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                  -> m (Either MError ReqUI)
    mainMenuHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      CCUI{coscreen=ScreenContent{rintroScreen}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      FontSetup{propFont} <- getFontSetup
      gameMode <- getGameMode
      curTutorial <- getsSession scurTutorial
      overrideTut <- getsSession soverrideTut
      curChal <- getsClient scurChal
      let offOn Bool
    b = if Bool
    b then a
    "on" else a
    "off"
          -- Key-description-command tuples.
          kds = [ (Text
    "+ setup and start new game>", HumanCmd
    ChallengeMenu, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "@ save and exit to desktop", HumanCmd
    GameExit, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "+ tweak convenience settings>", HumanCmd
    SettingsMenu, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "@ toggle autoplay", HumanCmd
    AutomateToggle, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "@ see command help", HumanCmd
    Help, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "@ switch to dashboard", HumanCmd
    Dashboard, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing)
                , (Text
    "^ back to playing", HumanCmd
    AutomateBack, Maybe a
    forall a. Maybe a
    Nothing, Maybe a
    forall a. Maybe a
    Nothing) ]
          gameName = ModeKind -> Text
    MK.mname ModeKind
    gameMode
          displayTutorialHints = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    overrideTut
          gameInfo = (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack
                       [ Text
    "Now playing:" Text -> Text -> Text
    <+> Text
    gameName
                       , Text
    ""
                       , Text
    "      with difficulty:" Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow (Challenge -> Int
    cdiff Challenge
    curChal)
                       , Text
    "            cold fish:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cfish Challenge
    curChal)
                       , Text
    "          ready goods:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cgoods Challenge
    curChal)
                       , Text
    "            lone wolf:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cwolf Challenge
    curChal)
                       , Text
    "        finder keeper:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    ckeeper Challenge
    curChal)
                       , Text
    "       tutorial hints:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn Bool
    displayTutorialHints
                       , Text
    "" ]
          glueLines ([a]
    l1 : [a]
    l2 : [[a]]
    rest) =
            if | [a] -> Bool
    forall a. [a] -> Bool
    null [a]
    l1 -> [a]
    l1 [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [[a]]
    glueLines ([a]
    l2 [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]]
    rest)
               | [a] -> Bool
    forall a. [a] -> Bool
    null [a]
    l2 -> [a]
    l1 [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a]
    l2 [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [[a]]
    glueLines [[a]]
    rest
               | Bool
    otherwise -> ([a]
    l1 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    l2) [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [[a]] -> [[a]]
    glueLines [[a]]
    rest
          glueLines [[a]]
    ll = [[a]]
    ll
          backstory | DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont = ([String], [[String]]) -> [String]
    forall a b. (a, b) -> a
    fst ([String], [[String]])
    rintroScreen
                    | Bool
    otherwise = [String] -> [String]
    forall {a}. [[a]] -> [[a]]
    glueLines ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ([String], [[String]]) -> [String]
    forall a b. (a, b) -> a
    fst ([String], [[String]])
    rintroScreen
          backstoryAL = (String -> AttrLine) -> [String] -> [AttrLine]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> AttrLine
    stringToAL (String -> AttrLine) -> (String -> String) -> String -> AttrLine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')) [String]
    backstory
          blurb = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap [(DisplayFont
    propFont, [AttrLine]
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    mainMenuAutoOnHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {swasAutomated = True}
      (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM

    -- * MainMenuAutoOff

    -- | Display the main menu and unset @swasAutomated@.
    mainMenuAutoOffHuman :: MonadClientUI m
                         => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                         -> m (Either MError ReqUI)
    mainMenuAutoOffHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    mainMenuAutoOffHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {swasAutomated = False}
      (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM

    -- * SettingsMenu

    -- | Display the settings menu.
    settingsMenuHuman :: MonadClientUI m
                      => (K.KM -> HumanCmd -> m (Either MError ReqUI))
                      -> m (Either MError ReqUI)
    settingsMenuHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    settingsMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    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 Bool
    b = if Bool
    b then a
    "on" else a
    "off"
          offOnAll v
    n = case v
    n of
            v
    0 -> a
    "none"
            v
    1 -> a
    "untried"
            v
    2 -> a
    "all"
            v
    _ -> String -> a
    forall a. (?callStack::CallStack) => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> v -> String
    forall v. Show v => String -> v -> String
    `showFailure` v
    n
          neverEver v
    n = case v
    n of
            v
    0 -> a
    "never"
            v
    1 -> a
    "aiming"
            v
    2 -> a
    "always"
            v
    _ -> String -> a
    forall a. (?callStack::CallStack) => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> v -> String
    forall v. Show v => String -> v -> String
    `showFailure` v
    n
          offOnUnset Maybe Bool
    mb = case Maybe Bool
    mb of
            Maybe Bool
    Nothing -> a
    "pass"
            Just Bool
    b -> if Bool
    b then a
    "force on" else a
    "force off"
          tsuspect = Text
    "@ mark suspect terrain:" Text -> Text -> Text
    <+> Int -> Text
    forall {v} {a}. (Eq v, Num v, IsString a, Show v) => v -> a
    offOnAll Int
    markSuspect
          tvisible = Text
    "@ show visible zone:" Text -> Text -> Text
    <+> Int -> Text
    forall {v} {a}. (Eq v, Num v, IsString a, Show v) => v -> a
    neverEver Int
    markVision
          tsmell = Text
    "@ display smell clues:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn Bool
    markSmell
          tanim = Text
    "@ play animations:" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Bool -> Bool
    not Bool
    noAnim)
          tdoctrine = Text
    "@ squad doctrine:" Text -> Text -> Text
    <+> Doctrine -> Text
    Ability.nameDoctrine Doctrine
    factDoctrine
          toverride = Text
    "@ override tutorial hints:" Text -> Text -> Text
    <+> Maybe Bool -> Text
    forall {a}. IsString a => Maybe Bool -> a
    offOnUnset Maybe Bool
    overrideTut
          width = if DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont
                  then Int
    rwidth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                  else Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    uMsgWrapColumn (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)
          textToBlurb Text
    t = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
    forall a. a -> Maybe a
    Just (EnumMap DisplayFont Overlay
     -> Maybe (EnumMap DisplayFont Overlay))
    -> EnumMap DisplayFont Overlay
    -> Maybe (EnumMap DisplayFont Overlay)
    forall a b. (a -> b) -> a -> b
    $ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap
            [ ( DisplayFont
    propFont
              , Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    width Int
    width
                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ Text -> AttrString
    textToAS Text
    t ) ]
          -- Key-description-command-text tuples.
          kds = [ ( Text
    tsuspect, Int -> HumanCmd
    MarkSuspect Int
    1, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just (Int -> HumanCmd
    MarkSuspect (-Int
    1))
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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." )
                , ( Text
    tvisible, Int -> HumanCmd
    MarkVision Int
    1, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just (Int -> HumanCmd
    MarkVision (-Int
    1))
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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." )
                , ( Text
    tsmell, HumanCmd
    MarkSmell, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    MarkSmell
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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)." )
                , ( Text
    tanim, HumanCmd
    MarkAnim, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    MarkAnim
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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." )
                , ( Text
    tdoctrine, HumanCmd
    Doctrine, Maybe HumanCmd
    forall a. Maybe a
    Nothing
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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." )
                , ( Text
    toverride, Int -> HumanCmd
    OverrideTut Int
    1, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just (Int -> HumanCmd
    OverrideTut (-Int
    1))
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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." )
                , ( Text
    "^ back to main menu", HumanCmd
    MainMenu, Maybe HumanCmd
    forall a. Maybe a
    Nothing, EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
    forall a. a -> Maybe a
    Just EnumMap DisplayFont Overlay
    forall k a. EnumMap k a
    EM.empty ) ]
          gameInfo = (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack
                       [ Text
    "Tweak convenience settings:"
                       , Text
    "" ]
      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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KM -> HumanCmd -> m (Either MError ReqUI))
    -> m (Either MError ReqUI)
    challengeMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM = do
      cops <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    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 ContentId ModeKind
    -> EnumMap (ContentId ModeKind) (Map Challenge Int)
    -> Maybe (Map Challenge Int)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup ContentId ModeKind
    gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
    svictories of
            Maybe (Map Challenge Int)
    Nothing -> Int
    0
            Just Map Challenge Int
    cm -> Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Challenge -> Map Challenge Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Challenge
    nxtChal Map Challenge Int
    cm)
          star Text
    t = if Int
    victories Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then Text
    "*" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t else Text
    t
          tnextScenario = Text
    "@ adventure:" Text -> Text -> Text
    <+> Text -> Text
    star (ModeKind -> Text
    MK.mname ModeKind
    gameMode)
          offOn Bool
    b = if Bool
    b then a
    "on" else a
    "off"
          tnextDiff = Text
    "@ difficulty level:" Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow (Challenge -> Int
    cdiff Challenge
    nxtChal)
          tnextFish = Text
    "@ cold fish (rather hard):" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cfish Challenge
    nxtChal)
          tnextGoods = Text
    "@ ready goods (hard):" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cgoods Challenge
    nxtChal)
          tnextWolf = Text
    "@ lone wolf (very hard):" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    cwolf Challenge
    nxtChal)
          tnextKeeper = Text
    "@ finder keeper (hard):" Text -> Text -> Text
    <+> Bool -> Text
    forall {a}. IsString a => Bool -> a
    offOn (Challenge -> Bool
    ckeeper Challenge
    nxtChal)
          width = if DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont
                  then Int
    rwidth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                  else Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    uMsgWrapColumn (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2)
          widthFull = if DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont
                      then Int
    rwidth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                      else Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
          duplicateEOL Char
    '\n' = Text
    "\n\n"
          duplicateEOL Char
    c = Char -> Text
    T.singleton Char
    c
          blurb = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
    forall a. a -> Maybe a
    Just (EnumMap DisplayFont Overlay
     -> Maybe (EnumMap DisplayFont Overlay))
    -> EnumMap DisplayFont Overlay
    -> Maybe (EnumMap DisplayFont Overlay)
    forall a b. (a -> b) -> a -> b
    $ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap
            [ ( DisplayFont
    propFont
              , Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    width Int
    width
                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ Color -> Text -> AttrString
    textFgToAS Color
    Color.BrBlack
                (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Text) -> Text -> Text
    T.concatMap Char -> Text
    duplicateEOL (ModeKind -> Text
    MK.mdesc ModeKind
    gameMode)
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n" )
            , ( DisplayFont
    propFont
              , Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    widthFull Int
    widthFull
                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ Text -> AttrString
    textToAS
                (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $ ModeKind -> Text
    MK.mrules ModeKind
    gameMode
                  Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\n\n" )
            , ( DisplayFont
    propFont
              , Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    width Int
    width
                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ Text -> AttrString
    textToAS
                (Text -> AttrString) -> Text -> AttrString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Text) -> Text -> Text
    T.concatMap Char -> Text
    duplicateEOL (ModeKind -> Text
    MK.mreason ModeKind
    gameMode) )
            ]
          textToBlurb Text
    t = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
    forall a. a -> Maybe a
    Just (EnumMap DisplayFont Overlay
     -> Maybe (EnumMap DisplayFont Overlay))
    -> EnumMap DisplayFont Overlay
    -> Maybe (EnumMap DisplayFont Overlay)
    forall a b. (a -> b) -> a -> b
    $ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
    attrLinesToFontMap
            [ ( DisplayFont
    propFont
              , Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    width Int
    width  -- not widthFull!
                (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $ Text -> AttrString
    textToAS Text
    t ) ]
          -- Key-description-command-text tuples.
          kds = [ ( Text
    tnextScenario, Int -> HumanCmd
    GameScenarioIncr Int
    1, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just (Int -> HumanCmd
    GameScenarioIncr (-Int
    1))
                  , Maybe (EnumMap DisplayFont Overlay)
    blurb )
                , ( Text
    tnextDiff, Int -> HumanCmd
    GameDifficultyIncr Int
    1, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just (Int -> HumanCmd
    GameDifficultyIncr (-Int
    1))
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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.")
                , ( Text
    tnextFish, HumanCmd
    GameFishToggle, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    GameFishToggle
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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).")
                , ( Text
    tnextGoods, HumanCmd
    GameGoodsToggle, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    GameGoodsToggle
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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).")
                , ( Text
    tnextWolf, HumanCmd
    GameWolfToggle, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    GameWolfToggle
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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.")
                , ( Text
    tnextKeeper, HumanCmd
    GameKeeperToggle, HumanCmd -> Maybe HumanCmd
    forall a. a -> Maybe a
    Just HumanCmd
    GameKeeperToggle
                  , Text -> Maybe (EnumMap DisplayFont Overlay)
    textToBlurb Text
    "* 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.")
                , ( Text
    "@ start new game", HumanCmd
    GameRestart, Maybe HumanCmd
    forall a. Maybe a
    Nothing, Maybe (EnumMap DisplayFont Overlay)
    blurb )
                , ( Text
    "^ back to main menu", HumanCmd
    MainMenu, Maybe HumanCmd
    forall a. Maybe a
    Nothing, Maybe (EnumMap DisplayFont Overlay)
    forall a. Maybe a
    Nothing ) ]
          gameInfo = (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack [ Text
    "Setup and start new game:"
                                  , Text
    "" ]
      generateMenu cmdSemInCxtOfKM EM.empty kds gameInfo "challenge"

    -- * GameDifficultyIncr

    gameDifficultyIncr :: MonadClient m => Int -> m ()
    gameDifficultyIncr :: forall (m :: * -> *). MonadClient m => Int -> m ()
    gameDifficultyIncr Int
    delta = do
      nxtDiff <- (StateClient -> Int) -> m Int
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Int) -> m Int) -> (StateClient -> Int) -> m Int
    forall a b. (a -> b) -> a -> b
    $ Challenge -> Int
    cdiff (Challenge -> Int)
    -> (StateClient -> Challenge) -> StateClient -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> Challenge
    snxtChal
      let d | Int
    nxtDiff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    delta Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    difficultyBound = Int
    1
            | Int
    nxtDiff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    delta Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 = Int
    difficultyBound
            | Bool
    otherwise = Int
    nxtDiff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    delta
      modifyClient $ \StateClient
    cli -> StateClient
    cli {snxtChal = (snxtChal cli) {cdiff = d} }

    -- * GameFishToggle

    gameFishToggle :: MonadClient m => m ()
    gameFishToggle :: forall (m :: * -> *). MonadClient m => m ()
    gameFishToggle =
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli ->
        StateClient
    cli {snxtChal = (snxtChal cli) {cfish = not (cfish (snxtChal cli))} }

    -- * GameGoodsToggle

    gameGoodsToggle :: MonadClient m => m ()
    gameGoodsToggle :: forall (m :: * -> *). MonadClient m => m ()
    gameGoodsToggle =
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli ->
        StateClient
    cli {snxtChal = (snxtChal cli) {cgoods = not (cgoods (snxtChal cli))} }

    -- * GameWolfToggle

    gameWolfToggle :: MonadClient m => m ()
    gameWolfToggle :: forall (m :: * -> *). MonadClient m => m ()
    gameWolfToggle =
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli ->
        StateClient
    cli {snxtChal = (snxtChal cli) {cwolf = not (cwolf (snxtChal cli))} }

    -- * GameKeeperToggle

    gameKeeperToggle :: MonadClient m => m ()
    gameKeeperToggle :: forall (m :: * -> *). MonadClient m => m ()
    gameKeeperToggle =
      (StateClient -> StateClient) -> m ()
    forall (m :: * -> *).
    MonadClient m =>
    (StateClient -> StateClient) -> m ()
    modifyClient ((StateClient -> StateClient) -> m ())
    -> (StateClient -> StateClient) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateClient
    cli ->
        StateClient
    cli {snxtChal = (snxtChal cli) {ckeeper = not (ckeeper (snxtChal cli))} }

    -- * GameScenarioIncr

    gameScenarioIncr :: MonadClientUI m => Int -> m ()
    gameScenarioIncr :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
    gameScenarioIncr Int
    delta = do
      cops <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      oldScenario <- getsSession snxtScenario
      let snxtScenario = Int
    oldScenario Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    delta
          snxtTutorial = ModeKind -> Bool
    MK.mtutorial (ModeKind -> Bool) -> ModeKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ (ContentId ModeKind, ModeKind) -> ModeKind
    forall a b. (a, b) -> b
    snd ((ContentId ModeKind, ModeKind) -> ModeKind)
    -> (ContentId ModeKind, ModeKind) -> ModeKind
    forall a b. (a -> b) -> a -> b
    $ COps -> Int -> (ContentId ModeKind, ModeKind)
    nxtGameMode COps
    cops Int
    snxtScenario
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {snxtScenario, snxtTutorial}

    -- * GameRestart & GameQuit

    data ExitStrategy = Restart | Quit

    gameExitWithHuman :: MonadClientUI m => ExitStrategy -> m (FailOrCmd ReqUI)
    gameExitWithHuman :: forall (m :: * -> *).
    MonadClientUI m =>
    ExitStrategy -> m (FailOrCmd ReqUI)
    gameExitWithHuman ExitStrategy
    exitStrategy = do
      snxtChal       <- (StateClient -> Challenge) -> m Challenge
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> Challenge
    snxtChal
      cops           <- getsState scops
      noConfirmsGame <- isNoConfirmsGame
      gameMode       <- getGameMode
      snxtScenario   <- getsSession snxtScenario
      let nxtGameName = ModeKind -> Text
    MK.mname (ModeKind -> Text) -> ModeKind -> Text
    forall a b. (a -> b) -> a -> b
    $ (ContentId ModeKind, ModeKind) -> ModeKind
    forall a b. (a, b) -> b
    snd ((ContentId ModeKind, ModeKind) -> ModeKind)
    -> (ContentId ModeKind, ModeKind) -> ModeKind
    forall a b. (a -> b) -> a -> b
    $ COps -> Int -> (ContentId ModeKind, ModeKind)
    nxtGameMode COps
    cops Int
    snxtScenario
          exitReturn GroupName ModeKind
    x = FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
    -> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
    forall a b. (a -> b) -> a -> b
    $ ReqUI -> FailOrCmd ReqUI
    forall a b. b -> Either a b
    Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
    forall a b. (a -> b) -> a -> b
    $ GroupName ModeKind -> Challenge -> ReqUI
    ReqUIGameRestart GroupName ModeKind
    x Challenge
    snxtChal
          displayExitMessage Text
    diff =
            ColorMode -> Text -> m Bool
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displayYesNo ColorMode
    ColorBW
            (Text -> m Bool) -> Text -> m Bool
    forall a b. (a -> b) -> a -> b
    $ Text
    diff Text -> Text -> Text
    <+> Text
    "progress of the ongoing"
              Text -> Text -> Text
    <+> ModeKind -> Text
    MK.mname ModeKind
    gameMode Text -> Text -> Text
    <+> Text
    "game will be lost! Are you sure?"
      ifM (if' noConfirmsGame
               (return True)  -- true case
               (displayExitMessage $ case exitStrategy of  -- false case
                  ExitStrategy
    Restart -> Text
    "You just requested a new" Text -> Text -> Text
    <+> Text
    nxtGameName
                             Text -> Text -> Text
    <+> Text
    "game. The "
                  ExitStrategy
    Quit -> Text
    "If you quit, the "))
          (exitReturn $ case exitStrategy of  -- ifM true case
             ExitStrategy
    Restart ->
               let (Text
    mainName, Text
    _) = (Char -> Bool) -> Text -> (Text, Text)
    T.span (\Char
    c -> Char -> Bool
    Char.isAlpha Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')
                                          Text
    nxtGameName
               in Text -> GroupName ModeKind
    forall c. Text -> GroupName c
    DefsInternal.GroupName (Text -> GroupName ModeKind) -> Text -> GroupName ModeKind
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    T.intercalate Text
    " "
                  ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    take Int
    2 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    T.words Text
    mainName
             ExitStrategy
    Quit -> GroupName ModeKind
    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 :: forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
    ifM m Bool
    b m b
    t m b
    f = do b' <- m Bool
    b; if b' then t else f

    if' :: Bool -> p -> p -> p
    if' :: forall p. Bool -> p -> p -> p
    if' Bool
    b p
    t p
    f = if Bool
    b then p
    t else p
    f

    -- * GameDrop

    gameDropHuman :: MonadClientUI m => m ReqUI
    gameDropHuman :: forall (m :: * -> *). MonadClientUI m => m ReqUI
    gameDropHuman = do
      (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sallNframes = -1}  -- hack, but we crash anyway
      MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgPromptGeneric Text
    "Interrupt! Trashing the unsaved game. The program exits now."
      Text -> m ()
    forall (m :: * -> *). MonadClientUI m => Text -> m ()
    clientPrintUI Text
    "Interrupt! Trashing the unsaved game. The program exits now."
        -- this is not shown by ANSI frontend, but at least shown by sdl2 one
      ReqUI -> m ReqUI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ReqUI
    ReqUIGameDropAndExit

    -- * GameExit

    gameExitHuman :: Monad m => m ReqUI
    gameExitHuman :: forall (m :: * -> *). Monad m => m ReqUI
    gameExitHuman =
      ReqUI -> m ReqUI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ReqUI
    ReqUIGameSaveAndExit

    -- * GameSave

    gameSaveHuman :: MonadClientUI m => m ReqUI
    gameSaveHuman :: forall (m :: * -> *). MonadClientUI m => m ReqUI
    gameSaveHuman = do
      -- Announce before the saving started, since it can take a while.
      MsgClassSave -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassSave
    MsgInnerWorkSpam Text
    "Saving game backup."
      ReqUI -> m ReqUI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ReqUI
    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 :: forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ReqUI)
    doctrineHuman = do
      fid <- (StateClient -> FactionId) -> m FactionId
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient StateClient -> FactionId
    sside
      fromT <- getsState $ gdoctrine . (EM.! fid) . sfactionD
      let toT = if Doctrine
    fromT Doctrine -> Doctrine -> Bool
    forall a. Eq a => a -> a -> Bool
    == Doctrine
    forall a. Bounded a => a
    maxBound then Doctrine
    forall a. Bounded a => a
    minBound else Doctrine -> Doctrine
    forall a. Enum a => a -> a
    succ Doctrine
    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 :: forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ReqUI)
    automateHuman = do
      m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    clearAimMode
      proceed <- ColorMode -> Text -> m Bool
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displayYesNo ColorMode
    ColorBW Text
    "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 :: forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ReqUI)
    automateToggleHuman = do
      swasAutomated <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    swasAutomated
      if swasAutomated
      then failWith "automation canceled"
      else automateHuman

    -- * AutomateBack

    automateBackHuman :: MonadClientUI m => m (Either MError ReqUI)
    automateBackHuman :: forall (m :: * -> *). MonadClientUI m => m (Either MError ReqUI)
    automateBackHuman = do
      swasAutomated <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    swasAutomated
      return $! if swasAutomated
                then Right ReqUIAutomate
                else Left Nothing