Place the chacracter in the level at startup time
Randomly select a position in the largest contiguous region of the generated level in which to place the character at startup time.
This commit is contained in:
		
							parent
							
								
									9ebdc6fbb4
								
							
						
					
					
						commit
						c06edf3cc6
					
				
					 9 changed files with 171 additions and 34 deletions
				
			
		
							
								
								
									
										18
									
								
								src/Main.hs
									
										
									
									
									
								
							
							
						
						
									
										18
									
								
								src/Main.hs
									
										
									
									
									
								
							|  | @ -1,10 +1,10 @@ | ||||||
| module Main where | module Main ( main ) where | ||||||
| 
 | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude | import           Xanthous.Prelude | ||||||
| import           Brick | import           Brick | ||||||
| import qualified Options.Applicative as Opt | import qualified Options.Applicative as Opt | ||||||
| import           System.Random | import           System.Random | ||||||
| 
 | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Game (getInitialState) | import           Xanthous.Game (getInitialState) | ||||||
| import           Xanthous.App (makeApp) | import           Xanthous.App (makeApp) | ||||||
| import           Xanthous.Generators | import           Xanthous.Generators | ||||||
|  | @ -13,8 +13,11 @@ import Xanthous.Generators | ||||||
|   , generateFromInput |   , generateFromInput | ||||||
|   , showCells |   , showCells | ||||||
|   ) |   ) | ||||||
|  | import           Xanthous.Generators.Util (regions) | ||||||
|  | import           Xanthous.Generators.LevelContents | ||||||
| import           Xanthous.Data (Dimensions, Dimensions'(Dimensions)) | import           Xanthous.Data (Dimensions, Dimensions'(Dimensions)) | ||||||
| 
 | import           Data.Array.IArray ( amap ) | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
| data Command | data Command | ||||||
|   = Run |   = Run | ||||||
|   | Generate GeneratorInput Dimensions |   | Generate GeneratorInput Dimensions | ||||||
|  | @ -61,6 +64,13 @@ runGenerate :: GeneratorInput -> Dimensions -> IO () | ||||||
| runGenerate input dims = do | runGenerate input dims = do | ||||||
|   randGen <- getStdGen |   randGen <- getStdGen | ||||||
|   let res = generateFromInput input dims randGen |   let res = generateFromInput input dims randGen | ||||||
|  |       rs = regions $ amap not res | ||||||
|  |   putStr "num regions: " | ||||||
|  |   print $ length rs | ||||||
|  |   putStr "region lengths: " | ||||||
|  |   print $ length <$> rs | ||||||
|  |   putStr "character position: " | ||||||
|  |   print =<< chooseCharacterPosition res | ||||||
|   putStrLn $ showCells res |   putStrLn $ showCells res | ||||||
| 
 | 
 | ||||||
| runCommand :: Command -> IO () | runCommand :: Command -> IO () | ||||||
|  |  | ||||||
|  | @ -9,7 +9,13 @@ import           Control.Monad.State (get) | ||||||
| import           Control.Monad.Random (getRandom) | import           Control.Monad.Random (getRandom) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Command | import           Xanthous.Command | ||||||
| import           Xanthous.Data (move, Position(..), Dimensions'(Dimensions), Dimensions) | import           Xanthous.Data | ||||||
|  |                  ( move | ||||||
|  |                  , Position(..) | ||||||
|  |                  , Dimensions'(Dimensions) | ||||||
|  |                  , Dimensions | ||||||
|  |                  , positionFromPair | ||||||
|  |                  ) | ||||||
| import qualified Xanthous.Data.EntityMap as EntityMap | import qualified Xanthous.Data.EntityMap as EntityMap | ||||||
| import           Xanthous.Data.EntityMap (EntityMap) | import           Xanthous.Data.EntityMap (EntityMap) | ||||||
| import           Xanthous.Game | import           Xanthous.Game | ||||||
|  | @ -24,6 +30,7 @@ import           Xanthous.Entities.Raws (raw) | ||||||
| import           Xanthous.Entities | import           Xanthous.Entities | ||||||
| import           Xanthous.Generators | import           Xanthous.Generators | ||||||
| import qualified Xanthous.Generators.CaveAutomata as CaveAutomata | import qualified Xanthous.Generators.CaveAutomata as CaveAutomata | ||||||
|  | import           Xanthous.Generators.LevelContents | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| type App = Brick.App GameState () Name | type App = Brick.App GameState () Name | ||||||
|  | @ -49,10 +56,13 @@ testGormlak = | ||||||
| startEvent :: AppM () | startEvent :: AppM () | ||||||
| startEvent = do | startEvent = do | ||||||
|   say_ ["welcome"] |   say_ ["welcome"] | ||||||
|   level <- generateLevel SCaveAutomata CaveAutomata.defaultParams |   (level, charPos) <- | ||||||
|           $ Dimensions 120 80 |     generateLevel SCaveAutomata CaveAutomata.defaultParams | ||||||
|  |     $ Dimensions 80 80 | ||||||
|   entities <>= level |   entities <>= level | ||||||
|   entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) |   characterPosition .= charPos | ||||||
|  |   -- entities %= EntityMap.insertAt (Position 10 10) (SomeEntity testGormlak) | ||||||
|  | 
 | ||||||
| 
 | 
 | ||||||
| handleEvent :: BrickEvent Name () -> AppM (Next GameState) | handleEvent :: BrickEvent Name () -> AppM (Next GameState) | ||||||
| handleEvent (VtyEvent (EvKey k mods)) | handleEvent (VtyEvent (EvKey k mods)) | ||||||
|  | @ -73,9 +83,15 @@ handleCommand PreviousMessage = do | ||||||
| 
 | 
 | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| generateLevel :: SGenerator gen -> Params gen -> Dimensions -> AppM (EntityMap SomeEntity) | generateLevel | ||||||
|  |   :: SGenerator gen | ||||||
|  |   -> Params gen | ||||||
|  |   -> Dimensions | ||||||
|  |   -> AppM (EntityMap SomeEntity, Position) | ||||||
| generateLevel g ps dims = do | generateLevel g ps dims = do | ||||||
|   gen <- use randomGen |   gen <- use randomGen | ||||||
|   let cells = generate g ps dims gen |   let cells = generate g ps dims gen | ||||||
|   _ <- getRandom @_ @Int -- perturb the generator, so we don't get the same level twice |   _ <- getRandom @_ @Int -- perturb the generator, so we don't get the same level twice | ||||||
|   pure $ SomeEntity <$> cellsToWalls cells |   charPos <- positionFromPair <$> chooseCharacterPosition cells | ||||||
|  |   let level = SomeEntity <$> cellsToWalls cells | ||||||
|  |   pure (level, charPos) | ||||||
|  |  | ||||||
|  | @ -15,6 +15,7 @@ module Xanthous.Data | ||||||
|   , position |   , position | ||||||
|   , positioned |   , positioned | ||||||
|   , loc |   , loc | ||||||
|  |   , positionFromPair | ||||||
| 
 | 
 | ||||||
|     -- * |     -- * | ||||||
|   , Dimensions'(..) |   , Dimensions'(..) | ||||||
|  | @ -91,6 +92,9 @@ loc = iso hither yon | ||||||
|     hither (Position px py) = Location (px, py) |     hither (Position px py) = Location (px, py) | ||||||
|     yon (Location (lx, ly)) = Position lx ly |     yon (Location (lx, ly)) = Position lx ly | ||||||
| 
 | 
 | ||||||
|  | positionFromPair :: (Integral i, Integral j) => (i, j) -> Position | ||||||
|  | positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j) | ||||||
|  | 
 | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| data Dimensions' a = Dimensions | data Dimensions' a = Dimensions | ||||||
|  |  | ||||||
|  | @ -101,7 +101,7 @@ _EntityMap = iso hither yon | ||||||
|     yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap |     yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap | ||||||
| 
 | 
 | ||||||
| instance Semigroup (EntityMap a) where | instance Semigroup (EntityMap a) where | ||||||
|   em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₁ ^. _EntityMap) em₂ |   em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁ | ||||||
| 
 | 
 | ||||||
| instance Monoid (EntityMap a) where | instance Monoid (EntityMap a) where | ||||||
|   mempty = emptyEntityMap |   mempty = emptyEntityMap | ||||||
|  |  | ||||||
|  | @ -33,13 +33,13 @@ generate | ||||||
|   -> Params gen |   -> Params gen | ||||||
|   -> Dimensions |   -> Dimensions | ||||||
|   -> g |   -> g | ||||||
|   -> UArray (Word, Word) Bool |   -> Cells | ||||||
| generate SCaveAutomata = CaveAutomata.generate | generate SCaveAutomata = CaveAutomata.generate | ||||||
| 
 | 
 | ||||||
| data GeneratorInput where | data GeneratorInput where | ||||||
|   GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput |   GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput | ||||||
| 
 | 
 | ||||||
| generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> UArray (Word, Word) Bool | generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells | ||||||
| generateFromInput (GeneratorInput sg ps) = generate sg ps | generateFromInput (GeneratorInput sg ps) = generate sg ps | ||||||
| 
 | 
 | ||||||
| parseGeneratorInput :: Opt.Parser GeneratorInput | parseGeneratorInput :: Opt.Parser GeneratorInput | ||||||
|  | @ -48,7 +48,7 @@ parseGeneratorInput = Opt.subparser $ | ||||||
|                       (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) |                       (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) | ||||||
|                       (Opt.progDesc "cellular-automata based cave generator")) |                       (Opt.progDesc "cellular-automata based cave generator")) | ||||||
| 
 | 
 | ||||||
| showCells :: UArray (Word, Word) Bool -> Text | showCells :: Cells -> Text | ||||||
| showCells arr = | showCells arr = | ||||||
|   let ((minX, minY), (maxX, maxY)) = bounds arr |   let ((minX, minY), (maxX, maxY)) = bounds arr | ||||||
|       showCellVal True = "x" |       showCellVal True = "x" | ||||||
|  | @ -58,7 +58,7 @@ showCells arr = | ||||||
|       rows = row <$> [minY..maxY] |       rows = row <$> [minY..maxY] | ||||||
|   in intercalate "\n" rows |   in intercalate "\n" rows | ||||||
| 
 | 
 | ||||||
| cellsToWalls :: UArray (Word, Word) Bool -> EntityMap Wall | cellsToWalls :: Cells -> EntityMap Wall | ||||||
| cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells | cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells | ||||||
|   where |   where | ||||||
|     maybeInsertWall em (pos@(x, y), True) |     maybeInsertWall em (pos@(x, y), True) | ||||||
|  |  | ||||||
|  | @ -92,7 +92,7 @@ generate params dims gen | ||||||
|   $ flip runRandT gen |   $ flip runRandT gen | ||||||
|   $ generate' params dims |   $ generate' params dims | ||||||
| 
 | 
 | ||||||
| generate' :: RandomGen g => Params -> Dimensions -> CellM g s (Cells s) | generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s) | ||||||
| generate' params dims = do | generate' params dims = do | ||||||
|   cells <- randInitialize dims $ params ^. aliveStartChance |   cells <- randInitialize dims $ params ^. aliveStartChance | ||||||
|   let steps' = params ^. steps |   let steps' = params ^. steps | ||||||
|  | @ -100,7 +100,7 @@ generate' params dims = do | ||||||
|    $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params |    $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params | ||||||
|   pure cells |   pure cells | ||||||
| 
 | 
 | ||||||
| stepAutomata :: forall s g. Cells s -> Dimensions -> Params -> CellM g s () | stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s () | ||||||
| stepAutomata cells dims params = do | stepAutomata cells dims params = do | ||||||
|   origCells <- lift $ cloneMArray @_ @(STUArray s) cells |   origCells <- lift $ cloneMArray @_ @(STUArray s) cells | ||||||
|   for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do |   for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do | ||||||
|  |  | ||||||
							
								
								
									
										26
									
								
								src/Xanthous/Generators/LevelContents.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								src/Xanthous/Generators/LevelContents.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,26 @@ | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | module Xanthous.Generators.LevelContents | ||||||
|  |   ( chooseCharacterPosition | ||||||
|  |   ) where | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Prelude | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Control.Monad.Random | ||||||
|  | import Data.Array.IArray (amap) | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Generators.Util | ||||||
|  | import Xanthous.Random | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | chooseCharacterPosition :: MonadRandom m => Cells -> m (Word, Word) | ||||||
|  | chooseCharacterPosition cells = choose $ impureNonNull candidates | ||||||
|  |   where | ||||||
|  |     -- cells ends up with true = wall, we want true = can put a character here | ||||||
|  |     placeableCells = amap not cells | ||||||
|  | 
 | ||||||
|  |     -- find the largest contiguous region of cells in the cave. | ||||||
|  |     candidates | ||||||
|  |       = maximumBy (compare `on` length) | ||||||
|  |       $ fromMaybe (error "No regions generated! this should never happen.") | ||||||
|  |       $ fromNullable | ||||||
|  |       $ regions placeableCells | ||||||
|  | @ -1,28 +1,34 @@ | ||||||
| -- | | {-# LANGUAGE ViewPatterns #-} | ||||||
| 
 | -------------------------------------------------------------------------------- | ||||||
| module Xanthous.Generators.Util | module Xanthous.Generators.Util | ||||||
|   ( Cells |   ( MCells | ||||||
|  |   , Cells | ||||||
|   , CellM |   , CellM | ||||||
|   , randInitialize |   , randInitialize | ||||||
|   , numAliveNeighborsM |   , numAliveNeighborsM | ||||||
|   , numAliveNeighbors |   , numAliveNeighbors | ||||||
|   , cloneMArray |   , cloneMArray | ||||||
|  |   , floodFill | ||||||
|  |   , regions | ||||||
|   ) where |   ) where | ||||||
| 
 | -------------------------------------------------------------------------------- | ||||||
| import Xanthous.Prelude | import Xanthous.Prelude hiding (Foldable, toList) | ||||||
| import Data.Array.ST | import Data.Array.ST | ||||||
| import Data.Array.Unboxed | import Data.Array.Unboxed | ||||||
| import Control.Monad.ST | import Control.Monad.ST | ||||||
| import Control.Monad.Random | import Control.Monad.Random | ||||||
| import Data.Monoid | import Data.Monoid | ||||||
| 
 | import Data.Foldable (Foldable, toList) | ||||||
| import Xanthous.Util (foldlMapM') | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Util (foldlMapM', between) | ||||||
| import Xanthous.Data (Dimensions, width, height) | import Xanthous.Data (Dimensions, width, height) | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| type Cells s = STUArray s (Word, Word) Bool | type MCells s = STUArray s (Word, Word) Bool | ||||||
|  | type Cells = UArray (Word, Word) Bool | ||||||
| type CellM g s a = RandT g (ST s) a | type CellM g s a = RandT g (ST s) a | ||||||
| 
 | 
 | ||||||
| randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (Cells s) | randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s) | ||||||
| randInitialize dims aliveChance = do | randInitialize dims aliveChance = do | ||||||
|   res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False |   res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False | ||||||
|   for_ [0..dims ^. width] $ \i -> |   for_ [0..dims ^. width] $ \i -> | ||||||
|  | @ -87,6 +93,14 @@ numAliveNeighbors cells (x, y) = | ||||||
|     neighborPositions :: [(Int, Int)] |     neighborPositions :: [(Int, Int)] | ||||||
|     neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] |     neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] | ||||||
| 
 | 
 | ||||||
|  | safeGet :: (IArray a e, Ix i) => a i e -> i -> Maybe e | ||||||
|  | safeGet arr idx = | ||||||
|  |   let (minIdx, maxIdx) = bounds arr | ||||||
|  |   in if idx < minIdx || idx > maxIdx | ||||||
|  |      then Nothing | ||||||
|  |      else Just $ arr ! idx | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
| cloneMArray | cloneMArray | ||||||
|   :: forall a a' i e m. |   :: forall a a' i e m. | ||||||
|   ( Ix i |   ( Ix i | ||||||
|  | @ -97,3 +111,68 @@ cloneMArray | ||||||
|   => a i e |   => a i e | ||||||
|   -> m (a' i e) |   -> m (a' i e) | ||||||
| cloneMArray = thaw @_ @UArray <=< freeze | cloneMArray = thaw @_ @UArray <=< freeze | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | -- | Flood fill a cell array starting at a point, returning a list of all the | ||||||
|  | -- (true) cell locations reachable from that point | ||||||
|  | floodFill :: forall a i j. | ||||||
|  |             ( IArray a Bool | ||||||
|  |             , Ix (i, j) | ||||||
|  |             , Enum i , Enum j | ||||||
|  |             , Bounded i , Bounded j | ||||||
|  |             , Eq i , Eq j | ||||||
|  |             , Show i, Show j | ||||||
|  |             ) | ||||||
|  |           => a (i, j) Bool -- ^ array | ||||||
|  |           -> (i, j)        -- ^ position | ||||||
|  |           -> Set (i, j) | ||||||
|  | floodFill = go mempty | ||||||
|  |   where | ||||||
|  |     go :: Set (i, j) -> a (i, j) Bool -> (i, j) -> Set (i, j) | ||||||
|  |     -- TODO pass result in rather than passing seen in, return result | ||||||
|  |     go res arr@(bounds -> arrBounds) idx@(x, y) | ||||||
|  |       | not (inRange arrBounds idx) =  res | ||||||
|  |       | not (arr ! idx) =  res | ||||||
|  |       | otherwise = | ||||||
|  |         let neighbors | ||||||
|  |               = filter (inRange arrBounds) | ||||||
|  |               . filter (/= idx) | ||||||
|  |               . filter (`notMember` res) | ||||||
|  |               $ (,) | ||||||
|  |               <$> [(if x == minBound then x else pred x) | ||||||
|  |                    .. | ||||||
|  |                    (if x == maxBound then x else succ x)] | ||||||
|  |               <*> [(if y == minBound then y else pred y) | ||||||
|  |                    .. | ||||||
|  |                    (if y == maxBound then y else succ y)] | ||||||
|  |         in foldl' (\r idx' -> | ||||||
|  |                      if arr ! idx' | ||||||
|  |                      then r <> go (r & contains idx' .~ True) arr idx' | ||||||
|  |                      else r) | ||||||
|  |            (res & contains idx .~ True) neighbors | ||||||
|  | 
 | ||||||
|  | -- | Gives a list of all the disconnected regions in a cell array, represented | ||||||
|  | -- each as lists of points | ||||||
|  | regions :: forall a i j. | ||||||
|  |           ( IArray a Bool | ||||||
|  |           , Ix (i, j) | ||||||
|  |           , Enum i , Enum j | ||||||
|  |           , Bounded i , Bounded j | ||||||
|  |           , Eq i , Eq j | ||||||
|  |           , Show i, Show j | ||||||
|  |           ) | ||||||
|  |         => a (i, j) Bool | ||||||
|  |         -> [Set (i, j)] | ||||||
|  | regions arr | ||||||
|  |   | Just firstPoint <- findFirstPoint arr = | ||||||
|  |       let region = floodFill arr firstPoint | ||||||
|  |           arr' = fillAll region arr | ||||||
|  |       in region : regions arr' | ||||||
|  |   | otherwise = [] | ||||||
|  |   where | ||||||
|  |     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 | ||||||
|  |  | ||||||
|  | @ -4,7 +4,7 @@ cabal-version: 1.12 | ||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: 3fbeb53b2706e3f0186fa3c80619a166f64eb52cf045006ac993074fa7f3e9d1 | -- hash: a79caccff8895730c394c19244f068830759636d17f55f3b6d1d8a9ebe43ecdd | ||||||
| 
 | 
 | ||||||
| name:           xanthous | name:           xanthous | ||||||
| version:        0.1.0.0 | version:        0.1.0.0 | ||||||
|  | @ -46,6 +46,7 @@ library | ||||||
|       Xanthous.Game.Draw |       Xanthous.Game.Draw | ||||||
|       Xanthous.Generators |       Xanthous.Generators | ||||||
|       Xanthous.Generators.CaveAutomata |       Xanthous.Generators.CaveAutomata | ||||||
|  |       Xanthous.Generators.LevelContents | ||||||
|       Xanthous.Generators.Util |       Xanthous.Generators.Util | ||||||
|       Xanthous.Messages |       Xanthous.Messages | ||||||
|       Xanthous.Monad |       Xanthous.Monad | ||||||
|  | @ -113,6 +114,7 @@ executable xanthous | ||||||
|       Xanthous.Game.Draw |       Xanthous.Game.Draw | ||||||
|       Xanthous.Generators |       Xanthous.Generators | ||||||
|       Xanthous.Generators.CaveAutomata |       Xanthous.Generators.CaveAutomata | ||||||
|  |       Xanthous.Generators.LevelContents | ||||||
|       Xanthous.Generators.Util |       Xanthous.Generators.Util | ||||||
|       Xanthous.Messages |       Xanthous.Messages | ||||||
|       Xanthous.Monad |       Xanthous.Monad | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue