mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove all but the largest region in caves

Browse source 
When generating cave levels, remove all but the largest contiguous
region from the resulting level.
This commit is contained in:
Griffin Smith 2019-09-15 17:00:27 -04:00
parent 2604341c2f
commit 15895c69fe
2 changed files with 12 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
src/Xanthous/Generators/CaveAutomata.hs
View file

@ -99,6 +99,9 @@ generate' params dims = do
when (steps' > 0)
$ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params
lift $ fillOuterEdgesM cells
-- Remove all but the largest contiguous region of unfilled space
(_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells
lift $ fillAllM (fold smallerRegions) cells
pure cells
stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s ()

11
src/Xanthous/Generators/Util.hs
View file

@ -11,15 +11,17 @@ module Xanthous.Generators.Util
, cloneMArray
, floodFill
, regions
, fillAll
, fillAllM
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude hiding (Foldable, toList)
import Xanthous.Prelude hiding (Foldable, toList, for_)
import Data.Array.ST
import Data.Array.Unboxed
import Control.Monad.ST
import Control.Monad.Random
import Data.Monoid
import Data.Foldable (Foldable, toList)
import Data.Foldable (Foldable, toList, for_)
--------------------------------------------------------------------------------
import Xanthous.Util (foldlMapM')
import Xanthous.Data (Dimensions, width, height)
@ -177,5 +179,8 @@ regions arr
findFirstPoint :: a (i, j) Bool -> Maybe (i, j)
findFirstPoint = fmap fst . headMay . filter snd . assocs
fillAll :: Foldable f => f (i, j) -> a (i, j) Bool -> a (i, j) Bool
fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool
fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes
fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m ()
fillAllM ixes a = for_ ixes $ \i -> writeArray a i False