start with buggy arena generation

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

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

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])
+      )
+  )

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