{-# 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 = do
side <- getsClient sside
debugPossiblyPrint $ "AI client" <+> tshow side <+> "initializing."
initUI :: (MonadClient m, MonadClientUI m) => CCUI -> m ()
initUI sccui@CCUI{coscreen} = do
side <- getsClient sside
soptions <- getsClient soptions
debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing."
schanF <- chanFrontend coscreen soptions
modifySession $ \sess -> sess {schanF, sccui}
loopCli :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> CCUI -> UIOptions -> ClientOptions -> m ()
loopCli ccui sUIOptions soptions = do
modifyClient $ \cli -> cli {soptions}
hasUI <- clientHasUI
if not hasUI then initAI else initUI ccui
restoredG <- tryRestore
restored <- case restoredG of
Just (cli, msess) | not $ snewGameCli soptions -> do
schanF <- getsSession schanF
sccui <- getsSession sccui
maybe (return ()) (\sess -> modifySession $ const
sess {schanF, sccui, sUIOptions}) msess
putClient cli {soptions}
return True
Just (_, msessR) -> do
maybe (return ()) (\sessR -> modifySession $ \sess ->
sess {shistory = shistory sessR}) msessR
return False
_ -> return False
tabA <- createTabBFS
tabB <- createTabBFS
modifyClient $ \cli -> cli {stabs = (tabA, tabB)}
side <- getsClient sside
cmd1 <- receiveResponse
case (restored, cmd1) of
(True, RespUpdAtomic _ UpdResume{}) -> return ()
(True, RespUpdAtomic _ UpdRestart{}) ->
when hasUI $
promptAdd "Ignoring an old savefile and starting a new game."
(False, RespUpdAtomic _ UpdResume{}) ->
error $ "Savefile of client " ++ show side ++ " not usable."
`showFailure` ()
(False, RespUpdAtomic _ UpdRestart{}) -> return ()
(True, RespUpdAtomicNoState UpdResume{}) -> undefined
(True, RespUpdAtomicNoState UpdRestart{}) ->
when hasUI $
promptAdd "Ignoring an old savefile and starting a new game."
(False, RespUpdAtomicNoState UpdResume{}) ->
error $ "Savefile of client " ++ show side ++ " not usable."
`showFailure` ()
(False, RespUpdAtomicNoState UpdRestart{}) -> return ()
_ -> error $ "unexpected command" `showFailure` (side, restored, cmd1)
handleResponse cmd1
let cliendKindText = if not hasUI then "AI" else "UI"
debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "started."
loop
debugPossiblyPrint $ cliendKindText <+> "client" <+> tshow side <+> "stopped."
where
loop = do
cmd <- receiveResponse
handleResponse cmd
quit <- getsClient squit
unless quit loop