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

module Server.Map where

import Control.Monad (foldM)

import qualified Data.Matrix as M

import qualified Data.Vector as V

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
        _otherTiles -> 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)
      wallRow  = M.rowVector $ V.replicate (mapRows + 2) Wall
      wallCol  = M.colVector $ V.replicate mapColumns Wall
  builtMap <- divide 0 0 mapRows mapColumns initMap
  pure $ wallRow M.<-> (wallCol M.<|> builtMap M.<|> wallCol) M.<-> wallRow
  where
    divide :: Int -> Int -> Int -> Int -> ServerMap -> IO ServerMap
    divide rowOffset colOffset rowSize colSize tilemap
      | rowSize <= 4 || colSize <= 4 = pure tilemap
      | otherwise                    = do
        -- position wall intersection at random
        crossRow <- randomRIO (2, rowSize - 2)
        crossCol <- randomRIO (2, colSize - 2)

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

            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