{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.LoopM
( MonadClientReadResponse(..)
, loopCli
#ifdef EXPOSE_INTERNAL
, initAI, initUI
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.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
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Vector
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 :: MonadClientUI m => KeyKind -> UIOptions -> m ()
initUI copsClient sUIOptions = do
side <- getsClient sside
soptions <- getsClient soptions
debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing."
schanF <- chanFrontend soptions
let !sbinding = stdBinding copsClient sUIOptions
modifySession $ \sess ->
sess { schanF
, sbinding
, sxhair = TVector $ Vector 1 1 }
loopCli :: ( MonadClientSetup m
, MonadClientUI m
, MonadClientAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> KeyKind -> UIOptions -> ClientOptions -> m ()
loopCli copsClient sUIOptions soptions = do
modifyClient $ \cli -> cli {soptions}
hasUI <- clientHasUI
if not hasUI then initAI else initUI copsClient sUIOptions
cops <- getsState scops
restoredG <- tryRestore
restored <- case restoredG of
Just (cli, msess) | not $ snewGameCli soptions -> do
schanF <- getsSession schanF
sbinding <- getsSession sbinding
maybe (return ()) (\sess -> modifySession $ \_ ->
sess {schanF, sbinding, sUIOptions}) msess
putClient cli {soptions}
return True
Just (_, msessR) -> do
maybe (return ()) (\sessR -> modifySession $ \sess ->
sess {shistory = shistory sessR}) msessR
return False
_ -> return False
side <- getsClient sside
cmd1 <- receiveResponse
case (restored, cmd1) of
(True, RespUpdAtomic s UpdResume{}) -> do
let sCops = updateCOps (const cops) s
handleResponse $ RespUpdAtomic sCops $ UpdResumeServer sCops
(True, RespUpdAtomic _ UpdRestart{}) ->
when hasUI $ msgAdd "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 $ msgAdd "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
debugPossiblyPrint $ "UI client" <+> tshow side <+> "started."
loop
debugPossiblyPrint $ "UI client" <+> tshow side <+> "stopped."
where
loop = do
cmd <- receiveResponse
handleResponse cmd
quit <- getsClient squit
unless quit loop