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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
module Xanthous.Generators
( generate
, SGenerator(..)
, GeneratorInput
, generateFromInput
, parseGeneratorInput
, showCells
, Level(..)
, levelWalls
, levelItems
, levelCreatures
, levelCharacterPosition
, levelTutorialMessage
, generateLevel
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude hiding (Level)
import Data.Array.Unboxed
import System.Random (RandomGen)
import qualified Options.Applicative as Opt
import Control.Monad.Random
--------------------------------------------------------------------------------
import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
import Xanthous.Generators.Util
import Xanthous.Generators.LevelContents
import Xanthous.Data (Dimensions, Position'(Position), Position)
import Xanthous.Data.EntityMap (EntityMap)
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities.Environment
import Xanthous.Entities.Item (Item)
import Xanthous.Entities.Creature (Creature)
--------------------------------------------------------------------------------
data Generator = CaveAutomata
deriving stock (Show, Eq)
data SGenerator (gen :: Generator) where
SCaveAutomata :: SGenerator 'CaveAutomata
type family Params (gen :: Generator) :: Type where
Params 'CaveAutomata = CaveAutomata.Params
generate
:: RandomGen g
=> SGenerator gen
-> Params gen
-> Dimensions
-> g
-> Cells
generate SCaveAutomata = CaveAutomata.generate
data GeneratorInput where
GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput
generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells
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 :: Cells -> 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
cellsToWalls :: Cells -> EntityMap Wall
cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
where
maybeInsertWall em (pos@(x, y), True)
| not (surroundedOnAllSides pos) =
let x' = fromIntegral x
y' = fromIntegral y
in EntityMap.insertAt (Position x' y') Wall em
maybeInsertWall em _ = em
surroundedOnAllSides pos = numAliveNeighbors cells pos == 8
--------------------------------------------------------------------------------
data Level = Level
{ _levelWalls :: !(EntityMap Wall)
, _levelItems :: !(EntityMap Item)
, _levelCreatures :: !(EntityMap Creature)
, _levelTutorialMessage :: !(EntityMap GroundMessage)
, _levelCharacterPosition :: !Position
}
makeLenses ''Level
generateLevel :: MonadRandom m => SGenerator gen -> Params gen -> Dimensions -> m Level
generateLevel gen ps dims = do
rand <- mkStdGen <$> getRandom
let cells = generate gen ps dims rand
_levelWalls = cellsToWalls cells
_levelItems <- randomItems cells
_levelCreatures <- randomCreatures cells
_levelCharacterPosition <- chooseCharacterPosition cells
_levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition
pure Level {..}
|
