wizard-wipeout/src-server/Server/Game.hs
2024-05-01 23:52:49 +02:00

54 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
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