wizard-wipeout/src-client/Client/Game.hs

38 lines
841 B
Haskell

module Client.Game where
import Control.Concurrent.STM (atomically, readTMVar)
import Control.Monad.Loops
import Control.Monad.RWS
import Data.IORef (readIORef)
-- internal imports
import Client.Communication
import Client.Events
import Client.Graphics
import Client.Types
import Library.Types
runGame
:: Game ()
runGame = do
sock <- asks rcSocket
messageQueue <- asks rcMessageQueue
clientId <- asks rcClientUUID
st <- get
vty <- clientVty <$> liftIO (atomically $ readTMVar (scClientState st))
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
whileM_
(liftIO (not <$> readIORef (scStopper st)))
(do
liftIO $ receiveMessage sock messageQueue st
handleMessages
pumpEvents vty
handleEvents
draw
)
liftIO $ sendMessage (ClientMessage clientId ClientQuit) sock