wizard-wipeout/src-server/Server/Map.hs

101 lines
3.5 KiB
Haskell
Raw Normal View History

2023-12-05 04:41:16 +00:00
module Server.Map where
2023-12-07 16:31:28 +00:00
import Control.Monad (foldM)
2023-12-06 05:14:12 +00:00
import qualified Data.Matrix as M
2023-12-07 16:31:28 +00:00
import Linear
2023-12-06 05:14:12 +00:00
import System.Random
2023-12-05 04:41:16 +00:00
import Library.Types
-- | This function procedurally generates the Arena for the game
generateArena
2023-12-07 16:31:28 +00:00
:: Int -- ^ Map's height
-> Int -- ^ Map's width
-> Float -- ^ Probability for a tile to be an item spawner (between 0 and 1)
2023-12-05 04:41:16 +00:00
-> IO Arena -- ^ resulting Arena
2023-12-07 16:31:28 +00:00
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
2023-12-08 04:19:32 +00:00
SpawnerFull
0
(V2 (fromIntegral r) (fromIntegral c) + V2 0.5 0.5)
: acc
2023-12-07 16:31:28 +00:00
else
pure acc
_ -> pure acc
)
[]
((,) <$> [1 .. arenaRows] <*> map fromIntegral [1 .. arenaColumns])
pure (Arena arenaMap spawners)
2023-12-05 04:41:16 +00:00
2023-12-06 05:14:12 +00:00
-- | Generate basic Map of Air and Walls
2023-12-05 04:41:16 +00:00
generateMap
2023-12-07 16:31:28 +00:00
:: Int -- ^ Map's height
-> Int -- ^ Map's width
2023-12-07 17:20:28 +00:00
-> IO ServerMap -- ^ resulting Map
2023-12-07 16:31:28 +00:00
generateMap mapRows mapColumns = do
let initMap = M.matrix mapRows mapColumns (const Air)
divide 0 0 mapRows mapColumns initMap
2023-12-06 05:14:12 +00:00
where
2023-12-07 17:20:28 +00:00
divide :: Int -> Int -> Int -> Int -> ServerMap -> IO ServerMap
2023-12-06 05:14:12 +00:00
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
2023-12-07 11:51:35 +00:00
let allHoles =
2023-12-06 05:14:12 +00:00
[ (rowHole1, crossCol)
, (rowHole2, crossCol)
, (crossRow, colHole1)
, (crossRow, colHole2)
]
-- drop one of the passages randomly
2023-12-07 11:51:35 +00:00
randomDropIndex <- randomRIO (0, length allHoles - 1)
let randomDrop = allHoles !! randomDropIndex
holes = filter (/= randomDrop) allHoles
2023-12-06 05:14:12 +00:00
crossedMap = M.mapPos
(\(r, c) tile ->
2023-12-07 11:51:35 +00:00
if (r - rowOffset == crossRow && c - colOffset > 0 && c - colOffset <= colSize) ||
(c - colOffset == crossCol && r - rowOffset > 0 && r - rowOffset <= rowSize)
2023-12-06 05:14:12 +00:00
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