about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs
diff options
context:
space:
mode:
authorGriffin Smith <grfn@gws.fyi>2021-06-12T18·57-0400
committergrfn <grfn@gws.fyi>2021-06-13T01·24+0000
commit006e5231e526b3b1e9d06644bd1d2de9d5decb1e (patch)
treebf3c4d398b2231c2b1d7b2c98dc8a83f653c4998 /users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs
parent6f238c1c9083afa303aba7a1317b8d91b1f02fd7 (diff)
refactor(xanthous): Generators -> Generators.Level r/2655
I'm going to start adding generators for things like text soon, so it
makes sense to specifically sequester level generators as their own
thing

Change-Id: I175025375204fab7d75eba67dd06dab9bd2939d3
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3201
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs112
1 files changed, 0 insertions, 112 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs b/users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs
deleted file mode 100644
index be904662f3f7..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/CaveAutomata.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# 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
-import           Linear.V2
---------------------------------------------------------------------------------
-
-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, V2 (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