bf9b09bd8c
This algorithm is a little rough around the edges right now, but generally the idea is we find a relatively closed-off region of the map, and place rooms randomly on it, expanding them until they run into each other, then we put doors in the walls of the rooms and a single door opening into the region. Later on, we'll generate friendly (or unfriendly!) NPCs to put in those rooms. Change-Id: Ic989b9905f55ad92a01fdf6db11aa57afb4ce383 Reviewed-on: https://cl.tvl.fyi/c/depot/+/726 Reviewed-by: glittershark <grfn@gws.fyi>
111 lines
3.7 KiB
Haskell
111 lines
3.7 KiB
Haskell
{-# LANGUAGE MultiWayIf #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
--------------------------------------------------------------------------------
|
|
module Xanthous.Generators.CaveAutomata
|
|
( Params(..)
|
|
, defaultParams
|
|
, parseParams
|
|
, generate
|
|
) where
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Prelude
|
|
import Control.Monad.Random (RandomGen, runRandT)
|
|
import Data.Array.ST
|
|
import Data.Array.Unboxed
|
|
import qualified Options.Applicative as Opt
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Util (between)
|
|
import Xanthous.Util.Optparse
|
|
import Xanthous.Data (Dimensions, width, height)
|
|
import Xanthous.Generators.Util
|
|
--------------------------------------------------------------------------------
|
|
|
|
data Params = Params
|
|
{ _aliveStartChance :: Double
|
|
, _birthLimit :: Word
|
|
, _deathLimit :: Word
|
|
, _steps :: Word
|
|
}
|
|
deriving stock (Show, Eq, Generic)
|
|
makeLenses ''Params
|
|
|
|
defaultParams :: Params
|
|
defaultParams = Params
|
|
{ _aliveStartChance = 0.6
|
|
, _birthLimit = 3
|
|
, _deathLimit = 4
|
|
, _steps = 4
|
|
}
|
|
|
|
parseParams :: Opt.Parser Params
|
|
parseParams = Params
|
|
<$> Opt.option parseChance
|
|
( Opt.long "alive-start-chance"
|
|
<> Opt.value (defaultParams ^. aliveStartChance)
|
|
<> Opt.showDefault
|
|
<> Opt.help ( "Chance for each cell to start alive at the beginning of "
|
|
<> "the cellular automata"
|
|
)
|
|
<> Opt.metavar "CHANCE"
|
|
)
|
|
<*> Opt.option parseNeighbors
|
|
( Opt.long "birth-limit"
|
|
<> Opt.value (defaultParams ^. birthLimit)
|
|
<> Opt.showDefault
|
|
<> Opt.help "Minimum neighbor count required for birth of a cell"
|
|
<> Opt.metavar "NEIGHBORS"
|
|
)
|
|
<*> Opt.option parseNeighbors
|
|
( Opt.long "death-limit"
|
|
<> Opt.value (defaultParams ^. deathLimit)
|
|
<> Opt.showDefault
|
|
<> Opt.help "Maximum neighbor count required for death of a cell"
|
|
<> Opt.metavar "NEIGHBORS"
|
|
)
|
|
<*> Opt.option Opt.auto
|
|
( Opt.long "steps"
|
|
<> Opt.value (defaultParams ^. steps)
|
|
<> Opt.showDefault
|
|
<> Opt.help "Number of generations to run the automata for"
|
|
<> Opt.metavar "STEPS"
|
|
)
|
|
<**> Opt.helper
|
|
where
|
|
parseChance = readWithGuard
|
|
(between 0 1)
|
|
$ \res -> "Chance must be in the range [0,1], got: " <> show res
|
|
|
|
parseNeighbors = readWithGuard
|
|
(between 0 8)
|
|
$ \res -> "Neighbors must be in the range [0,8], got: " <> show res
|
|
|
|
generate :: RandomGen g => Params -> Dimensions -> g -> Cells
|
|
generate params dims gen
|
|
= runSTUArray
|
|
$ fmap fst
|
|
$ flip runRandT gen
|
|
$ generate' params dims
|
|
|
|
generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s)
|
|
generate' params dims = do
|
|
cells <- randInitialize dims $ params ^. aliveStartChance
|
|
let steps' = params ^. steps
|
|
when (steps' > 0)
|
|
$ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params
|
|
-- Remove all but the largest contiguous region of unfilled space
|
|
(_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells
|
|
lift $ fillAllM (fold smallerRegions) cells
|
|
lift $ fillOuterEdgesM cells
|
|
pure cells
|
|
|
|
stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s ()
|
|
stepAutomata cells dims params = do
|
|
origCells <- lift $ cloneMArray @_ @(STUArray s) cells
|
|
for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do
|
|
neighs <- lift $ numAliveNeighborsM origCells pos
|
|
origValue <- lift $ readArray origCells pos
|
|
lift . writeArray cells pos
|
|
$ if origValue
|
|
then neighs >= params ^. deathLimit
|
|
else neighs > params ^. birthLimit
|