wizard-wipeout/src-server/Server/Game.hs

107 lines
2.8 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
module Server.Game where
2023-12-12 02:31:57 +00:00
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.STM as STM
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 Library.Types
2023-12-10 01:02:09 +00:00
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"
2023-12-12 02:31:57 +00:00
receiveMessages
handleMessages
updateSpawners delta
updateWizards delta
sendUpdates
modify'
(\s -> s
{ scServerLastTick = now
}
)
fps <- asks rcFPS
let remainingTime = recip (fromIntegral fps) - delta
when (remainingTime > 0) $
liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
)
updateSpawners :: Float -> Game ()
updateSpawners dt =
2023-12-11 08:49:24 +00:00
modify' (\sc@(StateContainer spawners _ _ _ _ _) ->
let newSpawners = map
(\spawner -> do
let newTTL = spawnerReloadTTL spawner - dt
if newTTL < 0 && spawnerState spawner == SpawnerEmpty
then spawner
{ spawnerReloadTTL = fromIntegral $ spawnerReloadTime spawner
, spawnerState = SpawnerFull
}
else spawner
{ spawnerReloadTTL = spawnerReloadTTL spawner - dt
}
)
spawners
in sc
{ scSpawners = newSpawners
}
)
updateWizards :: Float -> Game ()
updateWizards dt = do
playersVar <- gets scPlayers
players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
let newPlayers = map
(\player@(Player pId wizard@(Wizard _ _ health _ _ effects)) ->
let newEffects = foldl
(\acc effect@(Effect _ ttl) ->
if ttl - dt < 0
then acc
else effect
{ effectTTL = ttl - dt
} : acc
)
[]
effects
effectDamage = foldl
(\acc (Effect kind _) ->
if kind `elem` harmingAfflictions
then acc + 1
else acc
)
0
effects
in player {
playerWizard = wizard
{ wizardEffects = newEffects
, wizardHealth = health - effectDamage
}
}
)
players
void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers