diff --git a/src-lib/Library/Types.hs b/src-lib/Library/Types.hs index c86a0f8..3c4fefa 100644 --- a/src-lib/Library/Types.hs +++ b/src-lib/Library/Types.hs @@ -42,6 +42,7 @@ type Map = Matrix Tile data Tile = Air -- ^ walkable area | Wall -- ^ obstacle + deriving (Show) data ServerOptions = ServerOptions { serOptMapWidth :: Int -- ^ Map width diff --git a/src-server/Server/Map.hs b/src-server/Server/Map.hs index c7e3164..152c3ca 100644 --- a/src-server/Server/Map.hs +++ b/src-server/Server/Map.hs @@ -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 diff --git a/src-server/Server/Map/Snippets.hs b/src-server/Server/Map/Snippets.hs new file mode 100644 index 0000000..cfe871c --- /dev/null +++ b/src-server/Server/Map/Snippets.hs @@ -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]) + ) + ) diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 346606a..87342cc 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -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