wizard-wipeout/src-server/Server/Game.hs
Amedeo Molnár 73adfff54c tidbits
2024-11-29 11:24:07 +01:00

51 lines
1.2 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)
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 :: Int) :: Float)
)
liftIO $ threadDelay (10 ^ (6 :: Int))