start creating amin server loop

src-lib/Library/Types.hs

@@ -19,7 +19,7 @@ data Wizard = Wizard
     -- ^ Player's Mana (magic fuel)
   , wizardWands  :: [Wand]
     -- ^ Player's wands (read: weapons)
-  , wizardEffect :: [Effect]
+  , wizardEffects :: [Effect]
     -- ^ 'Effect's affecting the player
   }
   deriving (Show, Eq)
@@ -49,12 +49,6 @@ data Tile
   | Wall -- ^ obstacle
   deriving (Show, Eq)
 
-data ServerOptions = ServerOptions
-  { serOptMapWidth  :: Int -- ^ Map width
-  , serOptMapHeight :: Int -- ^ Map height
-  }
-  deriving (Show, Eq)
-
 data Arena = Arena
   { arenaMap      :: ServerMap
   , arenaSpawners :: [Spawner]
@@ -97,3 +91,9 @@ data Affliction
   | Frozen   -- ^ Unable to perform any action
   | Shielded -- ^ invulnerable until next hit or time runs out.
   deriving (Show, Eq)
+
+harmingAfflictions :: [ Affliction ]
+harmingAfflictions =
+  [ Burning
+  , Frozen
+  ]

src-server/Main.hs

@@ -1,4 +1,126 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# 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
+
+import Data.String (fromString)
+
+import Data.Time
+
+import Data.Yaml
+
+import Options.Applicative
+
+-- internal imports
+
+import Library.Types
+
+import Server.Types
+import Server.Map (generateArena)
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  putStrLn "Hello, Wizards!"
+  (Options optSettingLoc) <- execParser opts
+  raw <- B8.readFile optSettingLoc
+  case decodeEither' raw of
+    Left msg -> 
+      error (optSettingLoc <> ":" <>
+        " error: " <>
+        fromString (prettyPrintParseException msg)
+        )
+    Right (Settings {..}) -> do
+      arena <- generateArena setMapRows setMapColumns setSpawnerProbability
+      putStrLn "generated arena:"
+      print (arenaMap arena)
+      putStrLn "-----------------------------------------------------------------------------------"
+      putStrLn "starting game…"
+      now <- getCurrentTime
+      let initRead  = ReaderContainer (arenaMap arena) setFPS
+          initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
+      (finalState, finalWrite) <- execRWST runGame initRead initState
+      print finalWrite
+  where
+    opts = info (options <**> helper)
+      ( fullDesc
+        <> 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/Map.hs

@@ -30,7 +30,10 @@ generateArena arenaRows arenaColumns spawnerChance = do
               Spawner
                 (wands !! randomWandIndex)
                 randomReloadTime
-                (V2 (fromIntegral r) (fromIntegral c) + V2 0.5 0.5) : acc
+                SpawnerFull
+                0
+                (V2 (fromIntegral r) (fromIntegral c) + V2 0.5 0.5)
+                : acc
           else
             pure acc
         _   -> pure acc

src-server/Server/Types.hs

@@ -1,19 +1,53 @@
 {-# LANGUAGE DeriveGeneric #-}
-module Server.Options where
+module Server.Types where
+
+import Control.Monad.RWS.Strict
 
 import qualified Data.Aeson as Aeson
+
+import Data.Time.Clock
+
 import GHC.Generics
 
+import Options.Applicative as O
+
+import Library.Types
+
 data Settings = Settings
   { setSocketPath         :: FilePath
   , setMapRows            :: Int
   , setMapColumns         :: Int
   , setSpawnerProbability :: Float
+  , setFPS                :: Int
   }
   deriving (Show, Generic)
 
 instance Aeson.FromJSON Settings
 
-data Options = Options
+newtype Options = Options
   { optConfLoc :: FilePath
   }
+
+options :: O.Parser Options
+options = Options
+  <$> strOption
+    ( long "configuration"
+    <> short 'c'
+    <> metavar "FILEPATH"
+    <> help "Location of the configuration YAML-file"
+    )
+
+data ReaderContainer = ReaderContainer
+  { rcMap :: ServerMap
+  , rcFPS :: Int
+  }
+  deriving (Eq, Show)
+
+data StateContainer = StateContainer
+  { scSpawners       :: [ Spawner ]
+  , scPlayers        :: [ Wizard ]
+  , scServerState    :: ServerState
+  , scServerLastTick :: UTCTime
+  }
+
+type Game = RWST ReaderContainer String StateContainer IO ()

wizard-wipeout.cabal

@@ -33,7 +33,10 @@ executable wizard-wipeout-client
     -- other-modules:
     -- other-extensions:
     build-depends:    base ^>=4.17.2.1
+                    , monad-loops
+                    , mtl
                     , network
+                    , vty
                     , wizard-wipeout
     hs-source-dirs:   src-client
     default-language: GHC2021
@@ -42,14 +45,21 @@ executable wizard-wipeout-server
     import:           warnings
     main-is:          Main.hs
     other-modules:    Server.Map
-                      Server.Map.Snippets
                       Server.Types
     -- other-extensions:
     build-depends:    base ^>=4.17.2.1
+                    , aeson
+                    , bytestring
                     , linear
                     , matrix
+                    , monad-loops
+                    , mtl
                     , network
+                    , optparse-applicative
+                    , text
+                    , time
                     , random
                     , wizard-wipeout
+                    , yaml
     hs-source-dirs:   src-server
     default-language: GHC2021