wizard-wipeout/src-server/Server/Game.hs

{-# LANGUAGE OverloadedStrings #-}
module Server.Game where

import Control.Concurrent

import qualified Control.Concurrent.STM as STM

import Control.Monad

import Control.Monad.RWS.Strict

import Control.Monad.Loops

import qualified Data.ByteString.Char8 as B8

import Data.Time

import Data.String (fromString)

import System.IO (stdout)

-- internal imports

import Server.Game.Update
import Server.Communication
import Server.Types

runGame :: Game ()
runGame = do
  processRequests
  whileM_
    (not . serverStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scServerState))
    (do
      before <- gets scServerLastTick
      now <- liftIO getCurrentTime
      let delta = realToFrac $ diffUTCTime now before
      -- liftIO $ B8.hPutStr stdout $ "tick: " <> fromString (show delta) <> "  \r"
      handleMessages
      -- updateSpawners delta
      -- updateWizards delta
      -- modify'
      --   (\s -> s
      --     { scServerLastTick = now
      --     }
      --   )
      fps <- asks rcFPS
      sendPings
      let remainingTime = recip (fromIntegral fps) - delta
      when (remainingTime > 0) $
        liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
    )
  liftIO $ threadDelay (10 ^ 6)