start with buggy arena generation

This commit is contained in:
nek0 2023-12-06 06:14:12 +01:00
parent 897240ee86
commit ac0b09256f
4 changed files with 150 additions and 1 deletions

View file

@ -42,6 +42,7 @@ type Map = Matrix Tile
data Tile
= Air -- ^ walkable area
| Wall -- ^ obstacle
deriving (Show)
data ServerOptions = ServerOptions
{ serOptMapWidth :: Int -- ^ Map width

View file

@ -1,6 +1,10 @@
module Server.Map where
import qualified Data.Matrix as M
import System.Random
import Library.Types
import Server.Map.Snippets
-- | This function procedurally generates the Arena for the game
generateArena
@ -11,9 +15,59 @@ generateArena
generateArena arenaWidth arenaHeight spawnerChance = do
undefined
-- | Generate basic Map of Air and Walls
generateMap
:: Int -- ^ Map's width
-> Int -- ^ Map's height
-> IO Map -- ^ resulting Map
generateMap mapWidth mapHeight = do
undefined
let initMap = M.matrix mapWidth mapHeight (const Air)
divide 0 0 mapHeight mapWidth initMap
where
divide :: Int -> Int -> Int -> Int -> Map -> IO Map
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 holes =
[ (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 == crossCol) &&
(r - rowOffset <= rowSize || c - colOffset <= colSize)
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

View file

@ -0,0 +1,91 @@
{-# LANGUAGE LambdaCase #-}
module Server.Map.Snippets where
import qualified Data.Matrix as M
import Library.Types
catalogue :: [Map]
catalogue = convertCatalogue
[ M.fromLists
[ [ ' ', ' ' ]
, [ ' ', ' ' ]
]
, M.fromLists
[ [ ' ', ' ', ' ']
, [ ' ', ' ', ' ']
, [ ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ', ' ']
, [ ' ', ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
]
, M.fromLists
[ [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', '#', '#', ' ', ' ', ' ']
, [ ' ', ' ', ' ', '#', '#', ' ', ' ', ' ']
, [ ' ', ' ', '#', ' ', ' ', '#', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
, [ ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ']
]
]
convertCatalogue
:: [ M.Matrix Char ]
-> [ Map ]
convertCatalogue =
map
(fmap
(\case
'#' -> Wall
' ' -> Air
x -> error ("unexpected element: " ++ [x])
)
)

View file

@ -41,8 +41,11 @@ executable wizard-wipeout-server
import: warnings
main-is: Main.hs
other-modules: Server.Map
Server.Map.Snippets
-- other-extensions:
build-depends: base ^>=4.17.2.1
, matrix
, wizard-wipeout
, random
hs-source-dirs: src-server
default-language: GHC2021