{-# 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 sendUpdates 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) -- liftIO $ killThread recvThread