86 lines
2.2 KiB
Haskell
86 lines
2.2 KiB
Haskell
module Server.Game where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
|
|
import Control.Monad.RWS.Strict
|
|
|
|
import Control.Monad.Loops
|
|
|
|
import Data.Time
|
|
|
|
-- internal imports
|
|
|
|
import Library.Types
|
|
|
|
import Server.Types
|
|
|
|
runGame :: Game
|
|
runGame = do
|
|
whileM_
|
|
(not . serverStop <$> gets scServerState)
|
|
(do
|
|
before <- gets scServerLastTick
|
|
now <- liftIO getCurrentTime
|
|
let delta = realToFrac $ diffUTCTime now before
|
|
updateSpawners delta
|
|
updateWizards delta
|
|
fps <- asks rcFPS
|
|
let remainingTime = recip (fromIntegral fps) - delta
|
|
when (remainingTime > 0) $
|
|
liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
|
|
)
|
|
|
|
updateSpawners :: Float -> Game
|
|
updateSpawners dt =
|
|
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 =
|
|
modify' (\sc@(StateContainer _ wizards _ _) ->
|
|
let newWizards = map
|
|
(\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 wizard
|
|
{ wizardEffects = newEffects
|
|
, wizardHealth = health - effectDamage
|
|
}
|
|
)
|
|
wizards
|
|
in sc
|
|
{ scPlayers = newWizards
|
|
}
|
|
)
|