{-# 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.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
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 _ UpdResume{}) -> return ()
(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