From 554f483cd9361ed809b84ff288545e3f973132d5 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 9 Dec 2023 02:49:19 +0100 Subject: [PATCH] make configuration and move things around --- configuration.yaml | 5 +++ src-server/Main.hs | 78 +---------------------------------- src-server/Server/Game.hs | 86 +++++++++++++++++++++++++++++++++++++++ wizard-wipeout.cabal | 3 +- 4 files changed, 95 insertions(+), 77 deletions(-) create mode 100644 configuration.yaml create mode 100644 src-server/Server/Game.hs diff --git a/configuration.yaml b/configuration.yaml new file mode 100644 index 0000000..db0271a --- /dev/null +++ b/configuration.yaml @@ -0,0 +1,5 @@ +setSocketPath : "/run/wizard.sock" +setMapRows : 40 +setMapColumns : 40 +setSpawnerProbability : 0.01 +setFPS : 30 diff --git a/src-server/Main.hs b/src-server/Main.hs index f76766e..43da76f 100644 --- a/src-server/Main.hs +++ b/src-server/Main.hs @@ -2,10 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Concurrent (threadDelay) - -import Control.Monad.Loops - import Control.Monad.RWS.Strict import qualified Data.ByteString.Char8 as B8 @@ -22,8 +18,9 @@ import Options.Applicative import Library.Types -import Server.Types +import Server.Game import Server.Map (generateArena) +import Server.Types main :: IO () main = do @@ -53,74 +50,3 @@ main = do <> progDesc "Run the \"wizard-wipeout\" Server." <> header "wizard-wipeout - Last Mage standing" ) - -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 - } - ) diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs new file mode 100644 index 0000000..68a924b --- /dev/null +++ b/src-server/Server/Game.hs @@ -0,0 +1,86 @@ +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 + } + ) diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 747dda4..5c43b6e 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -44,7 +44,8 @@ executable wizard-wipeout-client executable wizard-wipeout-server import: warnings main-is: Main.hs - other-modules: Server.Map + other-modules: Server.Game + Server.Map Server.Types -- other-extensions: build-depends: base ^>=4.17.2.1