module Game.LambdaHack.Client.LoopAction (loopAI, loopUI) where
import Control.Monad
import qualified Data.Text as T
import Game.LambdaHack.Client.Action
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.AtomicCmd
import Game.LambdaHack.Common.ClientCmd
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.State
import Game.LambdaHack.Utils.Assert
initCli :: MonadClient m => (State -> m ()) -> m (Either Msg Msg)
initCli putSt = do
cops <- getsState scops
restored <- restoreGame
case restored of
Left (s, cli, msg) -> do
let sCops = updateCOps (const cops) s
putSt sCops
putClient cli
return $ Left msg
Right msg ->
return $ Right msg
loopAI :: (MonadConnClient CmdClientAI m)
=> (CmdClientAI -> m ()) -> m ()
loopAI cmdClientAISem = do
side <- getsClient sside
ConnServer{readConnServer} <- getConn
msg <- initCli $ \s -> cmdClientAISem $ CmdAtomicAI $ ResumeServerA s
cmd1 <- readConnServer
case (msg, cmd1) of
(Left _, CmdAtomicAI ResumeA{}) -> return ()
(Left _, CmdAtomicAI RestartA{}) -> return ()
(Right msg1, CmdAtomicAI ResumeA{}) ->
error $ T.unpack $ "Savefile of client " <> showT side <> " not usable. Can't join the party. Please remove all savefiles manually and restart. Savefile subsystem said: " <> msg1
(Right _, CmdAtomicAI RestartA{}) -> return ()
_ -> assert `failure` (side, msg, cmd1)
cmdClientAISem cmd1
debugPrint $ "AI client" <+> showT side <+> "started."
loop
debugPrint $ "AI client" <+> showT side <+> "stopped."
where
loop = do
ConnServer{readConnServer} <- getConn
cmd <- readConnServer
cmdClientAISem cmd
quit <- getsClient squit
unless quit loop
loopUI :: (MonadClientUI m, MonadConnClient CmdClientUI m)
=> (CmdClientUI -> m ()) -> m ()
loopUI cmdClientUISem = do
side <- getsClient sside
ConnServer{readConnServer} <- getConn
msg <- initCli $ \s -> cmdClientUISem $ CmdAtomicUI $ ResumeServerA s
cmd1 <- readConnServer
case (msg, cmd1) of
(Left msg1, CmdAtomicUI ResumeA{}) -> do
cmdClientUISem cmd1
msgAdd msg1
(Left _, CmdAtomicUI RestartA{}) -> do
cmdClientUISem cmd1
msgAdd "Starting a new game (and ignoring an old client savefile)."
(Right msg1, CmdAtomicUI ResumeA{}) ->
error $ T.unpack $ "Savefile of client " <> showT side <> " not usable. Can't join the party. Please remove all savefiles manually and restart. Savefile subsystem said: " <> msg1
(Right msg1, CmdAtomicUI RestartA{}) -> do
cmdClientUISem cmd1
msgAdd msg1
_ -> assert `failure` (side, msg, cmd1)
debugPrint $ "UI client" <+> showT side <+> "started."
loop
debugPrint $ "UI client" <+> showT side <+> "stopped."
where
loop = do
ConnServer{readConnServer} <- getConn
cmd <- readConnServer
cmdClientUISem cmd
quit <- getsClient squit
unless quit loop