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

module Server.Game.Update where

import qualified Control.Concurrent.STM as STM

import Control.Monad

import Control.Monad.Reader

import Control.Monad.State

-- internal imports

import Library.Types

import Server.Types

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 = do
  playersVar <- gets scPlayers
  players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
  let newPlayers = map
        (\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness lastPong) ->
          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
            if readiness
            then
              player
                { playerWizard = wizard
                  { wizardEffects = newEffects
                  , wizardHealth  = health - effectDamage
                  }
                }
            else
              player
        )
        players
  void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers