49 lines
1.1 KiB
Haskell
49 lines
1.1 KiB
Haskell
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)
|
|
|
|
-- 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 :: Int) :: Float)
|
|
)
|
|
liftIO $ threadDelay (10 ^ (6 :: Int))
|