{-# LANGUAGE FlexibleContexts #-}
-- | The main loop of the client, processing human and computer player
-- moves turn by turn.
module Game.LambdaHack.Client.LoopM
  ( MonadClientReadResponse(..)
  , loopCli
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , initAI, initUI, loopAI, longestDelay, loopUI
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           Data.Time.Clock
import           Data.Time.Clock.POSIX

import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.HandleAtomicM
import Game.LambdaHack.Client.HandleResponseM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Response
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State

-- | Client monad in which one can receive responses from the server.
class MonadClient m => MonadClientReadResponse m where
  receiveResponse :: m Response

initAI :: MonadClient m => m ()
initAI :: m ()
initAI = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"AI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"initializing."

initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI :: CCUI -> m ()
initUI sccui :: CCUI
sccui@CCUI{ScreenContent
coscreen :: CCUI -> ScreenContent
coscreen :: ScreenContent
coscreen} = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"UI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"initializing."
  -- Start the frontend.
  ChanFrontend
schanF <- ScreenContent -> ClientOptions -> m ChanFrontend
forall (m :: * -> *).
MonadClientUI m =>
ScreenContent -> ClientOptions -> m ChanFrontend
chanFrontend ScreenContent
coscreen ClientOptions
soptions
  (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 {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
sccui}

-- | The main game loop for an AI or UI client. It receives responses from
-- the server, changes internal client state accordingly, analyzes
-- ensuing human or AI commands and sends resulting requests to the server.
-- Depending on whether it's an AI or UI client, it sends AI or human player
-- requests.
--
-- The loop is started in client state that is empty except for
-- the @sside@ and @seps@ fields, see 'emptyStateClient'.
loopCli :: ( MonadClientSetup m
           , MonadClientUI m
           , MonadClientAtomic m
           , MonadClientReadResponse m
           , MonadClientWriteRequest m )
        => CCUI -> UIOptions -> ClientOptions -> m ()
loopCli :: CCUI -> UIOptions -> ClientOptions -> m ()
loopCli CCUI
ccui UIOptions
sUIOptions ClientOptions
clientOptions = do
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {soptions :: ClientOptions
soptions = ClientOptions
clientOptions}
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Bool
hasUI <- m Bool
forall (m :: * -> *). MonadClientWriteRequest m => m Bool
clientHasUI
  if Bool -> Bool
not Bool
hasUI then m ()
forall (m :: * -> *). MonadClient m => m ()
initAI else CCUI -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
CCUI -> m ()
initUI CCUI
ccui
  let cliendKindText :: Text
cliendKindText = if Bool -> Bool
not Bool
hasUI then Text
"AI" else Text
"UI"
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"started 1/4."
  -- Warning: state and client state are invalid here, e.g., sdungeon
  -- and sper are empty.
  Maybe (StateClient, Maybe SessionUI)
restoredG <- m (Maybe (StateClient, Maybe SessionUI))
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe (StateClient, Maybe SessionUI))
tryRestore
  Bool
restored <- case Maybe (StateClient, Maybe SessionUI)
restoredG of
    Just (StateClient
cli, Maybe SessionUI
msess) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
snewGameCli ClientOptions
clientOptions -> do
      -- Restore game.
      ChanFrontend
schanF <- (SessionUI -> ChanFrontend) -> m ChanFrontend
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChanFrontend
schanF
      CCUI
sccui <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
      m () -> (SessionUI -> m ()) -> Maybe SessionUI -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\SessionUI
sess -> (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 -> SessionUI -> SessionUI
forall a b. a -> b -> a
const
        SessionUI
sess {ChanFrontend
schanF :: ChanFrontend
schanF :: ChanFrontend
schanF, CCUI
sccui :: CCUI
sccui :: CCUI
sccui, UIOptions
sUIOptions :: UIOptions
sUIOptions :: UIOptions
sUIOptions}) Maybe SessionUI
msess
      let noAnim :: Bool
noAnim = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool) -> ClientOptions -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ StateClient -> ClientOptions
soptions StateClient
cli
      StateClient -> m ()
forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
cli {soptions :: ClientOptions
soptions = ClientOptions
clientOptions {snoAnim :: Maybe Bool
snoAnim = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noAnim}}
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just (StateClient
_, Maybe SessionUI
msessR) -> do
      -- Preserve previous history, if any.
      m () -> (SessionUI -> m ()) -> Maybe SessionUI -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\SessionUI
sessR -> (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 {shistory :: History
shistory = SessionUI -> History
shistory SessionUI
sessR}) Maybe SessionUI
msessR
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Maybe (StateClient, Maybe SessionUI)
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"started 2/4."
  -- At this point @ClientState@ not overriten dumbly and @State@ valid.
  PrimArray PointI
tabA <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
  PrimArray PointI
tabB <- m (PrimArray PointI)
forall (m :: * -> *). MonadClient m => m (PrimArray PointI)
createTabBFS
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {stabs :: (PrimArray PointI, PrimArray PointI)
stabs = (PrimArray PointI
tabA, PrimArray PointI
tabB)}
  Response
cmd1 <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"started 3/4."
  case (Bool
restored, Response
cmd1) of
    (Bool
True, RespUpdAtomic State
_ UpdResume{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, RespUpdAtomic State
_ UpdRestart{}) ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
    (Bool
False, RespUpdAtomic State
_ UpdResume{}) ->
      [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not usable."
              [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
    (Bool
False, RespUpdAtomic State
_ UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
True, RespUpdAtomicNoState UpdResume{}) -> m ()
forall a. HasCallStack => a
undefined
    (Bool
True, RespUpdAtomicNoState UpdRestart{}) ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasUI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Ignoring an old savefile and starting a new game."
    (Bool
False, RespUpdAtomicNoState UpdResume{}) ->
      [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Savefile of client " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FactionId -> [Char]
forall a. Show a => a -> [Char]
show FactionId
side [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not usable."
              [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
    (Bool
False, RespUpdAtomicNoState UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool, Response)
_ -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected command" [Char] -> (FactionId, Bool, Response) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (FactionId
side, Bool
restored, Response
cmd1)
  Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd1
  -- State and client state now valid.
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client"
                       Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> Text
"started 4/4."
  if Bool
hasUI
  then POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
  else m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
m ()
loopAI
  FactionId
side2 <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Text -> m ()
forall (m :: * -> *). MonadClient m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cliendKindText Text -> Text -> Text
<+> Text
"client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side2
                       Text -> Text -> Text
<+> Text
"(initially" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") stopped."

loopAI :: ( MonadClientSetup m
          , MonadClientUI m
          , MonadClientAtomic m
          , MonadClientReadResponse m
          , MonadClientWriteRequest m )
       => m ()
loopAI :: m ()
loopAI = do
  Response
cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
  Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd
  Bool
quit <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Bool
squit
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit
    m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
m ()
loopAI

-- | Alarm after this many seconds without server querying us for a command.
longestDelay :: POSIXTime
longestDelay :: POSIXTime
longestDelay = Pico -> POSIXTime
secondsToNominalDiffTime Pico
1
                 -- really high to accomodate slow browsers

-- | The argument is the time of last UI query from the server.
-- After @longestDelay@ seconds past this date, the client considers itself
-- ignored and displays a warning and, at a keypress, gives
-- direct control to the player, no longer waiting for the server
-- to prompt it to do so.
loopUI :: ( MonadClientSetup m
          , MonadClientUI m
          , MonadClientAtomic m
          , MonadClientReadResponse m
          , MonadClientWriteRequest m )
       => POSIXTime -> m ()
loopUI :: POSIXTime -> m ()
loopUI POSIXTime
timeSinceLastQuery = do
  Maybe RequestUI
sreqPending <- (SessionUI -> Maybe RequestUI) -> m (Maybe RequestUI)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RequestUI
sreqPending
  ReqDelay
sreqDelay <- (SessionUI -> ReqDelay) -> m ReqDelay
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ReqDelay
sreqDelay
  Bool
sregainControl <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sregainControl
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  let alarm :: Bool
alarm = POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
longestDelay
  if | Bool -> Bool
not Bool
alarm  -- no alarm starting right now
       Bool -> Bool -> Bool
&& -- no need to mark AI for control regain ASAP:
          (ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayNot  -- no old alarm still in effect
           Bool -> Bool -> Bool
|| Bool
sregainControl  -- AI control already marked for regain
           Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
keyPressed  -- player does not insist by keypress
               Bool -> Bool -> Bool
&& ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
/= ReqDelay
ReqDelayHandled)) -> do  -- or by hack
       POSIXTime
timeBefore <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
       Response
cmd <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
       POSIXTime
timeAfter <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadClientRead m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
       Response -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientWriteRequest m) =>
Response -> m ()
handleResponse Response
cmd
       -- @squit@ can be changed only in @handleResponse@, so this is the only
       -- place where it needs to be checked.
       Bool
quit <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Bool
squit
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quit (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Response
cmd of
         Response
RespQueryUI -> POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
         Response
RespQueryUIunderAI ->
           POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXTime
forall a. Enum a => a -> a
succ POSIXTime
longestDelay  -- permit fast AI control regain
         Response
_ -> do
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isJust Maybe RequestUI
sreqPending) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
             MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
"Warning: server updated game state after current command was issued by the client but before it was received by the server."
           -- This measures only the server's delay.
           POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI (POSIXTime -> m ()) -> POSIXTime -> m ()
forall a b. (a -> b) -> a -> b
$ POSIXTime
timeSinceLastQuery POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
timeBefore POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
timeAfter
     | Bool -> Bool
not Bool
sregainControl Bool -> Bool -> Bool
&& (Bool
keyPressed
                              Bool -> Bool -> Bool
|| ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayHandled
                              Bool -> Bool -> Bool
|| Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isJust Maybe RequestUI
sreqPending) -> do
         -- ignore alarm if to be handled by AI control regain code elsewhere
       -- Checking for special case for UI under AI control, because the default
       -- behaviour is in this case too alarming for the player, especially
       -- during the insert coin demo before game is started.
       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
       if Faction -> Bool
isAIFact Faction
fact then
         -- Mark for immediate control regain from AI.
         (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
True}
       else do  -- should work fine even if UI faction has no leader ATM
         -- Stop displaying the prompt, if any, but keep UI simple.
         (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 {sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayHandled}
         let msg :: Text
msg = if Maybe RequestUI -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RequestUI
sreqPending
                   then Text
"Server delayed asking us for a command. Regardless, UI is made accessible. Press ESC twice to listen to server some more."
                   else Text
"Server delayed receiving a command from us. The command is cancelled. Issue a new one."
         MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
msg
         Maybe RequestUI
mreqNew <- m (Maybe RequestUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe RequestUI)
queryUI
         -- TODO: once this is really used, verify that if a request
         -- overwritten, nothing breaks due to some things in our ClientState
         -- and SessionUI (but fortunately not in State nor ServerState)
         -- already set as if it was performed.
         (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 {sreqPending :: Maybe RequestUI
sreqPending = Maybe RequestUI
mreqNew}
         -- Now relax completely.
         (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 {sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayNot}
         -- We may yet not know if server is ready, but perhaps server
         -- tried hard to contact us while we took control and now it sleeps
         -- for a bit, so let's give it the benefit of the doubt
         -- and a slight pause before we alarm the player again.
       POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
     | Bool
otherwise -> do
       -- We know server is not ready.
       (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 {sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayAlarm}
       -- We take a slight pause during which we display encouragement
       -- to press a key and we receive game state changes.
       -- The pause is cut short by any keypress, so it does not
       -- make UI reaction any less snappy (animations do, but that's fine).
       POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
 MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0