{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.LoopM
( MonadClientReadResponse(..)
, loopCli
#ifdef EXPOSE_INTERNAL
, 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
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."
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}
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."
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
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
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."
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
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
longestDelay :: POSIXTime
longestDelay :: POSIXTime
longestDelay = Pico -> POSIXTime
secondsToNominalDiffTime Pico
1
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
Bool -> Bool -> Bool
&&
(ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayNot
Bool -> Bool -> Bool
|| Bool
sregainControl
Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
keyPressed
Bool -> Bool -> Bool
&& ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
/= ReqDelay
ReqDelayHandled)) -> do
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
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
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."
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
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
(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
(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
(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}
(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}
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0
| Bool
otherwise -> 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 {sreqDelay :: ReqDelay
sreqDelay = ReqDelay
ReqDelayAlarm}
POSIXTime -> m ()
forall (m :: * -> *).
(MonadClientSetup m, MonadClientUI m, MonadClientAtomic m,
MonadClientReadResponse m, MonadClientWriteRequest m) =>
POSIXTime -> m ()
loopUI POSIXTime
0