generate full arena

src-lib/Library/Types.hs

@@ -1,8 +1,8 @@
 module Library.Types where
 
 import Data.Matrix
-import Linear
 import Graphics.Vty
+import Linear
 
 -- | Just a type synonym for any kind of position. Translates to a 2D vector
 type Position = V2 Float
@@ -22,6 +22,7 @@ data Wizard = Wizard
   , wizardEffect :: [Effect]
     -- ^ 'Effect's affecting the player
   }
+  deriving (Show, Eq)
 
 -- | Data object for storing the client's state
 data ClientState = ClientState
@@ -35,6 +36,7 @@ data ServerState = ServerState
   { serverGameOver :: Bool -- ^ global game over state (only one contestant left)
   , serverStop     :: Bool -- ^ Server shutdown
   }
+  deriving (Show, Eq)
 
 -- | Type synonym for the Map. Translates to a Matrix of 'Tile's
 type Map = Matrix Tile
@@ -42,39 +44,45 @@ type Map = Matrix Tile
 data Tile
   = Air  -- ^ walkable area
   | Wall -- ^ obstacle
-  deriving (Show)
+  deriving (Show, Eq)
 
 data ServerOptions = ServerOptions
   { serOptMapWidth  :: Int -- ^ Map width
   , serOptMapHeight :: Int -- ^ Map height
   }
+  deriving (Show, Eq)
 
 data Arena = Arena
   { arenaMap      :: Map
   , arenaSpawners :: [Spawner]
   }
+  deriving (Show, Eq)
 
 data Spawner = Spawner
   { spawnerPowerup    :: Wand -- ^ Which 'Powerup' is being spawned
   , spawnerReloadTime :: Int     -- ^ How long does it take for the 'Powerup' to reappear
   , spawnerPosition   :: Position -- ^ Position of the `Spawner` on the map
   }
+  deriving (Show, Eq)
 
 -- List of all available Wands
 data Wand
   = HealthUp  -- ^ Instant Health boost
   | ManaUp    -- ^ Instant Mana boost
-  | Shield    -- ^ Magical sield protecting the player
+  | Shield    -- ^ Magical shield protecting the player
   | BigWand   -- ^ Stronger Zap spell
   | FireWand  -- ^ Spell for causing fire damage
   | IceWand   -- ^ Spell for causing ice damage
   | BlinkWand -- ^ Spell for random teleport
+  deriving (Show, Eq, Enum, Bounded)
 
 data Effect = Effect
   { effectType :: Affliction -- ^ What is happening
   , effectTTL  :: Float      -- ^ remaining time
   }
+  deriving (Show, Eq)
 
 data Affliction
   = Burning -- ^ Damage over time
   | Frozen  -- ^ Unable to perform any action
+  deriving (Show, Eq)

src-server/Server/Map.hs

@@ -1,28 +1,52 @@
 module Server.Map where
 
+import Control.Monad (foldM)
 import qualified Data.Matrix as M
+import Linear
 import System.Random
 
 import Library.Types
-import Server.Map.Snippets
 
 -- | This function procedurally generates the Arena for the game
 generateArena
-  :: Int   -- ^ Map's width
-  -> Int   -- ^ Map's height
-  -> Float -- ^ Probability for a tile to be an item spawner
+  :: Int   -- ^ Map's height
+  -> Int   -- ^ Map's width
+  -> Float -- ^ Probability for a tile to be an item spawner (between 0 and 1)
   -> IO Arena -- ^ resulting Arena
-generateArena arenaWidth arenaHeight spawnerChance = do
-  undefined
+generateArena arenaRows arenaColumns spawnerChance = do
+  arenaMap <- generateMap arenaRows arenaColumns
+  spawners <- foldM
+    (\acc tileCoord@(r, c) -> do
+      let tile = arenaMap M.! tileCoord
+      case tile of
+        Air -> do
+          dieThrow <- randomIO
+          if dieThrow < spawnerChance
+          then do
+            let wands = [minBound .. maxBound]
+            randomWandIndex <- randomRIO (0, length wands - 1)
+            randomReloadTime <- randomRIO (5, 60)
+            pure $
+              Spawner
+                (wands !! randomWandIndex)
+                randomReloadTime
+                (V2 (fromIntegral r) (fromIntegral c) + V2 0.5 0.5) : acc
+          else
+            pure acc
+        _   -> pure acc
+    )
+    []
+    ((,) <$> [1 .. arenaRows] <*> map fromIntegral [1 .. arenaColumns])
+  pure (Arena arenaMap spawners)
 
 -- | Generate basic Map of Air and Walls
 generateMap
-  :: Int    -- ^ Map's width
-  -> Int    -- ^ Map's height
+  :: Int    -- ^ Map's height
+  -> Int    -- ^ Map's width
   -> IO Map -- ^ resulting Map
-generateMap mapWidth mapHeight = do
-  let initMap = M.matrix mapHeight mapWidth (const Air)
-  divide 0 0 mapHeight mapWidth initMap
+generateMap mapRows mapColumns = do
+  let initMap = M.matrix mapRows mapColumns (const Air)
+  divide 0 0 mapRows mapColumns initMap
   where
     divide :: Int -> Int -> Int -> Int -> Map -> IO Map
     divide rowOffset colOffset rowSize colSize tilemap

wizard-wipeout.cabal

@@ -22,7 +22,7 @@ library
     build-depends:    base ^>=4.17.2.1
                     , linear
                     , matrix
-                    -- , vty-crossplatform
+                    , random
                     , vty
     hs-source-dirs:   src-lib
     default-language: GHC2021
@@ -44,8 +44,9 @@ executable wizard-wipeout-server
                       Server.Map.Snippets
     -- other-extensions:
     build-depends:    base ^>=4.17.2.1
+                    , linear
                     , matrix
-                    , wizard-wipeout
                     , random
+                    , wizard-wipeout
     hs-source-dirs:   src-server
     default-language: GHC2021