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

module Client.Game where

import Control.Concurrent (threadDelay)

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.Log (logPrint)
import Client.Types

import Library.Types

runGame 
  :: Game ()
runGame = do
  sock <- asks rcSocket
  messageQueue <- asks rcMessageQueue
  clientId <- asks rcClientUUID
  curLevel <- asks rcLogLevel
  st <- get
  vty <- clientVty <$> liftIO (atomically $ readTMVar (scClientState st))
  liftIO $ sendMessage curLevel (ClientMessage clientId ClientReady) sock
  logPrint Info "entering game loop"
  whileM_
    (liftIO (not <$> readIORef (scStopper st)))
    (do
      liftIO $ receiveMessage curLevel sock messageQueue st
      logPrint Verbose "received messages"
      handleMessages
      logPrint Verbose "handled messages"
      pumpEvents vty
      logPrint Verbose "pumped events"
      handleEvents
      logPrint Verbose "handled events"
      draw
      logPrint Verbose "drew"
    )
  logPrint Info "left game loop"
  liftIO $ do
    partingMessage curLevel clientId sock
    threadDelay (10 ^ (6 :: Int))