2023-12-20 07:12:22 +00:00
|
|
|
module Client.Game where
|
|
|
|
|
2023-12-20 08:04:50 +00:00
|
|
|
import Control.Concurrent
|
|
|
|
|
2023-12-20 07:12:22 +00:00
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
|
2023-12-20 08:04:50 +00:00
|
|
|
import Control.Monad
|
|
|
|
|
2023-12-20 07:12:22 +00:00
|
|
|
import Control.Monad.Loops
|
|
|
|
|
|
|
|
import Control.Monad.RWS
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Client.Communication
|
|
|
|
import Client.Types
|
|
|
|
|
|
|
|
import Library.Types
|
|
|
|
|
|
|
|
runGame :: Game ()
|
|
|
|
runGame = do
|
2023-12-20 08:04:50 +00:00
|
|
|
sock <- asks rcSocket
|
|
|
|
queue <- asks rcQueue
|
2023-12-23 10:38:57 +00:00
|
|
|
clientId <- asks rcClientUUID
|
2023-12-20 08:04:50 +00:00
|
|
|
recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue
|
2023-12-23 10:38:57 +00:00
|
|
|
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
|
2023-12-20 07:12:22 +00:00
|
|
|
whileM_
|
|
|
|
(not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
|
|
|
|
(do
|
2023-12-20 08:04:50 +00:00
|
|
|
handleMessages
|
2023-12-20 07:12:22 +00:00
|
|
|
)
|
2023-12-20 08:04:50 +00:00
|
|
|
liftIO $ killThread recvThread
|