blob: c266742b0590bc0138cdda9ca580c44a74721269 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
{-# LANGUAGE GADTs #-}
module Xanthous.Generators where
import Xanthous.Prelude
import Data.Array.Unboxed
import System.Random (RandomGen)
import qualified Options.Applicative as Opt
import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
import Xanthous.Data (Dimensions)
data Generator = CaveAutomata
deriving stock (Show, Eq)
data SGenerator (gen :: Generator) where
SCaveAutomata :: SGenerator 'CaveAutomata
data AGenerator where
AGenerator :: forall gen. SGenerator gen -> AGenerator
type family Params (gen :: Generator) :: Type where
Params 'CaveAutomata = CaveAutomata.Params
generate
:: RandomGen g
=> SGenerator gen
-> Params gen
-> Dimensions
-> g
-> UArray (Word, Word) Bool
generate SCaveAutomata = CaveAutomata.generate
data GeneratorInput where
GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput
generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> UArray (Word, Word) Bool
generateFromInput (GeneratorInput sg ps) = generate sg ps
parseGeneratorInput :: Opt.Parser GeneratorInput
parseGeneratorInput = Opt.subparser $
Opt.command "cave" (Opt.info
(GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams)
(Opt.progDesc "cellular-automata based cave generator"))
showCells :: UArray (Word, Word) Bool -> Text
showCells arr =
let ((minX, minY), (maxX, maxY)) = bounds arr
showCellVal True = "x"
showCellVal False = " "
showCell = showCellVal . (arr !)
row r = foldMap (showCell . (, r)) [minX..maxX]
rows = row <$> [minY..maxY]
in intercalate "\n" rows
|
