make configuration and move things around

This commit is contained in:
nek0 2023-12-09 02:49:19 +01:00
parent 7516364193
commit 554f483cd9
4 changed files with 95 additions and 77 deletions

5
configuration.yaml Normal file
View file

@ -0,0 +1,5 @@
setSocketPath : "/run/wizard.sock"
setMapRows : 40
setMapColumns : 40
setSpawnerProbability : 0.01
setFPS : 30

View file

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

86
src-server/Server/Game.hs Normal file
View file

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

View file

@ -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