Add cellular-automata cave generator
Add a cellular-automata-based cave level generator, plus an optparse-applicative-based CLI for invoking level generators in general.
This commit is contained in:
		
							parent
							
								
									73a52e531d
								
							
						
					
					
						commit
						f03ad6bbd6
					
				
					 10 changed files with 434 additions and 8 deletions
				
			
		
							
								
								
									
										66
									
								
								test/Xanthous/Generators/UtilSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										66
									
								
								test/Xanthous/Generators/UtilSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,66 @@ | |||
| {-# LANGUAGE PackageImports #-} | ||||
| 
 | ||||
| module Xanthous.Generators.UtilSpec (main, test) where | ||||
| 
 | ||||
| import Test.Prelude | ||||
| import System.Random (mkStdGen) | ||||
| import Control.Monad.Random (runRandT) | ||||
| import Data.Array.ST (STUArray, runSTUArray, thaw) | ||||
| import Data.Array.IArray (bounds) | ||||
| import Data.Array.MArray (newArray, readArray, writeArray) | ||||
| import Data.Array (Array, range, listArray, Ix) | ||||
| import Control.Monad.ST (ST, runST) | ||||
| import "checkers" Test.QuickCheck.Instances.Array () | ||||
| 
 | ||||
| import Xanthous.Util | ||||
| import Xanthous.Data (width, height) | ||||
| import Xanthous.Generators.Util | ||||
| 
 | ||||
| main :: IO () | ||||
| main = defaultMain test | ||||
| 
 | ||||
| newtype GenArray a b = GenArray (Array a b) | ||||
|   deriving stock (Show, Eq) | ||||
| 
 | ||||
| instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where | ||||
|   arbitrary = GenArray <$> do | ||||
|     (mkElem :: a -> b) <- arbitrary | ||||
|     minDims <- arbitrary | ||||
|     maxDims <- arbitrary | ||||
|     let bnds = (minDims, maxDims) | ||||
|     pure $ listArray bnds $ mkElem <$> range bnds | ||||
| 
 | ||||
| test :: TestTree | ||||
| test = testGroup "Xanthous.Generators.Util" | ||||
|   [ testGroup "randInitialize" | ||||
|     [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance -> | ||||
|         let gen = mkStdGen seed | ||||
|             res = runSTUArray | ||||
|                 $ fmap fst | ||||
|                 $ flip runRandT gen | ||||
|                 $ randInitialize dims aliveChance | ||||
|         in bounds res === ((0, 0), (dims ^. width, dims ^. height)) | ||||
|     ] | ||||
|   , testGroup "numAliveNeighbors" | ||||
|     [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc -> | ||||
|         let | ||||
|           act :: forall s. ST s Word | ||||
|           act = do | ||||
|             mArr <- thaw @_ @_ @_ @(STUArray s) arr | ||||
|             numAliveNeighborsM mArr loc | ||||
|           res = runST act | ||||
|         in counterexample (show res) $ between 0 8 res | ||||
|     ] | ||||
|   , testGroup "cloneMArray" | ||||
|       [ testCase "clones the array" $ runST $ | ||||
|           let | ||||
|             go :: forall s. ST s Assertion | ||||
|             go = do | ||||
|               arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int) | ||||
|               arr' <- cloneMArray @_ @(STUArray s) arr | ||||
|               writeArray arr' 0 1234 | ||||
|               x <- readArray arr 0 | ||||
|               pure $ x @?= 1 | ||||
|           in go | ||||
|       ] | ||||
|   ] | ||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue