make configuration and move things around

configuration.yaml

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

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

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

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