-- | UI of inventory management.
module Game.LambdaHack.Client.UI.InventoryM
  ( Suitability(..), ResultItemDialogMode(..)
  , getFull, getGroupItem, getStoreItem
  , skillCloseUp, placeCloseUp, factionCloseUp
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , ItemDialogState(..), accessModeBag, storeItemPrompt, getItem
  , DefItemKey(..), transition
  , runDefMessage, runDefAction, runDefSkills, skillsInRightPane
  , runDefPlaces, placesInRightPane
  , runDefFactions, factionsInRightPane
  , runDefModes, runDefInventory
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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.HandleHelperM
import           Game.LambdaHack.Client.UI.HumanCmd
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.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.Faction as Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.State
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.PlaceKind as PK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

data ItemDialogState = ISuitable | IAll
  deriving (Show, Eq)

data ResultItemDialogMode =
    RStore CStore [ItemId]
  | ROwned ItemId
  | RLore SLore MenuSlot [(ItemId, ItemQuant)]
  | RSkills MenuSlot
  | RPlaces MenuSlot
  | RFactions MenuSlot
  | RModes MenuSlot
  deriving Show

accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag leader s (MStore cstore) = let b = getActorBody leader s
                                         in getBodyStoreBag b cstore s
accessModeBag leader s MOwned = let fid = bfid $ getActorBody leader s
                                in combinedItems fid s
accessModeBag _ _ MSkills = EM.empty
accessModeBag leader s (MLore SBody) = let b = getActorBody leader s
                                       in getBodyStoreBag b COrgan s
accessModeBag _ s MLore{} = EM.map (const quantSingle) $ sitemD s
accessModeBag _ _ MPlaces = EM.empty
accessModeBag _ _ MFactions = EM.empty
accessModeBag _ _ MModes = EM.empty

-- | Let a human player choose any item from a given group.
-- Note that this does not guarantee the chosen item belongs to the group,
-- as the player can override the choice.
-- Used e.g., for applying and projecting.
getGroupItem :: MonadClientUI m
             => ActorId
             -> m Suitability
                          -- ^ which items to consider suitable
             -> Text      -- ^ specific prompt for only suitable items
             -> Text      -- ^ generic prompt
             -> Text      -- ^ the verb to use
             -> Text      -- ^ the generic verb to use
             -> [CStore]  -- ^ stores to cycle through
             -> m (Either Text (CStore, ItemId))
getGroupItem leader psuit prompt promptGeneric verb verbGeneric stores = do
  side <- getsClient sside
  mstash <- getsState $ \s -> gstash $ sfactionD s EM.! side
  let ppItemDialogBody v body actorSk cCur = case cCur of
        MStore CEqp | not $ calmEnough body actorSk ->
          "distractedly attempt to" <+> v <+> ppItemDialogModeIn cCur
        MStore CGround | mstash == Just (blid body, bpos body) ->
          "greedily attempt to" <+> v <+> ppItemDialogModeIn cCur
        _ -> v <+> ppItemDialogModeFrom cCur
  soc <- getFull leader psuit
                 (\body _ actorSk cCur _ ->
                    prompt <+> ppItemDialogBody verb body actorSk cCur)
                 (\body _ actorSk cCur _ ->
                    promptGeneric
                    <+> ppItemDialogBody verbGeneric body actorSk cCur)
                 stores True False
  case soc of
    Left err -> return $ Left err
    Right (rstore, [(iid, _)]) -> return $ Right (rstore, iid)
    Right _ -> error $ "" `showFailure` soc

-- | Display all items from a store and let the human player choose any
-- or switch to any other store.
-- Used, e.g., for viewing inventory and item descriptions.
getStoreItem :: MonadClientUI m
             => ActorId         -- ^ the pointman
             -> ItemDialogMode  -- ^ initial mode
             -> m (Either Text ResultItemDialogMode)
getStoreItem leader cInitial = do
  side <- getsClient sside
  let -- No @COrgan@, because triggerable organs are rare and,
      -- if really needed, accessible directly from the trigger menu.
      itemCs = map MStore [CStash, CEqp, CGround]
      -- This should match, including order, the items in standardKeysAndMouse
      -- marked with CmdDashboard up to @MSkills@.
      leaderCs = itemCs ++ [MOwned, MLore SBody, MSkills]
      -- No @SBody@, because repeated in other lores and included elsewhere.
      itemLoreCs = map MLore [minBound..SEmbed]
      -- This should match, including order, the items in standardKeysAndMouse
      -- marked with CmdDashboard past @MSkills@ and up to @MModes@.
      loreCs = itemLoreCs ++ [MPlaces, MFactions, MModes]
  let !_A1 = assert (null (leaderCs `intersect` loreCs)) ()
      !_A2 = assert (sort (leaderCs ++ loreCs ++ [MStore COrgan])
                     == map MStore [minBound..maxBound]
                        ++ [MOwned, MSkills]
                        ++ map MLore [minBound..maxBound]
                        ++ [MPlaces, MFactions, MModes]) ()
      allCs | cInitial `elem` leaderCs = leaderCs
            | cInitial `elem` loreCs = loreCs
            | otherwise = assert (cInitial == MStore COrgan) leaderCs
                            -- werrd content, but let it be
      (pre, rest) = break (== cInitial) allCs
      post = dropWhile (== cInitial) rest
      remCs = post ++ pre
      prompt = storeItemPrompt side
  getItem leader (return SuitsEverything) prompt prompt cInitial remCs
          True False

storeItemPrompt :: FactionId
                -> Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
                -> Text
storeItemPrompt side body bodyUI actorCurAndMaxSk c2 s =
  let COps{coitem} = scops s
      fact = sfactionD s EM.! side
      (tIn, t) = ppItemDialogMode c2
      subject = partActor bodyUI
      f (k, _) acc = k + acc
      countItems store = EM.foldr' f 0 $ getBodyStoreBag body store s
  in case c2 of
    MStore CGround ->
      let n = countItems CGround
          nItems = MU.CarAWs n "item"
          verbGround = if gstash fact == Just (blid body, bpos body)
                       then "fondle greedily"
                       else "notice"
      in makePhrase
           [ MU.Capitalize $ MU.SubjectVerbSg subject verbGround
           , nItems, "at"
           , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text "feet" ]
    MStore CEqp ->
      let n = countItems CEqp
          (verbEqp, nItems) =
            if | n == 0 -> ("find nothing", "")
               | calmEnough body actorCurAndMaxSk ->
                   ("find", MU.CarAWs n "item")
               | otherwise -> ("paw distractedly at", MU.CarAWs n "item")
      in makePhrase
           [ MU.Capitalize $ MU.SubjectVerbSg subject verbEqp
           , nItems, MU.Text tIn
           , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]
    MStore cstore ->
      let n = countItems cstore
          nItems = MU.CarAWs n "item"
          (verb, onLevel) = case cstore of
            COrgan -> ("feel", [])
            CStash ->
              ( "notice"
              , case gstash fact of
                  Just (lid, _) ->
                    map MU.Text ["on level", tshow $ abs $ fromEnum lid]
                  Nothing -> [] )
          ownObject = case cstore of
            CStash -> ["our", MU.Text t]
            _ -> [MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t]
      in makePhrase $
           [ MU.Capitalize $ MU.SubjectVerbSg subject verb
           , nItems, MU.Text tIn ] ++ ownObject ++ onLevel
    MOwned ->
      -- We assume "gold grain", not "grain" with label "of gold":
      let currencyName = IK.iname $ okind coitem
                         $ ouniqGroup coitem IK.S_CURRENCY
          dungeonTotal = sgold s
          (_, total) = calculateTotal side s
      in T.init $ spoilsBlurb currencyName total dungeonTotal
        -- no space for more, e.g., the pointman, but it can't be changed anyway
    MSkills ->
      makePhrase
        [ MU.Capitalize $ MU.SubjectVerbSg subject "estimate"
        , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]
    MLore SBody ->
      makePhrase
        [ MU.Capitalize $ MU.SubjectVerbSg subject "feel"
        , MU.Text tIn
        , MU.WownW (MU.Text $ bpronoun bodyUI) $ MU.Text t ]
    MLore slore ->
      makePhrase
        [ MU.Capitalize $ MU.Text $
            if slore == SEmbed
            then "terrain (including crafting recipes)"
            else t ]
    MPlaces ->
      makePhrase
        [ MU.Capitalize $ MU.Text t ]
    MFactions ->
      makePhrase
        [ MU.Capitalize $ MU.Text t ]
    MModes ->
      makePhrase
        [ MU.Capitalize $ MU.Text t ]

-- | Let the human player choose a single, preferably suitable,
-- item from a list of items. Don't display stores empty for all actors.
-- Start with a non-empty store.
getFull :: MonadClientUI m
        => ActorId
        -> m Suitability    -- ^ which items to consider suitable
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ specific prompt for only suitable items
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ generic prompt
        -> [CStore]         -- ^ stores to cycle through
        -> Bool             -- ^ whether to ask, when the only item
                            --   in the starting mode is suitable
        -> Bool             -- ^ whether to permit multiple items as a result
        -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull leader psuit prompt promptGeneric stores askWhenLone permitMulitple = do
  mpsuit <- psuit
  let psuitFun = case mpsuit of
        SuitsEverything -> \_ _ _ -> True
        SuitsSomething f -> f
  -- Move the first store that is non-empty for suitable items for this actor
  -- to the front, if any.
  b <- getsState $ getActorBody leader
  getCStoreBag <- getsState $ \s cstore -> getBodyStoreBag b cstore s
  let hasThisActor = not . EM.null . getCStoreBag
  case filter hasThisActor stores of
    [] -> do
      let dialogModes = map MStore stores
          ts = map (MU.Text . ppItemDialogModeIn) dialogModes
      return $ Left $ "no items" <+> makePhrase [MU.WWxW "nor" ts]
    haveThis@(headThisActor : _) -> do
      itemToF <- getsState $ flip itemToFull
      let suitsThisActor store =
            let bag = getCStoreBag store
            in any (\(iid, kit) -> psuitFun (Just store) (itemToF iid) kit)
                   (EM.assocs bag)
          firstStore = fromMaybe headThisActor $ find suitsThisActor haveThis
          -- Don't display stores totally empty for all actors.
          breakStores cInit =
            let (pre, rest) = break (== cInit) stores
                post = dropWhile (== cInit) rest
            in (MStore cInit, map MStore $ post ++ pre)
          (modeFirst, modeRest) = breakStores firstStore
      res <- getItem leader psuit prompt promptGeneric modeFirst modeRest
                     askWhenLone permitMulitple
      case res of
        Left t -> return $ Left t
        Right (RStore fromCStore iids) -> do
          let bagAll = getCStoreBag fromCStore
              f iid = (iid, bagAll EM.! iid)
          return $ Right (fromCStore, map f iids)
        Right _ -> error $ "" `showFailure` res

-- | Let the human player choose a single, preferably suitable,
-- item from a list of items.
getItem :: MonadClientUI m
        => ActorId
        -> m Suitability    -- ^ which items to consider suitable
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ specific prompt for only suitable items
        -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
            -> Text)        -- ^ generic prompt
        -> ItemDialogMode   -- ^ first mode to display
        -> [ItemDialogMode] -- ^ the (rest of) modes
        -> Bool             -- ^ whether to ask, when the only item
                            --   in the starting mode is suitable
        -> Bool             -- ^ whether to permit multiple items as a result
        -> m (Either Text ResultItemDialogMode)
getItem leader psuit prompt promptGeneric cCur cRest askWhenLone
        permitMulitple = do
  accessCBag <- getsState $ accessModeBag leader
  let storeAssocs = EM.assocs . accessCBag
      allAssocs = concatMap storeAssocs (cCur : cRest)
  case (allAssocs, cCur) of
    ([(iid, _)], MStore rstore) | null cRest && not askWhenLone ->
      return $ Right $ RStore rstore [iid]
    _ -> transition leader psuit prompt promptGeneric permitMulitple
                    cCur cRest ISuitable

data DefItemKey m = DefItemKey
  { defLabel  :: Either Text K.KM
  , defCond   :: Bool
  , defAction :: ~(m (Either Text ResultItemDialogMode))
      -- this field may be expensive or undefined when @defCond@ is false
  }

data Suitability =
    SuitsEverything
  | SuitsSomething (Maybe CStore -> ItemFull -> ItemQuant -> Bool)

transition :: forall m. MonadClientUI m
           => ActorId
           -> m Suitability
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
               -> Text)
           -> Bool
           -> ItemDialogMode
           -> [ItemDialogMode]
           -> ItemDialogState
           -> m (Either Text ResultItemDialogMode)
transition leader psuit prompt promptGeneric permitMulitple
           cCur cRest itemDialogState = do
  let recCall cCur2 cRest2 itemDialogState2 = do
        -- Pointman could have been changed by keypresses near the end of
        -- the current recursive call, so refresh it for the next call.
        mleader <- getsClient sleader
        -- When run inside a test, without mleader, assume leader not changed.
        let leader2 = fromMaybe leader mleader
        transition leader2 psuit prompt promptGeneric permitMulitple
                   cCur2 cRest2 itemDialogState2
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  body <- getsState $ getActorBody leader
  bodyUI <- getsSession $ getActorUI leader
  fact <- getsState $ (EM.! bfid body) . sfactionD
  hs <- partyAfterLeader leader
  revCmd <- revCmdMap
  promptChosen <- getsState $ \s -> case itemDialogState of
    ISuitable -> prompt body bodyUI actorCurAndMaxSk cCur s <> ":"
    IAll -> promptGeneric body bodyUI actorCurAndMaxSk cCur s <> ":"
  let keyDefsCommon :: [(K.KM, DefItemKey m)]
      keyDefsCommon = filter (defCond . snd)
        [ let km = K.mkChar '<'
          in (km, changeContainerDef Backward $ Right km)
        , let km = K.mkChar '>'
          in (km, changeContainerDef Forward $ Right km)
        , cycleKeyDef Forward
        , cycleKeyDef Backward
        , cycleLevelKeyDef Forward
        , cycleLevelKeyDef Backward
        , (K.KM K.NoModifier K.LeftButtonRelease, DefItemKey
           { defLabel = Left ""
           , defCond = maySwitchLeader cCur && not (null hs)
           , defAction = do
               -- This is verbose even in aiming mode, displaying
               -- terrain description, but it's fine, mouse may do that.
               merror <- pickLeaderWithPointer leader
               case merror of
                 Nothing -> recCall cCur cRest itemDialogState
                 Just{} -> return $ Left "not a menu item nor teammate position"
                             -- don't inspect the error, it's expected
           })
        , (K.escKM, DefItemKey
           { defLabel = Right K.escKM
           , defCond = True
           , defAction = return $ Left "never mind"
           })
        ]
      cycleLevelKeyDef direction =
        let km = revCmd $ PointmanCycleLevel direction
        in (km, DefItemKey
                { defLabel = Left ""
                , defCond = maySwitchLeader cCur
                            && any (\(_, b, _) -> blid b == blid body) hs
                , defAction = do
                    err <- pointmanCycleLevel leader False direction
                    let !_A = assert (isNothing err `blame` err) ()
                    recCall cCur cRest itemDialogState
                })
      changeContainerDef direction defLabel =
        let (cCurAfterCalm, cRestAfterCalm) = nextContainers direction
        in DefItemKey
          { defLabel
          , defCond = cCurAfterCalm /= cCur
          , defAction = recCall cCurAfterCalm cRestAfterCalm itemDialogState
          }
      nextContainers direction = case direction of
        Forward -> case cRest ++ [cCur] of
          c1 : rest -> (c1, rest)
          [] -> error $ "" `showFailure` cRest
        Backward -> case reverse $ cCur : cRest of
          c1 : rest -> (c1, reverse rest)
          [] -> error $ "" `showFailure` cRest
      banned = bannedPointmanSwitchBetweenLevels fact
      maySwitchLeader MStore{} = True
      maySwitchLeader MOwned = False
      maySwitchLeader MSkills = True
      maySwitchLeader (MLore SBody) = True
      maySwitchLeader MLore{} = False
      maySwitchLeader MPlaces = False
      maySwitchLeader MFactions = False
      maySwitchLeader MModes = False
      cycleKeyDef direction =
        let km = revCmd $ PointmanCycle direction
        in (km, DefItemKey
               { defLabel = if direction == Forward then Right km else Left ""
               , defCond = maySwitchLeader cCur && not (banned || null hs)
               , defAction = do
                   err <- pointmanCycle leader False direction
                   let !_A = assert (isNothing err `blame` err) ()
                   recCall cCur cRest itemDialogState
               })
  case cCur of
    MSkills -> runDefSkills keyDefsCommon promptChosen leader
    MPlaces -> runDefPlaces keyDefsCommon promptChosen
    MFactions -> runDefFactions keyDefsCommon promptChosen
    MModes -> runDefModes keyDefsCommon promptChosen
    _ -> do
      bagHuge <- getsState $ \s -> accessModeBag leader s cCur
      itemToF <- getsState $ flip itemToFull
      mpsuit <- psuit  -- when throwing, this sets eps and checks xhair validity
      psuitFun <- case mpsuit of
        SuitsEverything -> return $ \_ _ _ -> True
        SuitsSomething f -> return f  -- When throwing, this function takes
                                      -- missile range into accout.
      ItemRoles itemRoles <- getsSession sroles
      let slore = loreFromMode cCur
          itemRole = itemRoles EM.! slore
          bagAll = EM.filterWithKey (\iid _ -> iid `ES.member` itemRole) bagHuge
          mstore = case cCur of
            MStore store -> Just store
            _ -> Nothing
          filterP = psuitFun mstore . itemToF
          bagSuit = EM.filterWithKey filterP bagAll
          bagFiltered = case itemDialogState of
            ISuitable -> bagSuit
            IAll -> bagAll
          iids = sortIids itemToF $ EM.assocs bagFiltered
          keyDefsExtra =
            [ let km = K.mkChar '+'
              in (km, DefItemKey
               { defLabel = Right km
               , defCond = bagAll /= bagSuit
               , defAction = recCall cCur cRest $ case itemDialogState of
                                                    ISuitable -> IAll
                                                    IAll -> ISuitable
               })
            , let km = K.mkChar '*'
              in (km, useMultipleDef $ Right km)
            , let km = K.mkChar '!'
              in (km, useMultipleDef $ Left "")  -- alias close to 'g'
            ]
          useMultipleDef defLabel = DefItemKey
            { defLabel
            , defCond = permitMulitple && not (null iids)
            , defAction = case cCur of
                MStore rstore -> return $! Right $ RStore rstore $ map fst iids
                _ -> error "transition: multiple items not for MStore"
            }
          keyDefs = keyDefsCommon ++ filter (defCond . snd) keyDefsExtra
      runDefInventory keyDefs promptChosen leader cCur iids

runDefMessage :: MonadClientUI m
              => [(K.KM, DefItemKey m)]
              -> Text
              -> m ()
runDefMessage keyDefs prompt = do
  let wrapB s = "[" <> s <> "]"
      keyLabelsRaw = lefts $ map (defLabel . snd) keyDefs
      keyLabels = filter (not . T.null) keyLabelsRaw
      choice = T.intercalate " " $ map wrapB $ nub keyLabels
        -- switch to Data.Containers.ListUtils.nubOrd when we drop GHC 8.4.4
  msgAdd MsgPromptGeneric $ prompt <+> choice

runDefAction :: MonadClientUI m
             => [(K.KM, DefItemKey m)]
             -> (MenuSlot -> Either Text ResultItemDialogMode)
             -> KeyOrSlot
             -> m (Either Text ResultItemDialogMode)
runDefAction keyDefs slotDef ekm = case ekm of
  Left km -> case km `lookup` keyDefs of
    Just keyDef -> defAction keyDef
    Nothing -> error $ "unexpected key:" `showFailure` K.showKM km
  Right slot -> return $! slotDef slot

runDefSkills :: MonadClientUI m
             => [(K.KM, DefItemKey m)] -> Text -> ActorId
             -> m (Either Text ResultItemDialogMode)
runDefSkills keyDefsCommon promptChosen leader = do
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = map fst keyDefsCommon
      keys = rights $ map (defLabel . snd) keyDefsCommon
  okx <- skillsOverlay leader
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (skillsInRightPane leader) sli itemKeys (show MSkills)
  runDefAction keyDefsCommon (Right . RSkills) ekm

skillsInRightPane :: MonadClientUI m => ActorId -> Int -> MenuSlot -> m OKX
skillsInRightPane leader width slot = do
  FontSetup{propFont} <- getFontSetup
  (prompt, attrString) <- skillCloseUp leader slot
  let promptAS | T.null prompt = []
               | otherwise = textFgToAS Color.Brown $ prompt <> "\n\n"
      ov = EM.singleton propFont $ offsetOverlay
                                 $ splitAttrString width width
                                 $ promptAS ++ attrString
  return (ov, [])

runDefPlaces :: MonadClientUI m
             => [(K.KM, DefItemKey m)] -> Text
             -> m (Either Text ResultItemDialogMode)
runDefPlaces keyDefsCommon promptChosen = do
  COps{coplace} <- getsState scops
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  soptions <- getsClient soptions
  places <- getsState $ EM.assocs
                      . placesFromState coplace (sexposePlaces soptions)
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = map fst keyDefsCommon
      keys = rights $ map (defLabel . snd) keyDefsCommon
  okx <- placesOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (placesInRightPane places) sli itemKeys (show MPlaces)
  runDefAction keyDefsCommon (Right . RPlaces) ekm

placesInRightPane :: MonadClientUI m
                  => [( ContentId PK.PlaceKind
                      , (ES.EnumSet LevelId, Int, Int, Int) )]
                  -> Int -> MenuSlot
                  -> m OKX
placesInRightPane places width slot = do
  FontSetup{propFont} <- getFontSetup
  soptions <- getsClient soptions
  (prompt, blurbs) <- placeCloseUp places (sexposePlaces soptions) slot
  let promptAS | T.null prompt = []
               | otherwise = textFgToAS Color.Brown $ prompt <> "\n\n"
      splitText = splitAttrString width width
      ov = attrLinesToFontMap
           $ map (second $ concatMap splitText)
           $ (propFont, [promptAS]) : blurbs
  return (ov, [])

runDefFactions :: MonadClientUI m
               => [(K.KM, DefItemKey m)] -> Text
               -> m (Either Text ResultItemDialogMode)
runDefFactions keyDefsCommon promptChosen = do
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  sroles <- getsSession sroles
  factions <- getsState $ factionsFromState sroles
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = map fst keyDefsCommon
      keys = rights $ map (defLabel . snd) keyDefsCommon
  okx <- factionsOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (factionsInRightPane factions)
           sli itemKeys (show MFactions)
  runDefAction keyDefsCommon (Right . RFactions) ekm

factionsInRightPane :: MonadClientUI m
                    => [(FactionId, Faction)]
                    -> Int -> MenuSlot
                    -> m OKX
factionsInRightPane factions width slot = do
  FontSetup{propFont} <- getFontSetup
  (prompt, blurbs) <- factionCloseUp factions slot
  let promptAS | T.null prompt = []
               | otherwise = textFgToAS Color.Brown $ prompt <> "\n\n"
      splitText = splitAttrString width width
      ov = attrLinesToFontMap
           $ map (second $ concatMap splitText)
           $ (propFont, [promptAS]) : blurbs
  return (ov, [])

runDefModes :: MonadClientUI m
            => [(K.KM, DefItemKey m)] -> Text
            -> m (Either Text ResultItemDialogMode)
runDefModes keyDefsCommon promptChosen = do
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  runDefMessage keyDefsCommon promptChosen
  let itemKeys = map fst keyDefsCommon
      keys = rights $ map (defLabel . snd) keyDefsCommon
  okx <- modesOverlay
  sli <- overlayToSlideshow (rheight - 2) keys okx
  -- Modes would cover the whole screen, so we don't display in right pane.
  -- But we display and highlight menu bullets.
  ekm <- displayChoiceScreenWithDefItemKey
           (\_ _ -> return emptyOKX) sli itemKeys (show MModes)
  runDefAction keyDefsCommon (Right . RModes) ekm

runDefInventory :: MonadClientUI m
                => [(K.KM, DefItemKey m)]
                -> Text
                -> ActorId
                -> ItemDialogMode
                -> [(ItemId, ItemQuant)]
                -> m (Either Text ResultItemDialogMode)
runDefInventory keyDefs promptChosen leader dmode iids = do
  CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  let meleeSkill = Ability.getSk Ability.SkHurtMelee actorCurAndMaxSk
      slotDef :: MenuSlot -> Either Text ResultItemDialogMode
      slotDef slot =
        let iid = fst $ iids !! fromEnum slot
        in Right $ case dmode of
          MStore rstore -> RStore rstore [iid]
          MOwned -> ROwned iid
          MLore rlore -> RLore rlore slot iids
          _ -> error $ "" `showFailure` dmode
      promptFun _iid _itemFull _k = ""
        -- TODO, e.g., if the party still owns any copies, if the actor
        -- was ever killed by us or killed ours, etc.
        -- This can be the same prompt or longer than what entering
        -- the item screen shows.
  runDefMessage keyDefs promptChosen
  let itemKeys = map fst keyDefs
      keys = rights $ map (defLabel . snd) keyDefs
  okx <- itemOverlay iids dmode
  sli <- overlayToSlideshow (rheight - 2) keys okx
  ekm <- displayChoiceScreenWithDefItemKey
           (okxItemLoreInline promptFun meleeSkill dmode iids)
           sli itemKeys (show dmode)
  runDefAction keyDefs slotDef ekm

skillCloseUp :: MonadClientUI m => ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp leader slot = do
  b <- getsState $ getActorBody leader
  bUI <- getsSession $ getActorUI leader
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  let skill = skillsInDisplayOrder !! fromEnum slot
      valueText = skillToDecorator skill b
                  $ Ability.getSk skill actorCurAndMaxSk
      prompt = makeSentence
        [ MU.WownW (partActor bUI) (MU.Text $ skillName skill)
        , "is", MU.Text valueText ]
      attrString = textToAS $ skillDesc skill
  return (prompt, attrString)

placeCloseUp :: MonadClientUI m
             => [(ContentId PK.PlaceKind, (ES.EnumSet LevelId, Int, Int, Int))]
             -> Bool
             -> MenuSlot
             -> m (Text, [(DisplayFont, [AttrString])])
placeCloseUp places sexposePlaces slot = do
  COps{coplace} <- getsState scops
  FontSetup{..} <- getFontSetup
  let (pk, (es, ne, na, _)) = places !! fromEnum slot
      pkind = okind coplace pk
      prompt = makeSentence ["you remember", MU.Text $ PK.pname pkind]
      freqsText = "Frequencies:" <+> T.intercalate " "
        (map (\(grp, n) -> "(" <> displayGroupName grp
                           <> ", " <> tshow n <> ")")
         $ PK.pfreq pkind)
      onLevels | ES.null es = []
               | otherwise = [makeSentence
                               [ "Appears on"
                               , MU.CarWs (ES.size es) "level" <> ":"
                               , MU.WWandW $ map MU.Car $ sort
                                 $ map (abs . fromEnum) $ ES.elems es ]]
      placeParts = ["it has" | ne > 0 || na > 0]
                   ++ [MU.CarWs ne "entrance" | ne > 0]
                   ++ ["and" | ne > 0 && na > 0]
                   ++ [MU.CarWs na "surrounding" | na > 0]
      partsSentence | null placeParts = []
                    | otherwise = [makeSentence placeParts, "\n"]
      blurbs = [(propFont, partsSentence)]
               ++ [(monoFont, [freqsText, "\n"]) | sexposePlaces]
               ++ [(squareFont, PK.ptopLeft pkind ++ ["\n"]) | sexposePlaces]
               ++ [(propFont, onLevels)]
  return (prompt, map (second $ map textToAS) blurbs)

factionCloseUp :: MonadClientUI m
               => [(FactionId, Faction)]
               -> MenuSlot
               -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp factions slot = do
  side <- getsClient sside
  FontSetup{propFont} <- getFontSetup
  factionD <- getsState sfactionD
  let (fid, fact@Faction{gkind=FK.FactionKind{..}, ..}) =
        factions !! fromEnum slot
      (name, person) = if fhasGender  -- but we ignore "Controlled", etc.
                       then (makePhrase [MU.Ws $ MU.Text fname], MU.PlEtc)
                       else (fname, MU.Sg3rd)
      (youThey, prompt) =
        if fid == side
        then ("You", makeSentence  ["you are the", MU.Text name])
        else ("They", makeSentence ["you are wary of the", MU.Text name])
               -- wary even if the faction is allied
      ts1 =
        -- Display only the main groups, not to spam.
        case map fst $ filter ((>= 100) . snd) fgroups of
          [] -> []  -- only initial actors in the faction?
          [fgroup] ->
            [makeSentence [ "the faction consists of"
                          , MU.Ws $ MU.Text $ displayGroupName fgroup ]]
          grps -> [makeSentence
                    [ "the faction attracts members such as:"
                    ,  MU.WWandW $ map (MU.Text . displayGroupName) grps ]]
        ++ [if fskillsOther == Ability.zeroSkills  -- simplified
            then youThey <+> "don't care about each other and crowd and stampede all at once, sometimes brutally colliding by accident."
            else youThey <+> "pay attention to each other and take care to move one at a time."]
        ++ [ if fcanEscape
             then "The faction is able to take part in races to an area exit."
             else "The faction doesn't escape areas of conflict and attempts to block exits instead."]
        ++ [ "When all members are incapacitated, the faction dissolves."
           | fneverEmpty ]
        ++ [if fhasGender
            then "Its members are known to have sexual dimorphism and use gender pronouns."
            else "Its members seem to prefer naked ground for sleeping."]
        ++ [ "Its ranks swell with time."
           | fspawnsFast ]
        ++ [ "The faction is able to maintain activity on a level on its own, with a pointman coordinating each tactical maneuver."
           | fhasPointman ]
      -- Changes to all of these have visibility @PosAll@, so the player
      -- knows them fully, except for @gvictims@, which is coupled to tracking
      -- other factions' actors and so only incremented when we've seen
      -- their actor killed (mostly likely killed by us).
      ts2 =  -- reporting regardless of whether any of the factions are dead
        let renderDiplGroup [] = error "renderDiplGroup: null"
            renderDiplGroup ((fid2, diplomacy) : rest) = MU.Phrase
              [ MU.Text $ tshowDiplomacy diplomacy
              , "with"
              , MU.WWandW $ map renderFact2 $ fid2 : map fst rest ]
            renderFact2 fid2 = MU.Text $ Faction.gname (factionD EM.! fid2)
            valid (fid2, diplomacy) = isJust (lookup fid2 factions)
                                      && diplomacy /= Unknown
            knownAssocsGroups = groupBy ((==) `on` snd) $ sortOn snd
                                $ filter valid $ EM.assocs gdipl
        in [ makeSentence [ MU.SubjectVerb person MU.Yes (MU.Text name) "be"
                          , MU.WWandW $ map renderDiplGroup knownAssocsGroups ]
           | not (null knownAssocsGroups) ]
      ts3 =
        case gquit of
          Just Status{..} | not $ isHorrorFact fact ->
            ["The faction has already" <+> FK.nameOutcomePast stOutcome
             <+> "around level" <+> tshow (abs stDepth) <> "."]
          _ -> []
        ++ let nkilled = sum $ EM.elems gvictims
               personKilled = if nkilled == 1 then MU.Sg3rd else MU.PlEtc
           in [ makeSentence $
                  [ "so far," | isNothing gquit ]
                  ++ [ "at least"
                     , MU.CardinalWs nkilled "member"
                     , MU.SubjectVerb personKilled
                                      MU.Yes
                                      "of this faction"
                                      "have been incapacitated" ]
              | nkilled > 0 ]
        ++ let adjective = if isNothing gquit then "current" else "last"
               verb = if isNothing gquit then "is" else "was"
           in ["Its" <+> adjective <+> "doctrine" <+> verb
               <+> "'" <> Ability.nameDoctrine gdoctrine
               <> "' (" <> Ability.describeDoctrine gdoctrine <> ")."]
      -- Description of the score polynomial would go into a separate section,
      -- but it's hard to make it sound non-technical enough.
      blurbs = intersperse ["\n"] $ filter (not . null) [ts1, ts2, ts3]
  return (prompt, map (\t -> (propFont, map textToAS t)) blurbs)