generate full arena

This commit is contained in:
nek0 2023-12-07 17:31:28 +01:00
parent d92763fe09
commit 8aeef3505b
3 changed files with 49 additions and 16 deletions

View file

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

View file

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

View file

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