{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Client.LoopM
( loopCli
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client.HandleResponseM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Response
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Vector
initAI :: MonadClient m => DebugModeCli -> m ()
initAI sdebugCli = do
modifyClient $ \cli -> cli {sdebugCli}
side <- getsClient sside
debugPossiblyPrint $ "AI client" <+> tshow side <+> "initializing."
initUI :: MonadClientUI m => KeyKind -> Config -> DebugModeCli -> m ()
initUI copsClient sconfig sdebugCli = do
modifyClient $ \cli -> cli {sdebugCli}
side <- getsClient sside
debugPossiblyPrint $ "UI client" <+> tshow side <+> "initializing."
schanF <- chanFrontend sdebugCli
let !sbinding = stdBinding copsClient sconfig
sess = emptySessionUI sconfig
putSession sess { schanF
, sbinding
, sxhair = TVector $ Vector 1 1 }
loopCli :: ( MonadClientSetup m
, MonadClientUI m
, MonadAtomic m
, MonadClientReadResponse m
, MonadClientWriteRequest m )
=> KeyKind -> Config -> DebugModeCli -> m ()
loopCli copsClient sconfig sdebugCli = do
hasUI <- clientHasUI
if not hasUI then initAI sdebugCli else initUI copsClient sconfig sdebugCli
cops <- getsState scops
restoredG <- tryRestore
restored <- case restoredG of
Just (s, cli, msess) | not $ snewGameCli sdebugCli -> do
let sCops = updateCOps (const cops) s
handleResponse $ RespUpdAtomic $ UpdResumeServer sCops
schanF <- getsSession schanF
sbinding <- getsSession sbinding
maybe (return ()) (\sess ->
putSession sess {schanF, sbinding, sconfig}) msess
putClient cli {sdebugCli}
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 ()
_ -> 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