-- | 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 :: m (Maybe RequestUI)
queryUI = do
  Bool
sreqQueried <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreqQueried
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not Bool
sreqQueried) ()  -- querying not nested
  (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 {sreqQueried :: Bool
sreqQueried = Bool
True}
  let loop :: m (Maybe RequestUI)
loop = do
        Maybe RequestUI
mres <- m (Maybe RequestUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe RequestUI)
stepQueryUIwithLeader
        Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
        case Maybe RequestUI
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestUI
mres
  Maybe RequestUI
mres <- m (Maybe RequestUI)
loop
  (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 {sreqQueried :: Bool
sreqQueried = Bool
False}
  Maybe RequestUI -> m (Maybe RequestUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestUI
mres

queryUIunderAI :: (MonadClient m, MonadClientUI m) => m RequestUI
queryUIunderAI :: 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.
 Bool
sregainControl <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sregainControl
 if Bool
sregainControl then 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 { sregainControl :: Bool
sregainControl = Bool
False
                                 , sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayNot
                                 , sreqPending :: Maybe RequestUI
sreqPending = Maybe RequestUI
forall a. Maybe a
Nothing }  -- just in case
   -- The keys mashed to gain control are not considered a command.
   m ()
forall (m :: * -> *). MonadClientUI m => m ()
resetPressedKeys
   -- Menu is entered in @displayRespUpdAtomicUI@ at @UpdAutoFaction@
   -- and @stopAfter@ is canceled in @cmdAtomicSemCli@
   -- when handling the results of the request below.
   RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUIAutomate, Maybe ActorId
forall a. Maybe a
Nothing)
 else do
  Maybe Int
stopAfterFrames <- (StateClient -> Maybe Int) -> m (Maybe Int)
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
sstopAfterFrames (ClientOptions -> Maybe Int)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  Bool
bench <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
sbenchmark (ClientOptions -> Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  let exitCmd :: ReqUI
exitCmd = if Bool
bench then ReqUI
ReqUIGameDropAndExit else ReqUI
ReqUIGameSaveAndExit
  case Maybe Int
stopAfterFrames of
    Maybe Int
Nothing -> do
      Maybe Int
stopAfterSeconds <- (StateClient -> Maybe Int) -> m (Maybe Int)
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 Maybe Int
stopAfterSeconds of
        Maybe Int
Nothing -> RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)
        Just Int
stopS -> do
          POSIXTime
sstartPOSIX <- (SessionUI -> POSIXTime) -> m POSIXTime
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> POSIXTime
sstart
          Bool
exit <- POSIXTime -> Int -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
POSIXTime -> Int -> m Bool
elapsedSessionTimeGT POSIXTime
sstartPOSIX Int
stopS
          if Bool
exit then do
            m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellAllClipPS
            RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
exitCmd, Maybe ActorId
forall a. Maybe a
Nothing)  -- ask server to exit
          else RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)
    Just Int
stopF -> do
      Int
allNframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
sallNframes
      Int
gnframes <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snframes
      if Int
allNframes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gnframes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
stopF then do
        m ()
forall (m :: * -> *). MonadClientUI m => m ()
tellAllClipPS
        RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
exitCmd, Maybe ActorId
forall a. Maybe a
Nothing)  -- ask server to exit
      else RequestUI -> m RequestUI
forall (m :: * -> *) a. Monad m => a -> m a
return (ReqUI
ReqUINop, Maybe ActorId
forall a. Maybe a
Nothing)

stepQueryUIwithLeader :: (MonadClient m, MonadClientUI m)
                       => m (Maybe RequestUI)
stepQueryUIwithLeader :: m (Maybe RequestUI)
stepQueryUIwithLeader = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Maybe ReqUI
mreq <- m (Maybe ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe ReqUI)
stepQueryUI
  case Maybe ReqUI
mreq of
    Maybe ReqUI
Nothing -> Maybe RequestUI -> m (Maybe RequestUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestUI
forall a. Maybe a
Nothing
    Just ReqUI
req -> do
      Maybe ActorId
mleader2 <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
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 -> Bool
saveCmd ReqUI
cmd = case ReqUI
cmd of
            ReqUI
ReqUIGameDropAndExit -> Bool
True
            ReqUI
ReqUIGameSaveAndExit -> Bool
True
            ReqUI
ReqUIGameSave -> Bool
True
            ReqUI
_ -> Bool
False
      Maybe RequestUI -> m (Maybe RequestUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestUI -> m (Maybe RequestUI))
-> Maybe RequestUI -> m (Maybe RequestUI)
forall a b. (a -> b) -> a -> b
$ RequestUI -> Maybe RequestUI
forall a. a -> Maybe a
Just (ReqUI
req, if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader2 Bool -> Bool -> Bool
&& Bool -> Bool
not (ReqUI -> Bool
saveCmd ReqUI
req)
                          then Maybe ActorId
mleader2
                          else Maybe ActorId
forall a. Maybe a
Nothing)

-- | Let the human player issue commands until any command takes time.
stepQueryUI :: (MonadClient m, MonadClientUI m) => m (Maybe ReqUI)
stepQueryUI :: m (Maybe ReqUI)
stepQueryUI = do
  FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  KeyMacroFrame
macroFrame <- (SessionUI -> KeyMacroFrame) -> m KeyMacroFrame
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> KeyMacroFrame
smacroFrame
  -- This message, in particular, disturbs.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
keyPressed Bool -> Bool -> Bool
&& Bool -> Bool
not ([KM] -> Bool
forall a. [a] -> Bool
null (KeyMacro -> [KM]
unKeyMacro (KeyMacroFrame -> KeyMacro
keyPending KeyMacroFrame
macroFrame)))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning Text
"*interrupted*"
  Report
report <- (SessionUI -> Report) -> m Report
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Report) -> m Report)
-> (SessionUI -> Report) -> m Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport (History -> Report)
-> (SessionUI -> History) -> SessionUI -> Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> History
shistory
  (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 :: Bool
sreportNull = Report -> Bool
nullVisibleReport Report
report}
  Slideshow
slides <- Bool -> [KM] -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt Bool
False []
  EnumMap DisplayFont Overlay
ovs <- case Slideshow -> Maybe (Slideshow, OKX)
unsnoc Slideshow
slides of
    Maybe (Slideshow, OKX)
Nothing -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
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 (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. [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 :: Bool
sreportNull = Bool
True}
        -- Display base frame at the end.
        EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *) a. Monad m => a -> m a
return EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  case Maybe ActorId
mleader of
    Maybe ActorId
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ActorId
leader -> do
      Actor
body <- (State -> Actor) -> m Actor
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
      EnumSet ActorId
lastLost <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
slastLost
      if Actor -> Int64
bhp Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 then do
        FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
        Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
        let gameOver :: Bool
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)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
gameOver Bool -> Bool -> Bool
&& ActorId
leader ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.notMember` EnumSet ActorId
lastLost) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- Hacky reuse of @slastLost@ for near-death spam prevention.
          (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 {slastLost :: EnumSet ActorId
slastLost = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
leader EnumSet ActorId
lastLost}
          ColorMode -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
displayMore ColorMode
ColorBW Text
"If you move, the exertion will kill you. Consider asking for first aid instead."
      else
        (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 {slastLost :: EnumSet ActorId
slastLost = EnumSet ActorId
forall k. EnumSet k
ES.empty}
  KM
km <- ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
promptGetKey ColorMode
ColorFull EnumMap DisplayFont Overlay
ovs Bool
False []
  Either MError ReqUI
abortOrCmd <- do
    -- Look up the key.
    CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{Map KM CmdTriple
bcmdMap :: InputContent -> Map KM CmdTriple
bcmdMap :: Map KM CmdTriple
bcmdMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
    case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map KM CmdTriple
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 :: Int
swaitTimes = if SessionUI -> Int
swaitTimes SessionUI
sess Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                                    then - SessionUI -> Int
swaitTimes SessionUI
sess
                                                    else Int
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.
  (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 ->
    let (KeyMacroFrame
smacroFrameNew, [KeyMacroFrame]
smacroStackMew) =
          KeyMacroFrame
-> [KeyMacroFrame] -> (KeyMacroFrame, [KeyMacroFrame])
dropEmptyMacroFrames (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
smacroFrameNew
            , smacroStack :: [KeyMacroFrame]
smacroStack = [KeyMacroFrame]
smacroStackMew }
  -- The command was failed or successful and if the latter,
  -- possibly took some time.
  case Either MError ReqUI
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqUI
forall a. Maybe a
Nothing