{-# 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.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.Common.ClientOptions
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 clientOptions :: 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
$ \cli :: 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 "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 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 (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
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 ()) (\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
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 (_, 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
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 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
$ \cli :: 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
<+> "client"
Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side Text -> Text -> Text
<+> "started 3/4."
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 ()
clientPrintUI "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 ()
clientPrintUI "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
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 4/4."
m ()
loop
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
<+> "client" Text -> Text -> Text
<+> FactionId -> Text
forall a. Show a => a -> Text
tshow FactionId
side2
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
<> ") 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