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

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
      }
    )