diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-15T21·00-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-15T21·30-0400 |
commit | 15895c69fe8f1415f45fe33f7b3d564f4239496e (patch) | |
tree | 61f3f5cf633e86f1cbdb51bce0b7c51d3b9dc6f5 /src | |
parent | 2604341c2f3c7805f88422707e8ed08e45ecfa0b (diff) |
Remove all but the largest region in caves
When generating cave levels, remove all but the largest contiguous region from the resulting level.
Diffstat (limited to 'src')
-rw-r--r-- | src/Xanthous/Generators/CaveAutomata.hs | 3 | ||||
-rw-r--r-- | src/Xanthous/Generators/Util.hs | 13 |
2 files changed, 12 insertions, 4 deletions
diff --git a/src/Xanthous/Generators/CaveAutomata.hs b/src/Xanthous/Generators/CaveAutomata.hs index fd4c68ddbe90..f1123abbd8f4 100644 --- a/src/Xanthous/Generators/CaveAutomata.hs +++ b/src/Xanthous/Generators/CaveAutomata.hs @@ -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 () diff --git a/src/Xanthous/Generators/Util.hs b/src/Xanthous/Generators/Util.hs index e399ca5d4936..8fd04c0b9326 100644 --- a/src/Xanthous/Generators/Util.hs +++ b/src/Xanthous/Generators/Util.hs @@ -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 ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes +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 |