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.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
  liftIO $ putStrLn "entering game loop"
  whileM_
    (liftIO (not <$> readIORef (scStopper st)))
    (do
      liftIO $ receiveMessage sock messageQueue st
      -- liftIO $ putStrLn "received messages"
      handleMessages
      -- liftIO $ putStrLn "handled messages"
      pumpEvents vty
      -- liftIO $ putStrLn "pumped events"
      handleEvents
      -- liftIO $ putStrLn "handled events"
      draw
      -- liftIO $ putStrLn "drew"
    )
  liftIO $ do
    liftIO $ putStrLn "left game loop"
    partingMessage clientId sock
    threadDelay (10 ^ 6)