module Server.Map where import Control.Monad (foldM) import qualified Data.Matrix as M 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) divide 0 0 mapRows mapColumns initMap 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