{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.LoopM
( MonadClientReadResponse(..)
, loopCli
#ifdef EXPOSE_INTERNAL
, initAI, initUI
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.ClientOptions
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
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
$ "AI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side 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
$ "UI client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side 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
$ \sess :: 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
ccui sUIOptions :: UIOptions
sUIOptions soptions :: ClientOptions
soptions = 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
$ \cli :: StateClient
cli -> StateClient
cli {ClientOptions
soptions :: ClientOptions
soptions :: ClientOptions
soptions}
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
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 (cli :: StateClient
cli, msess :: Maybe SessionUI
msess) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientOptions -> Bool
snewGameCli ClientOptions
soptions -> 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 ()) (\sess :: 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
StateClient -> m ()
forall (m :: * -> *). MonadClient m => StateClient -> m ()
putClient StateClient
cli {ClientOptions
soptions :: ClientOptions
soptions :: ClientOptions
soptions}
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just (_, msessR :: 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 ()) (\sessR :: 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
$ \sess :: 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
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
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
$ \cli :: StateClient
cli -> StateClient
cli {stabs :: (PrimArray PointI, PrimArray PointI)
stabs = (PrimArray PointI
tabA, PrimArray PointI
tabB)}
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Response
cmd1 <- m Response
forall (m :: * -> *). MonadClientReadResponse m => m Response
receiveResponse
case (Bool
restored, Response
cmd1) of
(True, RespUpdAtomic _ UpdResume{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(True, RespUpdAtomic _ 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 ()
promptAdd "Ignoring an old savefile and starting a new game."
(False, RespUpdAtomic _ UpdResume{}) ->
[Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "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]
++ " not usable."
[Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
(False, RespUpdAtomic _ UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(True, RespUpdAtomicNoState UpdResume{}) -> m ()
forall a. HasCallStack => a
undefined
(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 ()
promptAdd "Ignoring an old savefile and starting a new game."
(False, RespUpdAtomicNoState UpdResume{}) ->
[Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "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]
++ " not usable."
[Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
(False, RespUpdAtomicNoState UpdRestart{}) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "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
let cliendKindText :: Text
cliendKindText = if Bool -> Bool
not Bool
hasUI then "AI" else "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
<+> "client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started."
m ()
loop
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
<+> "client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "stopped."
where
loop :: m ()
loop = 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 ()
loop