52 lines
1.2 KiB
Haskell
52 lines
1.2 KiB
Haskell
{-# 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)
|