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

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