    -- | Ways for the client to use player input via UI to produce server
    -- requests, based on the client's view (visualized for the player)
    -- of the game state.
    --
    -- This module is leaking quite a bit of implementation details
    -- for the sake of "Game.LambdaHack.Client.LoopM". After multiplayer
    -- is enabled again and the new requirements sorted out, this should be
    -- redesigned and some code moved down the module hierarhy tree,
    -- exposing a smaller API here.
    module Game.LambdaHack.Client.UI
      ( -- * Querying the human player
        queryUI, queryUIunderAI
        -- * UI monad operations
      , MonadClientUI(..), putSession, anyKeyPressed, resetPressedKeys
        -- * UI session type
      , SessionUI(..), ReqDelay(..), emptySessionUI
        -- * Updating UI state wrt game state changes
      , watchRespUpdAtomicUI, watchRespSfxAtomicUI
        -- * Startup and initialization
      , CCUI(..)
      , UIOptions, applyUIOptions, uOverrideCmdline, mkUIOptions
        -- * Assorted operations and types
      , ChanFrontend, chanFrontend, tryRestore, clientPrintUI
      , pushReportFrame, msgAdd, MsgClassShow(..)
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , stepQueryUIwithLeader, stepQueryUI
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    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           Game.LambdaHack.Client.MonadClient
    import           Game.LambdaHack.Client.Request
    import           Game.LambdaHack.Client.State
    import           Game.LambdaHack.Client.UI.Content.Input
    import           Game.LambdaHack.Client.UI.ContentClientUI
    import           Game.LambdaHack.Client.UI.Frame
    import           Game.LambdaHack.Client.UI.FrameM
    import           Game.LambdaHack.Client.UI.Frontend
    import           Game.LambdaHack.Client.UI.HandleHelperM
    import           Game.LambdaHack.Client.UI.HandleHumanM
    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.Client.UI.UIOptions
    import           Game.LambdaHack.Client.UI.UIOptionsParse
    import           Game.LambdaHack.Client.UI.Watch
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.ClientOptions
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.MonadStateRead
    import           Game.LambdaHack.Common.State
    import           Game.LambdaHack.Content.FactionKind

    -- | Handle the move of a human player.
    queryUI :: (MonadClient m, MonadClientUI m) => m (Maybe RequestUI)
    queryUI :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m (Maybe RequestUI)
    queryUI = do
      sreqQueried <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    sreqQueried
      let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not Bool
    sreqQueried) ()  -- querying not nested
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sreqQueried = True}
      let loop = do
            mres <- m (Maybe RequestUI)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m (Maybe RequestUI)
    stepQueryUIwithLeader
            saimMode <- getsSession saimMode
            case mres of
              Maybe RequestUI
    Nothing | Maybe AimMode -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe AimMode
    saimMode -> m (Maybe RequestUI)
    loop  -- loop until aiming finished
              Maybe RequestUI
    _ -> Maybe RequestUI -> m (Maybe RequestUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestUI
    mres
      mres <- loop
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sreqQueried = False}
      return mres

    queryUIunderAI :: (MonadClient m, MonadClientUI m) => m RequestUI
    queryUIunderAI :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m RequestUI
    queryUIunderAI = do
     -- Record history so the player can browse it later on.
     m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    recordHistory
     -- As long as UI faction is under AI control, check, once per move,
     -- for immediate control regain or benchmark game stop.
     sregainControl <- (SessionUI -> Bool) -> m Bool
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Bool
    sregainControl
     if sregainControl then do
       modifySession $ \SessionUI
    sess -> SessionUI
    sess { sregainControl = False
                                     , sreqDelay = ReqDelayNot
                                     , sreqPending = Nothing }  -- just in case
       -- The keys mashed to gain control are not considered a command.
       resetPressedKeys
       -- Menu is entered in @displayRespUpdAtomicUI@ at @UpdAutoFaction@
       -- and @stopAfter@ is canceled in @cmdAtomicSemCli@
       -- when handling the results of the request below.
       return (ReqUIAutomate, Nothing)
     else do
      stopAfterFrames <- getsClient $ sstopAfterFrames . soptions
      bench <- getsClient $ sbenchmark . soptions
      let exitCmd = if Bool
    bench then ReqUI
    ReqUIGameDropAndExit else ReqUI
    ReqUIGameSaveAndExit
      case stopAfterFrames of
        Maybe Int
    Nothing -> do
          stopAfterSeconds <- (StateClient -> Maybe Int) -> m (Maybe Int)
    forall a. (StateClient -> a) -> m a
    forall (m :: * -> *) a.
    MonadClientRead m =>
    (StateClient -> a) -> m a
    getsClient ((StateClient -> Maybe Int) -> m (Maybe Int))
    -> (StateClient -> Maybe Int) -> m (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ ClientOptions -> Maybe Int
    sstopAfterSeconds (ClientOptions -> Maybe Int)
    -> (StateClient -> ClientOptions) -> StateClient -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateClient -> ClientOptions
    soptions
          case stopAfterSeconds of
            Maybe Int
    Nothing -> RequestUI -> m RequestUI
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReqUI
    ReqUINop, Maybe ActorId
    forall a. Maybe a
    Nothing)
            Just Int
    stopS -> do
              sstartPOSIX <- (SessionUI -> POSIXTime) -> m POSIXTime
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> POSIXTime
    sstart
              exit <- elapsedSessionTimeGT sstartPOSIX stopS
              if exit then do
                tellAllClipPS
                return (exitCmd, Nothing)  -- ask server to exit
              else return (ReqUINop, Nothing)
        Just Int
    stopF -> do
          allNframes <- (SessionUI -> Int) -> m Int
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Int
    sallNframes
          gnframes <- getsSession snframes
          if allNframes + gnframes >= stopF then do
            tellAllClipPS
            return (exitCmd, Nothing)  -- ask server to exit
          else return (ReqUINop, Nothing)

    stepQueryUIwithLeader :: (MonadClient m, MonadClientUI m)
                           => m (Maybe RequestUI)
    stepQueryUIwithLeader :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m (Maybe RequestUI)
    stepQueryUIwithLeader = 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
      mleader <- getsState $ gleader . (EM.! side) . sfactionD
      mreq <- stepQueryUI
      case mreq of
        Maybe ReqUI
    Nothing -> Maybe RequestUI -> m (Maybe RequestUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestUI
    forall a. Maybe a
    Nothing
        Just ReqUI
    req -> do
          mleader2 <- (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
          -- Don't send the leader switch to the server with these commands,
          -- to avoid leader death at resume if his HP <= 0. That would violate
          -- the principle that save and reload doesn't change game state.
          let saveCmd ReqUI
    cmd = case ReqUI
    cmd of
                ReqUI
    ReqUIGameDropAndExit -> Bool
    True
                ReqUI
    ReqUIGameSaveAndExit -> Bool
    True
                ReqUI
    ReqUIGameSave -> Bool
    True
                ReqUI
    _ -> Bool
    False
          return $ Just (req, if mleader /= mleader2 && not (saveCmd req)
                              then mleader2
                              else Nothing)

    -- | Let the human player issue commands until any command takes time.
    stepQueryUI :: (MonadClient m, MonadClientUI m) => m (Maybe ReqUI)
    stepQueryUI :: forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    m (Maybe ReqUI)
    stepQueryUI = do
      FontSetup{propFont} <- m FontSetup
    forall (m :: * -> *). MonadClientUI m => m FontSetup
    getFontSetup
      keyPressed <- anyKeyPressed
      macroFrame <- getsSession smacroFrame
      -- This message, in particular, disturbs.
      when (keyPressed && not (null (unKeyMacro (keyPending macroFrame)))) $
        msgAdd MsgActionWarning "*interrupted*"
      report <- getsSession $ newReport . shistory
      modifySession $ \SessionUI
    sess -> SessionUI
    sess {sreportNull = nullVisibleReport report}
      slides <- reportToSlideshowKeepHalt False []
      ovs <- case unsnocSlideshow slides of
        Maybe (Slideshow, OKX)
    Nothing -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnumMap DisplayFont Overlay
    forall k a. EnumMap k a
    EM.empty
        Just (Slideshow
    allButLast, (EnumMap DisplayFont Overlay
    ov, [KYX]
    _)) ->
          if Slideshow
    allButLast Slideshow -> Slideshow -> Bool
    forall a. Eq a => a -> a -> Bool
    == Slideshow
    emptySlideshow
          then do
            -- Display the only generated slide while waiting for next key.
            -- Strip the "--end-" prompt from it, by ignoring @MonoFont@.
            let ovProp :: Overlay
    ovProp = EnumMap DisplayFont Overlay
    ov EnumMap DisplayFont Overlay -> DisplayFont -> Overlay
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! DisplayFont
    propFont
            EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay))
    -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a b. (a -> b) -> a -> b
    $!
              DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ if EnumMap DisplayFont Overlay -> Int
    forall k a. EnumMap k a -> Int
    EM.size EnumMap DisplayFont Overlay
    ov Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 then Overlay
    ovProp else Overlay -> Overlay
    forall a. (?callStack::CallStack) => [a] -> [a]
    init Overlay
    ovProp
          else do
            -- Show, one by one, all slides, awaiting confirmation for each.
            m KM -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m KM -> m ()) -> m KM -> m ()
    forall a b. (a -> b) -> a -> b
    $ ColorMode -> [KM] -> Slideshow -> m KM
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> [KM] -> Slideshow -> m KM
    getConfirms ColorMode
    ColorFull [KM
    K.spaceKM, KM
    K.escKM] Slideshow
    slides
            -- Indicate that report wiped out.
            (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess -> SessionUI
    sess {sreportNull = True}
            -- Display base frame at the end.
            EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnumMap DisplayFont Overlay
    forall k a. EnumMap k a
    EM.empty
      mleader <- getsClient sleader
      case mleader of
        Maybe ActorId
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just ActorId
    leader -> do
          body <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
          lastLost <- getsSession slastLost
          if bhp body <= 0 then do
            side <- getsClient sside
            fact <- getsState $ (EM.! side) . sfactionD
            let gameOver = Bool -> (Status -> Bool) -> Maybe Status -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False ((Outcome -> Outcome -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Outcome
    Camping) (Outcome -> Bool) -> (Status -> Outcome) -> Status -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Status -> Outcome
    stOutcome) (Faction -> Maybe Status
    gquit Faction
    fact)
            when (not gameOver && leader `ES.notMember` lastLost) $ do
              -- Hacky reuse of @slastLost@ for near-death spam prevention.
              modifySession $ \SessionUI
    sess ->
                SessionUI
    sess {slastLost = ES.insert leader lastLost}
              displayMore ColorBW "If you move, the exertion will kill you. Consider asking for first aid instead."
          else
            modifySession $ \SessionUI
    sess -> SessionUI
    sess {slastLost = ES.empty}
      km <- promptGetKey ColorFull ovs False []
      abortOrCmd <- do
        -- Look up the key.
        CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui
        case km `M.lookup` bcmdMap of
          Just ([CmdCategory]
    _, Text
    _, 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 {swaitTimes = if swaitTimes sess > 0
                                                        then - swaitTimes sess
                                                        else 0}
            KM -> HumanCmd -> m (Either MError ReqUI)
    forall (m :: * -> *).
    (MonadClient m, MonadClientUI m) =>
    KM -> HumanCmd -> m (Either MError ReqUI)
    cmdSemInCxtOfKM KM
    km HumanCmd
    cmd
          Maybe CmdTriple
    _ -> let msgKey :: String
    msgKey = String
    "unknown command '" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> KM -> String
    K.showKM KM
    km String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "'"
               in 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 (String -> Text
    T.pack String
    msgKey)
      -- GC macro stack if there are no actions left to handle,
      -- removing all unnecessary macro frames at once,
      -- but leaving the last one for user's in-game macros.
      modifySession $ \SessionUI
    sess ->
        let (KeyMacroFrame
    smacroFrameNew, [KeyMacroFrame]
    smacroStackMew) =
              KeyMacroFrame
    -> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])
    dropEmptyMacroFrames (SessionUI -> KeyMacroFrame
    smacroFrame SessionUI
    sess) (SessionUI -> [KeyMacroFrame]
    smacroStack SessionUI
    sess)
        in SessionUI
    sess { smacroFrame = smacroFrameNew
                , smacroStack = smacroStackMew }
      -- The command was failed or successful and if the latter,
      -- possibly took some time.
      case abortOrCmd of
        Right ReqUI
    cmdS ->
          -- Exit the loop and let other actors act. No next key needed
          -- and no report could have been generated.
          Maybe ReqUI -> m (Maybe ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ReqUI -> m (Maybe ReqUI)) -> Maybe ReqUI -> m (Maybe ReqUI)
    forall a b. (a -> b) -> a -> b
    $ ReqUI -> Maybe ReqUI
    forall a. a -> Maybe a
    Just ReqUI
    cmdS
        Left MError
    Nothing -> Maybe ReqUI -> m (Maybe ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ReqUI
    forall a. Maybe a
    Nothing
        Left (Just FailError
    err) -> do
          MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgAdd MsgClassShow
    MsgActionAlert (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ FailError -> Text
    showFailError FailError
    err
          Maybe ReqUI -> m (Maybe ReqUI)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ReqUI
    forall a. Maybe a
    Nothing