content: -- | Helper functions for both inventory management and human commands.
  module Game.LambdaHack.Client.UI.HandleHelperM
    ( FailError, showFailError, MError, mergeMError, FailOrCmd, failWith
    , failSer, failMsg, weaveJust
    , pointmanCycle, pointmanCycleLevel, partyAfterLeader
    , pickLeader, doLook, pickLeaderWithPointer
    , itemOverlay, skillsOverlay, placesFromState, placesOverlay
    , factionsFromState, factionsOverlay
    , describeMode, modesOverlay
    , pickNumber, guardItemSize, lookAtItems, lookAtStash, lookAtPosition
    , displayOneMenuItem, okxItemLoreInline, okxItemLoreMsg, itemDescOverlays
    , cycleLore, spoilsBlurb, ppContainerWownW, nxtGameMode
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , itemOverlayFromState, lookAtTile, lookAtActors, guardItemVerbs
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Control.Applicative
  import qualified Data.Char as Char
  import qualified Data.EnumMap.Strict as EM
  import qualified Data.EnumSet as ES
  import qualified Data.Map.Strict as M
  import qualified Data.Text as T
  import qualified NLP.Miniutter.English as MU
  
  import           Game.LambdaHack.Client.CommonM
  import           Game.LambdaHack.Client.MonadClient
  import           Game.LambdaHack.Client.State
  import           Game.LambdaHack.Client.UI.ActorUI
  import           Game.LambdaHack.Client.UI.Content.Screen
  import           Game.LambdaHack.Client.UI.ContentClientUI
  import           Game.LambdaHack.Client.UI.EffectDescription
  import           Game.LambdaHack.Client.UI.Frame
  import           Game.LambdaHack.Client.UI.ItemDescription
  import qualified Game.LambdaHack.Client.UI.Key as K
  import           Game.LambdaHack.Client.UI.MonadClientUI
  import           Game.LambdaHack.Client.UI.Msg
  import           Game.LambdaHack.Client.UI.MsgM
  import           Game.LambdaHack.Client.UI.Overlay
  import           Game.LambdaHack.Client.UI.PointUI
  import           Game.LambdaHack.Client.UI.SessionUI
  import           Game.LambdaHack.Client.UI.Slideshow
  import           Game.LambdaHack.Client.UI.SlideshowM
  import           Game.LambdaHack.Common.Actor
  import           Game.LambdaHack.Common.ActorState
  import           Game.LambdaHack.Common.ClientOptions
  import           Game.LambdaHack.Common.Faction
  import qualified Game.LambdaHack.Common.HighScore as HighScore
  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.Perception
  import           Game.LambdaHack.Common.Point
  import           Game.LambdaHack.Common.ReqFailure
  import           Game.LambdaHack.Common.State
  import           Game.LambdaHack.Common.Time
  import           Game.LambdaHack.Common.Types
  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 qualified Game.LambdaHack.Content.PlaceKind as PK
  import qualified Game.LambdaHack.Content.TileKind as TK
  import qualified Game.LambdaHack.Definition.Ability as Ability
  import qualified Game.LambdaHack.Definition.Color as Color
  import           Game.LambdaHack.Definition.Defs
  
  -- | Message describing the cause of failure of human command.
  newtype FailError = FailError {failError :: Text}
    deriving (Show, Eq)
  
  showFailError :: FailError -> Text
  showFailError (FailError err) = "*" <> err <> "*"
  
  type MError = Maybe FailError
  
  mergeMError :: MError -> MError -> MError
  mergeMError Nothing Nothing = Nothing
  mergeMError merr1@Just{} Nothing = merr1
  mergeMError Nothing merr2@Just{} = merr2
  mergeMError (Just err1) (Just err2) =
    Just $ FailError $ failError err1 <+> "and" <+> failError err2
  
  type FailOrCmd a = Either FailError a
  
  failWith :: MonadClientUI m => Text -> m (FailOrCmd a)
  failWith err = assert (not $ T.null err) $ return $ Left $ FailError err
  
  failSer :: MonadClientUI m => ReqFailure -> m (FailOrCmd a)
  failSer = failWith . showReqFailure
  
  failMsg :: MonadClientUI m => Text -> m MError
  failMsg err = assert (not $ T.null err) $ return $ Just $ FailError err
  
  weaveJust :: FailOrCmd a -> Either MError a
  weaveJust (Left ferr) = Left $ Just ferr
  weaveJust (Right a) = Right a
  
  -- | Switches current pointman to the next on the level, if any, wrapping.
  pointmanCycleLevel :: MonadClientUI m
                     => ActorId -> Bool -> Direction -> m MError
  pointmanCycleLevel leader verbose direction = do
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    lidV <- viewedLevelUI
    body <- getsState $ getActorBody leader
    hs <- partyAfterLeader leader
    let banned = bannedPointmanSwitchBetweenLevels fact
        hsSort = case direction of
          Forward -> hs
          Backward -> reverse hs
    case filter (\(_, b, _) -> blid b == lidV) hsSort of
      _ | banned && lidV /= blid body ->
        failMsg $ showReqFailure NoChangeDunLeader
      [] -> failMsg "cannot pick any other pointman on this level"
      (np, _b, _) : _ -> do
        _success <- pickLeader verbose np
  -- This apparently crashes rarely, probably becuase @leader@ gets out of sync
  -- with the leader in client state, during nested UI manipulations.
  -- The worst that can happen is TAB doing nothing and having to be repeated
  -- or perhaps item manipulation needs to be exited for TAB to work again.
  --      let !_A = assert (success `blame` "same leader"
  --                                `swith` (leader, np, b)) ()
        return Nothing
  
  -- | Switches current pointman to the previous in the whole dungeon, wrapping.
  pointmanCycle :: MonadClientUI m
                => ActorId -> Bool -> Direction -> m MError
  pointmanCycle leader verbose direction = do
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    hs <- partyAfterLeader leader
    let banned = bannedPointmanSwitchBetweenLevels fact
        hsSort = case direction of
          Forward -> hs
          Backward -> reverse hs
    case hsSort of
      _ | banned -> failMsg $ showReqFailure NoChangeDunLeader
      [] -> failMsg "no other member in the party"
      (np, b, _) : _ -> do
        success <- pickLeader verbose np
        let !_A = assert (success `blame` "same leader"
                                  `swith` (leader, np, b)) ()
        return Nothing
  
  partyAfterLeader :: MonadClientUI m => ActorId -> m [(ActorId, Actor, ActorUI)]
  partyAfterLeader leader = do
    side <- getsClient sside
    sactorUI <- getsSession sactorUI
    allOurs <- getsState $ fidActorNotProjGlobalAssocs side -- not only on level
    let allOursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) allOurs
        hs = sortOn keySelected allOursUI
        i = fromMaybe (-1) $ findIndex (\(aid, _, _) -> aid == leader) hs
        (lt, gt) = (take i hs, drop (i + 1) hs)
    return $! gt ++ lt
  
  -- | Select a faction leader. False, if nothing to do.
  pickLeader :: MonadClientUI m => Bool -> ActorId -> m Bool
  pickLeader verbose aid = do
    mleader <- getsClient sleader
    if mleader == Just aid
      then return False -- already picked
      else do
        body <- getsState $ getActorBody aid
        bodyUI <- getsSession $ getActorUI aid
        let !_A = assert (not (bproj body)
                          `blame` "projectile chosen as the pointman"
                          `swith` (aid, body)) ()
        -- Even if it's already the leader, give his proper name, not 'you'.
        let subject = partActor bodyUI
        when verbose $
          msgAdd MsgPointmanSwap $ makeSentence [subject, "picked as a pointman"]
        -- Update client state.
        updateClientLeader aid
        -- Move the xhair, if active, to the new level.
        modifySession $ \sess -> sess {saimMode =
          (\aimMode -> aimMode {aimLevelId = blid body}) <$> saimMode sess}
        -- Inform about items, etc.
        saimMode <- getsSession saimMode
        when verbose $
          if isJust saimMode
          then doLook
          else do
            (itemsBlurb, _) <-
              lookAtItems True (bpos body) (blid body) (Just aid) Nothing
            stashBlurb <- lookAtStash (bpos body) (blid body)
            msgAdd MsgAtFeetMinor $ stashBlurb <+> itemsBlurb
        return True
  
  -- | Perform look around in the current position of the xhair.
  -- Does nothing outside aiming mode.
  doLook :: MonadClientUI m => m ()
  doLook = do
    saimMode <- getsSession saimMode
    case saimMode of
      Just aimMode -> do
        let lidV = aimLevelId aimMode
        mxhairPos <- mxhairToPos
        xhairPos <- xhairToPos
        blurb <- lookAtPosition xhairPos lidV
        itemSel <- getsSession sitemSel
        mleader <- getsClient sleader
        outOfRangeBlurb <- case (itemSel, mxhairPos, mleader) of
          (Just (iid, _, _), Just pos, Just leader) -> do
            b <- getsState $ getActorBody leader
            if lidV /= blid b  -- no range warnings on remote levels
               || detailLevel aimMode < DetailHigh  -- no spam
            then return []
            else do
              itemFull <- getsState $ itemToFull iid
              let arItem = aspectRecordFull itemFull
              return [ (MsgPromptGeneric, "This position is out of range when flinging the selected item.")
                     | 1 + IA.totalRange arItem (itemKind itemFull)
                       < chessDist (bpos b) pos ]
          _ -> return []
        mapM_ (uncurry msgAdd) $ blurb ++ outOfRangeBlurb
      _ -> return ()
  
  pickLeaderWithPointer :: MonadClientUI m => ActorId -> m MError
  pickLeaderWithPointer leader = do
    CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
    lidV <- viewedLevelUI
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    arena <- getArenaUI
    sactorUI <- getsSession sactorUI
    ours <- getsState $ filter (not . bproj . snd)
                        . actorAssocs (== side) lidV
    let oursUI = map (\(aid, b) -> (aid, b, sactorUI EM.! aid)) ours
        viewed = sortOn keySelected oursUI
        banned = bannedPointmanSwitchBetweenLevels fact
        pick (aid, b) = if blid b /= arena && banned
                        then failMsg $ showReqFailure NoChangeDunLeader
                        else do
                          void $ pickLeader True aid
                          return Nothing
    pUI <- getsSession spointer
    let p@(Point px py) = squareToMap $ uiToSquare pUI
    -- Pick even if no space in status line for the actor's symbol.
    if | py == rheight - 2 && px == 0 -> pointmanCycle leader True Forward
       | py == rheight - 2 ->
           case drop (px - 1) viewed of
             [] -> return Nothing
               -- relaxed, due to subtleties of display of selected actors
             (aid, b, _) : _ -> pick (aid, b)
       | otherwise ->
           case find (\(_, b, _) -> bpos b == p) oursUI of
             Nothing -> failMsg "not pointing at an actor"
             Just (aid, b, _) -> pick (aid, b)
  
  itemOverlayFromState :: LevelId -> [(ItemId, ItemQuant)] -> Bool
                       -> CCUI -> FactionId -> DiscoveryBenefit -> FontSetup
                       -> State
                       -> OKX
  itemOverlayFromState arena iids displayRanged sccui side discoBenefit
                       FontSetup{..} s =
    let CCUI{coscreen=ScreenContent{rwidth}} = sccui
        localTime = getLocalTime arena s
        itemToF = flip itemToFull s
        factionD = sfactionD s
        attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
        markEqp periodic k ncha =
          if | periodic -> '"'  -- if equipped, no charges
             | ncha == 0 -> '-'  -- no charges left
             | k > ncha -> '~'  -- not all charges left
             | otherwise -> '+'
        pr :: MenuSlot -> (ItemId, ItemQuant)
           -> (AttrString, AttrString, KeyOrSlot)
        pr c (iid, kit@(k, _)) =
          let itemFull = itemToF iid
              arItem = aspectRecordFull itemFull
              colorSymbol =
                if IA.checkFlag Ability.Condition arItem
                then viewItemBenefitColored discoBenefit iid itemFull
                else viewItem itemFull
              phrase = makePhrase
                [partItemWsRanged rwidth side factionD displayRanged
                                  DetailLow 4 k localTime itemFull kit]
              ncha = ncharges localTime kit
              periodic = IA.checkFlag Ability.Periodic arItem
              !cLab = Color.AttrChar { acAttr = attrCursor
                                     , acChar = markEqp periodic k ncha }
              asLab = [Color.attrCharToW32 cLab]
                      ++ [Color.spaceAttrW32 | isSquareFont propFont]
                      ++ [colorSymbol]
              !tDesc = " " <> phrase
          in (asLab, textToAS tDesc, Right c)
        l = zipWith pr natSlots iids
    in labDescOKX squareFont propFont l
  
  -- | Extract whole-dungeon statistics for each place kind,
  -- counting the number of occurrences of each type of
  -- `Game.LambdaHack.Content.PlaceKind.PlaceEntry`
  -- for the given place kind and gathering the set of levels
  -- on which any entry for that place kind can be found.
  placesFromState :: ContentData PK.PlaceKind -> Bool -> State
                  -> EM.EnumMap (ContentId PK.PlaceKind)
                                (ES.EnumSet LevelId, Int, Int, Int)
  placesFromState coplace sexposePlaces s =
    let addEntries (!es1, !nEntries1, !nArounds1, !nExists1)
                   (!es2, !nEntries2, !nArounds2, !nExists2) =
          let !es = ES.union es1 es2
              !nEntries = nEntries1 + nEntries2
              !nArounds = nArounds1 + nArounds2
              !nExists = nExists1 + nExists2
          in (es, nEntries, nArounds, nExists)
        placesFromLevel :: (LevelId, Level)
                        -> EM.EnumMap (ContentId PK.PlaceKind)
                                      (ES.EnumSet LevelId, Int, Int, Int)
        placesFromLevel (!lid, Level{lentry}) =
          let f (PK.PEntry pk) em =
                EM.insertWith addEntries pk (ES.singleton lid, 1, 0, 0) em
              f (PK.PAround pk) em =
                EM.insertWith addEntries pk (ES.singleton lid, 0, 1, 0) em
              f (PK.PExists pk) em =
                EM.insertWith addEntries pk (ES.singleton lid, 0, 0, 1) em
          in EM.foldr' f EM.empty lentry
               -- go through place entrances and depending on the place
               -- add an entry for it, whether Entry/Around/Exists,
               -- the effect being we're counting #s of each type
        insertZeros !em !pk _ = EM.insert pk (ES.empty, 0, 0, 0) em
        -- The initial places are overwritten except for those
        -- that have no entries in the dungeon at all,
        -- and in `sexposePlaces` debug mode these will be shown even though
        -- the stats will be zeros (which is a valuable warning!).
        initialPlaces | not sexposePlaces = EM.empty
                      | otherwise = ofoldlWithKey' coplace insertZeros EM.empty
    in EM.unionWith addEntries
         initialPlaces
         (EM.unionsWith addEntries $ map placesFromLevel $ EM.assocs $ sdungeon s)
          -- gather per-place-kind statistics for each level,
          -- then aggregate them over all levels, remembering that the place
          -- appeared on the given level (but not how man times)
  
  -- TODO: if faction not known, it's info should not be updated
  -- by the server. But let's wait until server sends general state diffs
  -- and then block diffs that don't apply, because faction is missing.
  factionsFromState :: ItemRoles -> State -> [(FactionId, Faction)]
  factionsFromState (ItemRoles itemRoles) s =
    let seenTrunks = ES.toList $ itemRoles EM.! STrunk
        trunkBelongs fid iid = jfid (getItemBody iid s) == Just fid
        factionSeen (fid, fact) = not (EM.null (gvictims fact))  -- shortcut
                                  || any (trunkBelongs fid) seenTrunks
    in filter factionSeen $ EM.assocs $ sfactionD s
  
  itemOverlay :: MonadClientUI m
              => [(ItemId, ItemQuant)] -> ItemDialogMode -> m OKX
  itemOverlay iids dmode = do
    sccui <- getsSession sccui
    side <- getsClient sside
    arena <- getArenaUI
    discoBenefit <- getsClient sdiscoBenefit
    fontSetup <- getFontSetup
    let displayRanged =
          dmode `elem` [ MStore CGround, MStore CEqp, MStore CStash
                       , MOwned, MLore SItem, MLore SBlast ]
    okx <- getsState $ itemOverlayFromState arena iids displayRanged
                                            sccui side discoBenefit fontSetup
    return $! okx
  
  skillsOverlay :: MonadClientUI m => ActorId -> m OKX
  skillsOverlay aid = do
    b <- getsState $ getActorBody aid
    actorMaxSk <- getsState $ getActorMaxSkills aid
    FontSetup{..} <- getFontSetup
    let prSlot :: MenuSlot -> Ability.Skill
               -> ((AttrLine, (Int, AttrLine), (Int, AttrLine)), KYX)
        prSlot c skill =
          let skName = " " <> skillName skill
              attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
              labAc = Color.AttrChar { acAttr = attrCursor
                                     , acChar = '+' }
              lab = attrStringToAL [Color.attrCharToW32 labAc]
              labLen = textSize squareFont $ attrLine lab
              indentation = if isSquareFont propFont then 52 else 26
              valueText = skillToDecorator skill b
                          $ Ability.getSk skill actorMaxSk
              triple = ( lab
                       , (labLen, textToAL skName)
                       , (indentation, textToAL valueText) )
              lenButton = 26 + T.length valueText
          in (triple, (Right c, ( PointUI 0 (fromEnum c)
                                , ButtonWidth propFont lenButton )))
        (ts, kxs) = unzip $ zipWith prSlot natSlots skillsInDisplayOrder
        (skLab, skDescr, skValue) = unzip3 ts
        skillLab = EM.singleton squareFont $ offsetOverlay skLab
        skillDescr = EM.singleton propFont $ offsetOverlayX skDescr
        skillValue = EM.singleton monoFont $ offsetOverlayX skValue
    return (EM.unionsWith (++) [skillLab, skillDescr, skillValue], kxs)
  
  placesOverlay :: MonadClientUI m => m OKX
  placesOverlay = do
    COps{coplace} <- getsState scops
    soptions <- getsClient soptions
    FontSetup{..} <- getFontSetup
    places <- getsState $ placesFromState coplace (sexposePlaces soptions)
    let prSlot :: MenuSlot
               -> (ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))
               -> (AttrString, AttrString, KeyOrSlot)
        prSlot c (pk, (es, _, _, _)) =
          let name = PK.pname $ okind coplace pk
              labChar = if ES.null es then '-' else '+'
              attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
              labAc = Color.AttrChar { acAttr = attrCursor
                                     , acChar = labChar }
              -- Bang required to free @places@ as you go.
              !asLab = [Color.attrCharToW32 labAc]
              !tDesc = " "
                       <> name
                       <+> if ES.null es
                           then ""
                           else "("
                                <> makePhrase [MU.CarWs (ES.size es) "level"]
                                <> ")"
          in (asLab, textToAS tDesc, Right c)
        l = zipWith prSlot natSlots $ EM.assocs places
    return $! labDescOKX squareFont propFont l
  
  factionsOverlay :: MonadClientUI m => m OKX
  factionsOverlay = do
    FontSetup{..} <- getFontSetup
    sroles <- getsSession sroles
    factions <- getsState $ factionsFromState sroles
    let prSlot :: MenuSlot
               -> (FactionId, Faction)
               -> (AttrString, AttrString, KeyOrSlot)
        prSlot c (_, fact) =
          let name = FK.fname $ gkind fact  -- we ignore "Controlled", etc.
              gameOver = isJust $ gquit fact
              labChar = if gameOver then '-' else '+'
              attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
              labAc = Color.AttrChar { acAttr = attrCursor
                                     , acChar = labChar }
              !asLab = [Color.attrCharToW32 labAc]
              !tDesc = " "
                       <> name
                       <+> case gquit fact of
                             Just Status{stOutcome} | not $ isHorrorFact fact ->
                               "(" <> FK.nameOutcomePast stOutcome <> ")"
                             _ -> ""
          in (asLab, textToAS tDesc, Right c)
        l = zipWith prSlot natSlots factions
    return $! labDescOKX squareFont propFont l
  
  modesOverlay :: MonadClientUI m => m OKX
  modesOverlay = do
    COps{comode} <- getsState scops
    FontSetup{..} <- getFontSetup
    svictories <- getsSession svictories
    nxtChal <- getsClient snxtChal  -- mark victories only for current difficulty
    let f !acc _p !i !a = (i, a) : acc
        campaignModes = ofoldlGroup' comode MK.CAMPAIGN_SCENARIO f []
        prSlot :: MenuSlot
               -> (ContentId MK.ModeKind, MK.ModeKind)
               -> (AttrString, AttrString, KeyOrSlot)
        prSlot c (gameModeId, gameMode) =
          let modeName = MK.mname gameMode
              victories = case EM.lookup gameModeId svictories of
                Nothing -> 0
                Just cm -> fromMaybe 0 (M.lookup nxtChal cm)
              labChar = if victories > 0 then '-' else '+'
              attrCursor = Color.defAttr {Color.bg = Color.HighlightNoneCursor}
              labAc = Color.AttrChar { acAttr = attrCursor
                                     , acChar = labChar }
              !asLab = [Color.attrCharToW32 labAc]
              !tDesc = " " <> modeName
          in (asLab, textToAS tDesc, Right c)
        l = zipWith prSlot natSlots campaignModes
    return $! labDescOKX squareFont propFont l
  
  describeMode :: MonadClientUI m
               => Bool -> ContentId MK.ModeKind
               -> m (EM.EnumMap DisplayFont Overlay)
  describeMode addTitle gameModeId = do
    COps{comode} <- getsState scops
    CCUI{coscreen=ScreenContent{rwidth}}
      <- getsSession sccui
    FontSetup{..} <- getFontSetup
    scoreDict <- getsState shigh
    scampings <- getsSession scampings
    srestarts <- getsSession srestarts
    side <- getsClient sside
    total <- getsState $ snd . calculateTotal side
    dungeonTotal <- getsState sgold
    let screensaverBlurb = "This is one of the screensaver scenarios, not available from the main menu, with all factions controlled by AI. Feel free to take over or relinquish control at any moment, but to register a legitimate high score, choose a standard scenario instead.\n"
    let gameMode = okind comode gameModeId
        duplicateEOL '\n' = "\n\n"
        duplicateEOL c = T.singleton c
        sections =
          [ ( textFgToAS Color.BrGreen "The story so far:"
            , T.concatMap duplicateEOL (MK.mdesc gameMode) )
          , ( textFgToAS Color.cMeta "Rules of the game:"
            , MK.mrules gameMode )
          , ( textFgToAS Color.BrCyan "Running commentary:"
            , T.concatMap duplicateEOL
                (if MK.mattract gameMode
                 then screensaverBlurb <> MK.mreason gameMode
                 else MK.mreason gameMode) )
          , ( textFgToAS Color.cGreed "Hints, not needed unless stuck:"
            , T.concatMap duplicateEOL (MK.mhint gameMode) )
          ]
        renderSection :: (AttrString, Text) -> Maybe [(DisplayFont, AttrString)]
        renderSection (header, desc) =
          if T.null desc
          then Nothing
          else Just [(monoFont, header), (propFont, textToAS desc)]
        survivingHow = if | total == 0 -> "(barely)"
                          | total < dungeonTotal `div` 2 -> "(so far)"
                          | otherwise -> ""
        title = if addTitle
                then "\nYou are"
                     <+> survivingHow
                     <+> "surviving the '"
                     <> MK.mname gameMode
                     <> "' adventure.\n"
                else ""
        blurb = map (second $ splitAttrString (rwidth - 2) (rwidth - 2)) $
          (propFont, textToAS (title <> "\n"))
          : intercalate [(monoFont, textToAS "\n")]
                         (mapMaybe renderSection sections)
        -- Colour is used to delimit the section when displayed in one
        -- column, when using square fonts only.
        blurbEnd = map (second $ splitAttrString (rwidth - 2) (rwidth - 2)) $
          ( propFont
          , textFgToAS Color.Brown
                       "\nThis adventure's endings experienced so far:\n\n" )
            : if null sectionsEndAS
              then [(monoFont, textToAS "*none*")]
              else sectionsEndAS
        sectionsEndAS = intercalate [(monoFont, textToAS "\n")]
                                    (mapMaybe renderSection sectionsEnd)
        sectionsEnd = map outcomeSection [minBound..maxBound]
        outcomeSection :: FK.Outcome -> (AttrString, Text)
        outcomeSection outcome =
          ( renderOutcome outcome
          , if not (outcomeSeen outcome)
            then ""  -- a possible spoiler and lack of sense of progression
            else T.concatMap duplicateEOL
                 $ fromMaybe "" $ lookup outcome
                 $ MK.mendMsg gameMode ++ endMsgDefault  -- left-biased
          )
        -- These are not added to @mendMsg@, because they only fit here.
        endMsgDefault =
          [ (FK.Restart, "No shame there is in noble defeat and there is honour in perseverance. Sometimes there are ways and places to turn rout into victory.")
          , (FK.Camping, "Don't fear to take breaks. While you move, others move, even on distant floors, but while you stay still, the world stays still.")
          ]
        scoreRecords = maybe [] HighScore.unTable $ EM.lookup gameModeId scoreDict
        -- This doesn't use @svictories@, but high scores, because high scores
        -- are more persistent and granular (per-outcome). OTOH, @svictories@
        -- are per-challenge, which is important in other cases.
        -- @Camping@ and @Restart@ are fine to be less persistent.
        outcomeSeen :: FK.Outcome -> Bool
        outcomeSeen outcome = case outcome of
          FK.Camping -> gameModeId `ES.member` scampings
          FK.Restart -> gameModeId `ES.member` srestarts
          _ -> outcome `elem` map (stOutcome . HighScore.getStatus) scoreRecords
        -- Camping not taken into account.
        lastOutcome :: FK.Outcome
        lastOutcome = if null scoreRecords
                      then FK.Restart  -- only if nothing else
                      else stOutcome . HighScore.getStatus
                           $ maximumBy (comparing HighScore.getDate) scoreRecords
        renderOutcome :: FK.Outcome -> AttrString
        renderOutcome outcome =
          let color | outcome `elem` FK.deafeatOutcomes = Color.cVeryBadEvent
                    | outcome `elem` FK.victoryOutcomes = Color.cVeryGoodEvent
                    | otherwise = Color.cNeutralEvent
              lastRemark
                | outcome /= lastOutcome = ""
                | outcome `elem` FK.deafeatOutcomes = "(last suffered ending)"
                | outcome `elem` FK.victoryOutcomes = "(last achieved ending)"
                | otherwise = "(last seen ending)"
          in textToAS "Game over message when"
             <+:> (textFgToAS color (T.toTitle $ FK.nameOutcomePast outcome)
                   <+:> textToAS lastRemark)
             <> textToAS ":"
    return $! if isSquareFont propFont
              then EM.singleton squareFont  -- single column, single font
                   $ xtranslateOverlay 2 $ offsetOverlay
                   $ concatMap snd $ blurb ++ blurbEnd
              else EM.unionWith (++)
                   (EM.map (xtranslateOverlay 1)
                    $ attrLinesToFontMap blurb)
                   (EM.map (xtranslateOverlay $ rwidth + 1)
                    $ attrLinesToFontMap blurbEnd)
  
  pickNumber :: MonadClientUI m => Bool -> Int -> m (Either MError Int)
  pickNumber askNumber kAll = assert (kAll >= 1) $ do
    let shownKeys = [ K.returnKM, K.spaceKM, K.mkChar '+', K.mkChar '-'
                    , K.backspaceKM, K.escKM ]
        frontKeyKeys = shownKeys ++ map K.mkChar ['0'..'9']
        gatherNumber kCur = assert (1 <= kCur && kCur <= kAll) $ do
          let kprompt = "Choose number:" <+> tshow kCur
          msgAdd MsgPromptGeneric kprompt
          sli <- reportToSlideshow shownKeys
          ekkm <- displayChoiceScreen "" ColorFull False sli frontKeyKeys
          case ekkm of
            Left kkm ->
              case K.key kkm of
                K.Char '+' ->
                  gatherNumber $ if kCur + 1 > kAll then 1 else kCur + 1
                K.Char '-' ->
                  gatherNumber $ if kCur - 1 < 1 then kAll else kCur - 1
                K.Char l | kCur * 10 + Char.digitToInt l > kAll ->
                  gatherNumber $ if Char.digitToInt l == 0
                                 then kAll
                                 else min kAll (Char.digitToInt l)
                K.Char l -> gatherNumber $ kCur * 10 + Char.digitToInt l
                K.BackSpace -> gatherNumber $ max 1 (kCur `div` 10)
                K.Return -> return $ Right kCur
                K.Esc -> weaveJust <$> failWith "never mind"
                K.Space -> return $ Left Nothing
                _ -> error $ "unexpected key" `showFailure` kkm
            Right slot -> error $ "unexpected menu slot" `showFailure` slot
    if kAll == 1 || not askNumber
    then return $ Right kAll
    else do
      res <- gatherNumber kAll
      case res of
        Right k | k <= 0 -> error $ "" `showFailure` (res, kAll)
        _ -> return res
  
  -- | Produces a textual description of the tile at a position.
  lookAtTile :: MonadClientUI m
             => Bool             -- ^ can be seen right now?
             -> Point            -- ^ position to describe
             -> LevelId          -- ^ level the position is at
             -> Maybe ActorId    -- ^ the actor that looks
             -> Maybe MU.Person  -- ^ grammatical person of the item(s), if any
             -> m (Text, Text, [(Int, MU.Part)])
  lookAtTile canSee p lidV maid mperson = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    cops@COps{cotile, coplace} <- getsState scops
    side <- getsClient sside
    factionD <- getsState sfactionD
    mb <- getsState $ \s -> flip getActorBody s <$> maid
    lvl <- getLevel lidV
    saimMode <- getsSession saimMode
    embeds <- getsState $ getEmbedBag lidV p
    itemToF <- getsState $ flip itemToFull
    seps <- getsClient seps
    localTime <- getsState $ getLocalTime lidV
    getKind <- getsState $ flip getIidKind
    let inhabitants = posToAidsLvl p lvl
        detail = maybe DetailAll detailLevel saimMode
        aims = isJust $ (\b -> makeLine False b p seps cops lvl) =<< mb
        tkid = lvl `at` p
        tile = okind cotile tkid
        vis | TK.tname tile == "unknown space" = "that is"
            | not (null inhabitants)
              && (bpos <$> mb) /= Just p = "the terrain here is"
            | not canSee = "you remember"
            | not aims = "you are aware of"  -- walkable path a proxy for in LOS
            | otherwise = "you see"
        vperson = case mperson of
          Nothing -> vis
          Just MU.Sg1st -> error "an item speaks in first person"
          Just MU.Sg3rd -> "It is laying on"
          Just MU.PlEtc -> "They lay on"
        tilePart = MU.AW $ MU.Text $ TK.tname tile
        entrySentence pk blurb =
          makeSentence [blurb, MU.Text $ PK.pname $ okind coplace pk]
        placeBlurb = case EM.lookup p $ lentry lvl of
          Nothing -> ""
          Just (PK.PEntry pk) -> entrySentence pk "it is an entrance to"
          Just (PK.PAround pk) -> entrySentence pk "it surrounds"
          Just (PK.PExists _) -> ""
        embedLook (iid, kit@(k, _)) =
          let itemFull = itemToF iid
              nWs = partItemWsDetail detail
                                     rwidth side factionD k localTime itemFull kit
          in (k, nWs)
        embedKindList =
          map (\(iid, kit) -> (getKind iid, (iid, kit))) (EM.assocs embeds)
        embedList = map embedLook $ sortEmbeds cops tkid embedKindList
    return (makeSentence [vperson, tilePart], placeBlurb, embedList)
  
  -- | Produces a textual description of actors at a position.
  lookAtActors :: MonadClientUI m
               => Point      -- ^ position to describe
               -> LevelId    -- ^ level the position is at
               -> m (Text, Maybe (MU.Part, Bool), Text)
  lookAtActors p lidV = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    side <- getsClient sside
    inhabitants <- getsState $ posToAidAssocs p lidV
    factionD <- getsState sfactionD
    localTime <- getsState $ getLocalTime lidV
    saimMode <- getsSession saimMode
    let detail = maybe DetailAll detailLevel saimMode
    case inhabitants of
      [] -> return ("", Nothing, "")
      (aid, body) : rest -> do
        actorPronoun <- partPronounLeader aid
        itemFull <- getsState $ itemToFull $ btrunk body
        guardVerbs <- getsState $ guardItemVerbs body
        subjects <- mapM (partActorLeader . fst) inhabitants
        let bfact = factionD EM.! bfid body
            -- No "a" prefix even if singular and inanimate, to distinguish
            -- from items lying on the floor (and to simplify code).
            (subject, person) = squashedWWandW subjects
            resideVerb = case bwatch body of
              WWatch -> "be here"
              WWait 0 -> "idle here"
              WWait _ -> "brace for impact"
              WSleep -> "sleep here"
              WWake -> "be waking up"
            flyVerb | bproj body = "zip through here"
                    | isJust $ btrajectory body = "move through here"
                    | otherwise = resideVerb
            verbs = flyVerb : guardVerbs
            projDesc | not (bproj body) || detail < DetailHigh = ""
                     | otherwise =
              let kit = beqp body EM.! btrunk body
                  ps = [partItemMediumAW rwidth side factionD localTime
                                         itemFull kit]
                  tailWords = tail . T.words . makePhrase
              in if tailWords ps == tailWords subjects
                 then ""
                 else makeSentence $ "this is" : ps
            factDesc = case jfid $ itemBase itemFull of
              Just tfid | tfid /= bfid body ->
                let dominatedBy = if bfid body == side then "us" else gname bfact
                    tfact = factionD EM.! tfid
                in "Originally of" <+> gname tfact
                   <> ", now fighting for" <+> dominatedBy <> "."
              _ | detail < DetailHigh -> ""  -- only domination worth spamming
              _ | bfid body == side -> ""  -- just one of us
              _ | bproj body -> "Launched by" <+> gname bfact <> "."
              _ -> "One of" <+> gname bfact <> "."
            idesc = if detail < DetailHigh
                    then ""
                    else IK.idesc $ itemKind itemFull
            -- If many different actors, only list names.
            sameTrunks = all (\(_, b) -> btrunk b == btrunk body) rest
            desc = wrapInParens $ projDesc <+> factDesc <+> idesc
            onlyIs = bwatch body == WWatch && null guardVerbs
            allBlurb = makeSentence [MU.SubjectVVxV "and" person MU.Yes
                                                    subject verbs]
            headBlurb = makeSentence [MU.SubjectVVxV "and" MU.Sg3rd MU.Yes
                                                     (head subjects) verbs]
            andProjectiles = case subjects of
              _ : projs@(_ : _) ->
                let (subjectProjs, personProjs) =
                      squashedWWandW projs
                in makeSentence
                     [MU.SubjectVerb personProjs MU.Yes
                                     subjectProjs "can be seen"]
              _ -> ""
            actorAlive = bhp body >= 0
            mactorPronounAlive =
              if bproj body then Nothing else Just (actorPronoun, actorAlive)
        return $!
          if | not actorAlive && not (bproj body) ->
               ( makeSentence
                   (MU.SubjectVerbSg (head subjects) "lie here"
                    : if null guardVerbs
                      then []
                      else [ MU.SubjectVVxV "and" MU.Sg3rd MU.No
                                            "and" guardVerbs
                           , "any more" ])
               , mactorPronounAlive
               , wrapInParens desc <+> andProjectiles )
             | sameTrunks ->  -- only non-proj or several similar projectiles
               ( allBlurb
               , mactorPronounAlive
               , desc )
             | not (bproj body) && onlyIs ->
               ( headBlurb
               , mactorPronounAlive
               , desc <+> andProjectiles )
             | not (bproj body) ->
               ( makeSentence [subject, "can be seen"] <+> headBlurb
               , mactorPronounAlive
               , desc )
             | otherwise -> assert (bproj body && not (null rest))
               ( makeSentence [subject, "can be seen"]
               , Nothing
               , "" )
  
  guardItemVerbs :: Actor -> State -> [MU.Part]
  guardItemVerbs body s =
    -- We only hint while, in reality, currently the client knows
    -- all the items in eqp of the foe. But we may remove the knowledge
    -- in the future and, anyway, it would require a dedicated
    -- UI mode beyond a couple of items per actor.
    let itemsSize = guardItemSize body s
        belongingsVerbs | itemsSize == 1 = ["fondle a trinket"]
                        | itemsSize > 1 = ["haul a hoard"]
                        | otherwise = []
    in if bproj body then [] else belongingsVerbs
  
  guardItemSize :: Actor -> State -> Int
  guardItemSize body s =
    let toReport iid =
          let itemKind = getIidKind iid s
          in fromMaybe 0 (lookup IK.UNREPORTED_INVENTORY (IK.ifreq itemKind)) <= 0
    in length $ filter toReport $ EM.keys (beqp body)
  
  -- | Produces a textual description of items at a position.
  lookAtItems :: MonadClientUI m
              => Bool     -- ^ can be seen right now?
              -> Point    -- ^ position to describe
              -> LevelId  -- ^ level the position is at
              -> Maybe ActorId
                          -- ^ the actor that looks
              -> Maybe (MU.Part, Bool)
                          -- ^ pronoun for the big actor at the position, if any,
                          --   and whether the big actor is alive
              -> m (Text, Maybe MU.Person)
  lookAtItems canSee p lidV maid mactorPronounAlive = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    side <- getsClient sside
    itemToF <- getsState $ flip itemToFull
    mb <- getsState $ \s -> flip getActorBody s <$> maid
    -- Not using @viewedLevelUI@, because @aid@ may be temporarily not a leader.
    saimMode <- getsSession saimMode
    let standingOn = Just p == (bpos <$> mb) && Just lidV == (blid <$> mb)
        -- In exploration mode the detail level depends on whether the actor
        -- that looks stand over the items, because then he can check details
        -- with inventory commands (or look in aiming mode).
        detailExploration = if standingOn && Just side == (bfid <$> mb)
                            then DetailLow
                            else DetailAll
        detail = maybe detailExploration detailLevel saimMode
    localTime <- getsState $ getLocalTime lidV
    is <- getsState $ getFloorBag lidV p
    factionD <- getsState sfactionD
    globalTime <- getsState stime
    getKind <- getsState $ flip getIidKindId
    mLeader <- case maid of
      Just aid | standingOn -> do
        leaderPronoun <- partPronounLeader aid
        return $ Just (leaderPronoun, (bhp <$> mb) >= Just 0)
      _ -> return Nothing
    let mactorPronounAliveLeader = mactorPronounAlive <|> mLeader
    (subject, verb) <- case mactorPronounAliveLeader of
      Just (actorPronoun, actorAlive) ->
        return (actorPronoun, if actorAlive then "stand over" else "fall over")
      Nothing -> case maid of
        Just aid -> do
          subjectAid <- partActorLeader aid
          return (subjectAid, if canSee then "notice" else "remember")
        Nothing ->
          return ("one", if canSee then "can see" else "may remember")
    let nWs (iid, kit@(k, _)) =
          partItemWsDetail detail
                           rwidth side factionD k localTime (itemToF iid) kit
        (object, person) = case EM.assocs is of
          ii : _ : _ : _ | detail <= DetailMedium ->
            (MU.Phrase [nWs ii, "and other items"], MU.PlEtc)
          [ii@(_, (1, _))] -> (nWs ii, MU.Sg3rd)
          iis -> (MU.WWandW $ map nWs $ sortOn (getKind . fst) iis, MU.PlEtc)
    -- Here @squashedWWandW@ is not needed, because identical items at the same
    -- position are already merged in the floor item bag and multiple identical
    -- messages concerning different positions are merged with <x7>
    -- to distinguish from a stack of items at a single position.
    return ( if EM.null is || globalTime == timeZero
             then ""
             else makeSentence [MU.SubjectVerbSg subject (MU.Text verb), object]
           , if isNothing mactorPronounAlive then Just person else Nothing )
  
  lookAtStash :: MonadClientUI m => Point -> LevelId -> m Text
  lookAtStash p lidV = do
    side <- getsClient sside
    factionD <- getsState sfactionD
    let locateStash (fid, fact) = case gstash fact of
          Just (lid, pos) | lid == lidV  && pos == p ->
            Just $ if fid == side
                   then "Here is the shared inventory stash of your team."
                   else gname fact
                        <+> "set up their shared inventory stash here."
          _ -> Nothing
    return $! T.intercalate " " $ mapMaybe locateStash $ EM.assocs factionD
  
  -- | Produces a textual description of everything at the requested
  -- level's position.
  lookAtPosition :: MonadClientUI m
                 => Point -> LevelId -> m [(MsgClassShow, Text)]
  lookAtPosition p lidV = do
    COps{cotile} <- getsState scops
    side <- getsClient sside
    per <- getPerFid lidV
    let canSee = ES.member p (totalVisible per)
    (actorsBlurb, mactorPronounAlive, actorsDesc) <- lookAtActors p lidV
    mleader <- getsClient sleader
    (itemsBlurb, mperson) <-
      lookAtItems canSee p lidV mleader mactorPronounAlive
    let tperson = if T.null itemsBlurb then Nothing else mperson
    (tileBlurb, placeBlurb, embedsList) <-
      lookAtTile canSee p lidV mleader tperson
    inhabitants <- getsState $ posToAidAssocs p lidV
    let actorMsgClass =
          if (bfid . snd <$> inhabitants) == [side]
          then MsgPromptGeneric  -- our single proj or non-proj; tame
          else MsgPromptActors
    stashBlurb <- lookAtStash p lidV
    lvl@Level{lsmell, ltime} <- getLevel lidV
    saimMode <- getsSession saimMode
    let detail = maybe DetailAll detailLevel saimMode
        smellBlurb = case EM.lookup p lsmell of
          Just sml | sml > ltime ->
            let Delta t = smellTimeout `timeDeltaSubtract`
                            (sml `timeDeltaToFrom` ltime)
                seconds = t `timeFitUp` timeSecond
            in "A smelly body passed here around" <+> tshow seconds <> "s ago."
          _ -> ""
    embeds <- getsState $ getEmbedBag lidV p
    getKind <- getsState $ flip getIidKind
    let ppEmbedName :: (Int, MU.Part) -> Text
        ppEmbedName (k, part) =
          let verb = if k == 1 then "is" else "are"
          in makeSentence ["There", verb, part]
        embedKindList = map (\(iid, kit) -> (getKind iid, (iid, kit)))
                            (EM.assocs embeds)
        feats = TK.tfeature $ okind cotile $ lvl `at` p
        tileActions = mapMaybe (parseTileAction False False embedKindList)
                               feats
        isEmbedAction EmbedAction{} = True
        isEmbedAction _ = False
        embedVerb = [ "activated"
                    | any isEmbedAction tileActions
                      && any (\(itemKind, _) -> not $ null $ IK.ieffects itemKind)
                             embedKindList ]
        isToAction ToAction{} = True
        isToAction _ = False
        isWithAction WithAction{} = True
        isWithAction _ = False
        isEmptyWithAction (WithAction [] _) = True
        isEmptyWithAction _ = False
        alterVerb | any isEmptyWithAction tileActions = ["very easily modified"]
                  | any isToAction tileActions = ["easily modified"]
                  | any isWithAction tileActions = ["potentially modified"]
                  | otherwise = []
        verbs = embedVerb ++ alterVerb
        alterBlurb = if null verbs
                     then ""
                     else makeSentence ["can be", MU.WWandW verbs]
        toolFromAction (WithAction grps _) = Just grps
        toolFromAction _ = Nothing
        toolsToAlterWith = mapMaybe toolFromAction tileActions
        tItems = describeToolsAlternative toolsToAlterWith
        transformBlurb = if T.null tItems
                         then ""
                         else "The following items on the ground or in equipment enable special transformations:"
                              <+> tItems <> "."  -- not telling to what terrain
        modifyBlurb = alterBlurb <+> transformBlurb
        midEOL = if detail < DetailMedium
                    || T.null stashBlurb && T.null actorsDesc
                    || T.null smellBlurb && T.null itemsBlurb
                    || null embedsList && T.null modifyBlurb
                 then ""
                 else "\n"
        ms = [ (MsgPromptAction, stashBlurb)
             , (actorMsgClass, actorsBlurb)
             , (MsgPromptGeneric, actorsDesc <> midEOL) ]
             ++ [(MsgPromptGeneric, smellBlurb) | detail >= DetailMedium]
             ++ [(MsgPromptItems, itemsBlurb <> midEOL)]
             ++ [(MsgPromptFocus, tileBlurb) | detail >= DetailMedium
                                               || detail == DetailLow
                                                  && not (null embedsList)]
             ++ [(MsgPromptGeneric, placeBlurb) | detail >= DetailMedium]
             ++ case detail of
                  DetailLow -> []  -- not to obscure aiming line
                  _ -> let n = sum $ map fst embedsList
                           wWandW = MU.WWandW $ map snd embedsList
                       in [(MsgPromptMention, ppEmbedName (n, wWandW)) | n > 0]
             ++ [(MsgPromptModify, modifyBlurb) | detail >= DetailHigh]
    return $! if all (T.null . snd) ms && detail > DetailLow
              then [(MsgPromptFocus, tileBlurb)]
              else ms
  
  displayOneMenuItem :: MonadClientUI m
                     => (MenuSlot -> m OKX) -> [K.KM] -> Int -> MenuSlot
                     -> m K.KM
  displayOneMenuItem renderOneItem extraKeys slotBound slot = do
    CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
    let keys = [K.spaceKM, K.escKM]
               ++ [K.upKM | fromEnum slot > 0]
               ++ [K.downKM | fromEnum slot < slotBound]
               ++ extraKeys
    okx <- renderOneItem slot
    slides <- overlayToSlideshow (rheight - 2) keys okx
    km <- getConfirms ColorFull keys slides
    case K.key km of
      K.Up -> displayOneMenuItem renderOneItem extraKeys slotBound $ pred slot
      K.Down -> displayOneMenuItem renderOneItem extraKeys slotBound $ succ slot
      _ -> return km
  
  okxItemLoreInline :: MonadClientUI m
                    => (ItemId -> ItemFull -> Int -> Text)
                    -> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
                    -> Int -> MenuSlot
                    -> m OKX
  okxItemLoreInline promptFun meleeSkill dmode iids widthRaw slot = do
    FontSetup{..} <- getFontSetup
    let (iid, kit@(k, _)) = iids !! fromEnum slot
        -- Some prop fonts are wider than mono (e.g., in dejavuBold font set),
        -- so the width in these artificial texts full of digits and strange
        -- characters needs to be smaller than @rwidth - 2@ that would suffice
        -- for mono.
        width = widthRaw - 5
    itemFull <- getsState $ itemToFull iid
    (ovLab, ovDesc) <- itemDescOverlays True meleeSkill dmode iid kit itemFull
                                        width
    let prompt = promptFun iid itemFull k
        promptBlurb | T.null prompt = []
                    | otherwise = offsetOverlay $ splitAttrString width width
                                  $ textFgToAS Color.Brown $ prompt <> "\n\n"
        len = length promptBlurb
        descSym2 = ytranslateOverlay len ovLab
        descBlurb2 = promptBlurb ++ ytranslateOverlay len ovDesc
        ov = EM.insertWith (++) squareFont descSym2
             $ EM.singleton propFont descBlurb2
    return (ov, [])
  
  okxItemLoreMsg :: MonadClientUI m
                 => (ItemId -> ItemFull -> Int -> Text)
                 -> Int -> ItemDialogMode -> [(ItemId, ItemQuant)]
                 -> MenuSlot
                 -> m OKX
  okxItemLoreMsg promptFun meleeSkill dmode iids slot = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    FontSetup{..} <- getFontSetup
    let (iid, kit@(k, _)) = iids !! fromEnum slot
    itemFull <- getsState $ itemToFull iid
    (ovLab, ovDesc) <- itemDescOverlays True meleeSkill dmode iid kit itemFull
                                        rwidth
    let prompt = promptFun iid itemFull k
    msgAdd MsgPromptGeneric prompt
    let ov = EM.insertWith (++) squareFont ovLab
             $ EM.singleton propFont ovDesc
    return (ov, [])
  
  itemDescOverlays :: MonadClientUI m
                   => Bool -> Int -> ItemDialogMode -> ItemId -> ItemQuant
                   -> ItemFull -> Int
                   -> m (Overlay, Overlay)
  itemDescOverlays markParagraphs meleeSkill dmode iid kit itemFull width = do
    FontSetup{squareFont} <- getFontSetup
    side <- getsClient sside
    arena <- getArenaUI
    localTime <- getsState $ getLocalTime arena
    factionD <- getsState sfactionD
    -- The hacky level 0 marks items never seen, but sent by server at gameover.
    jlid <- getsSession $ fromMaybe (toEnum 0) <$> EM.lookup iid . sitemUI
    let descAs = itemDesc width markParagraphs side factionD meleeSkill
                          dmode localTime jlid itemFull kit
    return $! labDescOverlay squareFont width descAs
  
  cycleLore :: MonadClientUI m => [m K.KM] -> [m K.KM] -> m ()
  cycleLore _ [] = return ()
  cycleLore seen (m : rest) = do  -- @seen@ is needed for SPACE to end cycling
    km <- m
    if | km == K.spaceKM -> cycleLore (m : seen) rest
       | km == K.mkChar '>' -> if null rest
                               then cycleLore [] (reverse $ m : seen)
                               else cycleLore (m : seen) rest
       | km == K.mkChar '<' -> case seen of
                                 prev : ps -> cycleLore ps (prev : m : rest)
                                 [] -> case reverse (m : rest) of
                                   prev : ps -> cycleLore ps [prev]
                                   [] -> error "cycleLore: screens disappeared"
       | km == K.escKM -> return ()
       | otherwise -> error "cycleLore: unexpected key"
  
  spoilsBlurb :: Text -> Int -> Int -> Text
  spoilsBlurb currencyName total dungeonTotal =
    if | dungeonTotal == 0 ->
           "All the spoils of your team are of the practical kind."
       | total == 0 -> "Your team haven't found any genuine treasure yet."
       | otherwise -> makeSentence
           [ "your team's spoils are worth"
           , MU.CarAWs total $ MU.Text currencyName
           , "out of the rumoured total"
           , MU.Cardinal dungeonTotal ]
  
  ppContainerWownW :: MonadClientUI m
                   => (ActorId -> m MU.Part) -> Bool -> Container -> m [MU.Part]
  ppContainerWownW ownerFun addPrepositions c = case c of
    CFloor{} -> return ["nearby"]
    CEmbed{} -> return ["embedded nearby"]
    CActor aid store -> do
      side <- getsClient sside
      b <- getsState $ getActorBody aid
      owner <- ownerFun aid
      fidName <- getsState $ gname . (EM.! bfid b) . sfactionD
      let (preposition, noun) = ppCStore store
          prep = [MU.Text preposition | addPrepositions]
      return $! prep ++ case store of
        CGround -> MU.Text noun : if bproj b then [] else ["under", owner]
        CStash -> if bfid b /= side
                  then [MU.WownW (MU.Text fidName) (MU.Text noun)]
                  else [MU.Text noun]
        _ -> [MU.WownW owner (MU.Text noun)]
    CTrunk{} -> error $ "" `showFailure` c
  
  nxtGameMode :: COps -> Int -> (ContentId MK.ModeKind, MK.ModeKind)
  nxtGameMode COps{comode} snxtScenario =
    let f !acc _p !i !a = (i, a) : acc
        campaignModes = ofoldlGroup' comode MK.CAMPAIGN_SCENARIO f []
    in campaignModes !! (snxtScenario `mod` length campaignModes)
  