-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathMapGen.elm
108 lines (84 loc) · 3.95 KB
/
MapGen.elm
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
module MapGen where
import Graphics.Input as Input
import Grid
import Generator
import Generator.Standard
import GameModel
import GameView
neighborhood : Grid.Coordinate -> [Grid.Coordinate]
neighborhood {x, y} = map (\(a, b) -> Grid.Coordinate a b)
[ (x - 1, y - 1), (x, y - 1), (x + 1, y - 1)
, (x - 1, y), (x, y), (x + 1, y)
, (x - 1, y + 1), (x, y + 1), (x + 1, y + 1)
]
neighborhood2 : Grid.Coordinate -> [Grid.Coordinate]
neighborhood2 {x, y} = map (\(a, b) -> Grid.Coordinate a b)
[ (x - 2, y - 2), (x - 1, y - 2), (x, y - 2), (x + 1, y - 2), (x + 2, y - 2)
, (x - 2, y - 1), (x - 1, y - 1), (x, y - 1), (x + 1, y - 1), (x + 2, y - 1)
, (x - 2, y), (x - 1, y), (x, y), (x + 1, y), (x + 2, y)
, (x - 2, y + 1), (x - 1, y + 1), (x, y + 1), (x + 1, y + 1), (x + 2, y + 1)
, (x - 2, y + 2), (x - 1, y + 2), (x, y + 2), (x + 1, y + 2), (x + 2, y + 2)
]
getNeighborsOrElse : a -> Grid.Grid a -> Grid.Coordinate -> [a]
getNeighborsOrElse x grid coord =
map (\c -> Grid.getOrElse x c grid) <| neighborhood coord
getNeighborsOrElse2 : a -> Grid.Grid a -> Grid.Coordinate -> [a]
getNeighborsOrElse2 x grid coord =
map (\c -> Grid.getOrElse x c grid) <| neighborhood2 coord
getNeighbors : Grid.Grid GameModel.Tile -> Grid.Coordinate -> [GameModel.Tile]
getNeighbors = getNeighborsOrElse GameModel.Wall
getNeighbors2 : Grid.Grid GameModel.Tile -> Grid.Coordinate -> [GameModel.Tile]
getNeighbors2 = getNeighborsOrElse2 GameModel.Wall
numberOfWalls : Grid.Grid GameModel.Tile -> Grid.Coordinate -> Int
numberOfWalls grid coord =
getNeighbors grid coord
|> filter (\t -> t == GameModel.Wall)
|> length
numberOfWalls2 : Grid.Grid GameModel.Tile -> Grid.Coordinate -> Int
numberOfWalls2 grid coord =
getNeighbors2 grid coord
|> filter (\t -> t == GameModel.Wall)
|> length
randomTile : GameModel.Random -> (GameModel.Tile, GameModel.Random)
randomTile gen =
let (p, gen') = Generator.float gen
tile = if p < 0.40 then GameModel.Wall else GameModel.Floor
in (tile, gen')
randomMap : (Int, Int) -> GameModel.Random -> (Grid.Grid GameModel.Tile, GameModel.Random)
randomMap (w, h) gen =
let row gen = Generator.listOf randomTile w gen
x = scanl (\_ (ts, g) -> row g) (row gen) [1..h]
rows = map fst x
level = Grid.fromList rows
in (level, x |> last |> snd)
iterate : Grid.Grid GameModel.Tile -> Grid.Grid GameModel.Tile
iterate grid =
let coords = Grid.toCoordinates grid
x = map (\coord -> (coord, if numberOfWalls grid coord >= 5 then GameModel.Wall else GameModel.Floor)) coords
in foldl (\(coord, a) grid -> Grid.set coord a grid) grid x
iterate2 : Grid.Grid GameModel.Tile -> Grid.Grid GameModel.Tile
iterate2 grid =
let coords = Grid.toCoordinates grid
rule coord = if | numberOfWalls grid coord >= 5 -> GameModel.Wall
| numberOfWalls2 grid coord <= 2 -> GameModel.Wall
| otherwise -> GameModel.Floor
x = map (\coord -> (coord, rule coord)) coords
in foldl (\(coord, a) grid -> Grid.set coord a grid) grid x
randomCave : (Int, Int) -> GameModel.Random -> (Grid.Grid GameModel.Tile, GameModel.Random)
randomCave (w, h) gen =
let (bedrock, gen') = randomMap (w, h) gen
in (bedrock |> iterate2 |> iterate2 |> iterate2 |> iterate2 |> iterate |> iterate |> iterate, gen')
main = lift display state
display state =
let level = fst state
in flow down <| button :: map (\x -> GameView.background x `above` spacer 10 10)
[level |> iterate2 |> iterate2 |> iterate2 |> iterate2 |> iterate |> iterate |> iterate]
seed : Int
seed = 2013
gen : GameModel.Random
gen = Generator.Standard.generator seed
input = Input.input ()
button = Input.button input.handle () "clickar"
state : Signal (Grid.Grid GameModel.Tile, GameModel.Random)
state = foldp (\a state' -> randomMap dimensions (snd state')) (randomMap dimensions gen) input.signal
dimensions = (40, 30)