108 lines
3.8 KiB
Haskell
108 lines
3.8 KiB
Haskell
module Server.Map where
|
|
|
|
import Control.Monad (foldM)
|
|
|
|
import qualified Data.Matrix as M
|
|
|
|
import qualified Data.Vector as V
|
|
|
|
import Linear
|
|
|
|
import System.Random
|
|
|
|
import Library.Types
|
|
|
|
-- | This function procedurally generates the Arena for the game
|
|
generateArena
|
|
:: 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 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
|
|
SpawnerFull
|
|
0
|
|
(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 height
|
|
-> Int -- ^ Map's width
|
|
-> IO ServerMap -- ^ resulting Map
|
|
generateMap mapRows mapColumns = do
|
|
let initMap = M.matrix mapRows mapColumns (const Air)
|
|
wallRow = M.rowVector $ V.replicate (mapRows + 2) Wall
|
|
wallCol = M.colVector $ V.replicate mapColumns Wall
|
|
builtMap <- divide 0 0 mapRows mapColumns initMap
|
|
pure $ wallRow M.<-> (wallCol M.<|> builtMap M.<|> wallCol) M.<-> wallRow
|
|
where
|
|
divide :: Int -> Int -> Int -> Int -> ServerMap -> IO ServerMap
|
|
divide rowOffset colOffset rowSize colSize tilemap
|
|
| rowSize <= 3 || colSize <= 3 = pure tilemap
|
|
| otherwise = do
|
|
-- position wall intersection at random
|
|
crossRow <- randomRIO (2, rowSize - 1)
|
|
crossCol <- randomRIO (2, colSize - 1)
|
|
|
|
-- position wall passages at random wall tiles
|
|
rowHole1 <- randomRIO (1, crossRow - 1)
|
|
rowHole2 <- randomRIO (crossRow + 1, rowSize - 1)
|
|
colHole1 <- randomRIO (1, crossCol - 1)
|
|
colHole2 <- randomRIO (crossCol + 1, colSize - 1)
|
|
|
|
-- determine all possible passages
|
|
let allHoles =
|
|
[ (rowHole1, crossCol)
|
|
, (rowHole2, crossCol)
|
|
, (crossRow, colHole1)
|
|
, (crossRow, colHole2)
|
|
]
|
|
|
|
-- drop one of the passages randomly
|
|
randomDropIndex <- randomRIO (0, length allHoles - 1)
|
|
let randomDrop = allHoles !! randomDropIndex
|
|
holes = filter (/= randomDrop) allHoles
|
|
|
|
crossedMap = M.mapPos
|
|
(\(r, c) tile ->
|
|
if (r - rowOffset == crossRow && c - colOffset > 0 && c - colOffset <= colSize) ||
|
|
(c - colOffset == crossCol && r - rowOffset > 0 && r - rowOffset <= rowSize)
|
|
then if (r - rowOffset, c - colOffset) `elem` holes
|
|
then Air
|
|
else Wall
|
|
else tile
|
|
)
|
|
tilemap
|
|
|
|
divide rowOffset colOffset (crossRow - 1) (crossCol - 1) =<<
|
|
divide rowOffset (colOffset + crossCol + 1) (crossRow - 1) (colSize - crossCol - 1) =<<
|
|
divide (rowOffset + crossRow + 1) colOffset (rowSize - crossRow - 1) (crossCol - 1) =<<
|
|
divide
|
|
(rowOffset + crossRow + 1)
|
|
(colOffset + crossCol + 1)
|
|
(rowSize - crossRow - 1)
|
|
(colSize - crossCol - 1)
|
|
crossedMap
|