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
|
module Fallen.Map.Overworld
( initOverworld
) where
import Fallen.Map
import Fallen.Tiles
import System.Random
import Fallen.Util
import Fallen.Point
-- initOverworld : generate the overworld
initOverworld rg = do
let m = emptyMap 150 150 Forest -- create map
let m' = fillMapRect 0 0 150 150 Grass m -- fill with grass
let (tr,rg1) = randomR (1,50) rg :: (Int,StdGen)
let (lr,rg2) = randomR (1,50) rg1 :: (Int,StdGen)
let (rr,rg3) = randomR (1,50) rg2 :: (Int,StdGen)
let (br,rg4) = randomR (1,50) rg3 :: (Int,StdGen)
let (m'',rg5) = roughen 150 tr lr rr br rg4 m' -- add surrounding forest
let (clumps,rg6) = randomR (30,60) rg5 :: (Int,StdGen)
let (m2,rg7) = drawClumps clumps rg6 m''
(m2,rg7)
-- roughen : create the rough forest edges of the overworld
roughen 0 _ _ _ _ rg m = (m,rg)
roughen w tr lr rr br rg m = do
let m' = fillMapRect (w-1) 0 1 tr Forest m
let m'' = fillMapRect 0 (w-1) lr 1 Forest m'
let m2 = fillMapRect (150-rr-1) (w-1) rr 1 Forest m''
let m2' = fillMapRect (w-1) (150-br-1) 1 br Forest m2
let (str,rg1) = randomR (-2,2) rg :: (Int,StdGen)
let (slr,rg2) = randomR (-2,2) rg1 :: (Int,StdGen)
let (srr,rg3) = randomR (-2,2) rg2 :: (Int,StdGen)
let (sbr,rg4) = randomR (-2,2) rg3 :: (Int,StdGen)
roughen (w-1) (bound tr str) (bound lr slr) (bound rr srr) (bound br sbr) rg4 m2' where
bound r s
| r + s < 1 = 1
| r + s > 50 = 50
| otherwise = r + s
-- drawClumps : add in clumps of rocks, water, and trees
clumpTypes = [Rock, Water, Forest]
clumpOver = [Rock, Water, Forest, Grass]
drawClumps 0 rg m = (m,rg)
drawClumps num rg m = do
let (area,rg1) = randomR (1,300) rg :: (Int,StdGen)
let (clumpType,rg2) = randomSetElement rg1 clumpTypes
let (startPoint,rg3) = randomPoint 0 0 149 149 rg2
let (m',rg4) = drawClump area clumpType startPoint m rg3
drawClumps (num-1) rg4 m'
drawClump 0 clumpType p m rg = (updateMap p clumpType m,rg)
drawClump area clumpType p m rg = do
let m' = updateMap p clumpType m
let legalDirs = legalMoves m' p clumpOver
if null legalDirs
then (m',rg)
else do
let (nextDir,rg1) = randomSetElement rg legalDirs
let nextPoint = stepInDirection p nextDir
drawClump (area-1) clumpType nextPoint m' rg1
|
