about summary refs log tree commit diff stats
path: root/Fallen
diff options
context:
space:
mode:
authorKelly Rauchenberger <fefferburbia@gmail.com>2013-04-02 01:57:09 -0400
committerKelly Rauchenberger <fefferburbia@gmail.com>2013-04-02 01:57:09 -0400
commit94fc90c32fb9d6694a95a9c191553aa39eabd10a (patch)
treeefafaeee96cba98f76353e18f59f0cb045fc6d70 /Fallen
parent8cb868224840c734f38e9041aa1567cdecd17797 (diff)
downloadfallen-hs-94fc90c32fb9d6694a95a9c191553aa39eabd10a.tar.gz
fallen-hs-94fc90c32fb9d6694a95a9c191553aa39eabd10a.tar.bz2
fallen-hs-94fc90c32fb9d6694a95a9c191553aa39eabd10a.zip
Got rid of pure functional randomness and started using IO monad
Diffstat (limited to 'Fallen')
-rw-r--r--Fallen/Map/Overworld.hs68
-rw-r--r--Fallen/Point.hs8
-rw-r--r--Fallen/Util.hs6
3 files changed, 42 insertions, 40 deletions
diff --git a/Fallen/Map/Overworld.hs b/Fallen/Map/Overworld.hs index 308aad0..5df5cf8 100644 --- a/Fallen/Map/Overworld.hs +++ b/Fallen/Map/Overworld.hs
@@ -8,30 +8,30 @@ module Fallen.Map.Overworld
8 import Fallen.Point 8 import Fallen.Point
9 9
10 -- initOverworld : generate the overworld 10 -- initOverworld : generate the overworld
11 initOverworld rg = do 11 initOverworld = do
12 let m = emptyMap 150 150 Forest -- create map 12 let m = emptyMap 150 150 Forest -- create map
13 let m' = fillMapRect 0 0 150 150 Grass m -- fill with grass 13 let m1 = fillMapRect 0 0 150 150 Grass m -- fill with grass
14 let (tr,rg1) = randomR (1,50) rg :: (Int,StdGen) 14 tr <- randomRIO (1,50)
15 let (lr,rg2) = randomR (1,50) rg1 :: (Int,StdGen) 15 lr <- randomRIO (1,50)
16 let (rr,rg3) = randomR (1,50) rg2 :: (Int,StdGen) 16 rr <- randomRIO (1,50)
17 let (br,rg4) = randomR (1,50) rg3 :: (Int,StdGen) 17 br <- randomRIO (1,50)
18 let (m'',rg5) = roughen 150 tr lr rr br rg4 m' -- add surrounding forest 18 m2 <- roughen 150 tr lr rr br m1 -- add surrounding forest
19 let (clumps,rg6) = randomR (30,60) rg5 :: (Int,StdGen) 19 clumps <- randomRIO (30,60)
20 let (m2,rg7) = drawClumps clumps rg6 m'' 20 m3 <- drawClumps clumps m2
21 (m2,rg7) 21 return m3
22 22
23 -- roughen : create the rough forest edges of the overworld 23 -- roughen : create the rough forest edges of the overworld
24 roughen 0 _ _ _ _ rg m = (m,rg) 24 roughen 0 _ _ _ _ m = return m
25 roughen w tr lr rr br rg m = do 25 roughen w tr lr rr br m = do
26 let m' = fillMapRect (w-1) 0 1 tr Forest m 26 let m1 = fillMapRect (w-1) 0 1 tr Forest m
27 let m'' = fillMapRect 0 (w-1) lr 1 Forest m' 27 let m2 = fillMapRect 0 (w-1) lr 1 Forest m1
28 let m2 = fillMapRect (150-rr-1) (w-1) rr 1 Forest m'' 28 let m3 = fillMapRect (150-rr-1) (w-1) rr 1 Forest m2
29 let m2' = fillMapRect (w-1) (150-br-1) 1 br Forest m2 29 let m4 = fillMapRect (w-1) (150-br-1) 1 br Forest m3
30 let (str,rg1) = randomR (-2,2) rg :: (Int,StdGen) 30 str <- randomRIO (-2,2)
31 let (slr,rg2) = randomR (-2,2) rg1 :: (Int,StdGen) 31 slr <- randomRIO (-2,2)
32 let (srr,rg3) = randomR (-2,2) rg2 :: (Int,StdGen) 32 srr <- randomRIO (-2,2)
33 let (sbr,rg4) = randomR (-2,2) rg3 :: (Int,StdGen) 33 sbr <- randomRIO (-2,2)
34 roughen (w-1) (bound tr str) (bound lr slr) (bound rr srr) (bound br sbr) rg4 m2' where 34 roughen (w-1) (bound tr str) (bound lr slr) (bound rr srr) (bound br sbr) m4 where
35 bound r s 35 bound r s
36 | r + s < 1 = 1 36 | r + s < 1 = 1
37 | r + s > 50 = 50 37 | r + s > 50 = 50
@@ -40,20 +40,22 @@ module Fallen.Map.Overworld
40 -- drawClumps : add in clumps of rocks, water, and trees 40 -- drawClumps : add in clumps of rocks, water, and trees
41 clumpTypes = [Rock, Water, Forest] 41 clumpTypes = [Rock, Water, Forest]
42 clumpOver = [Rock, Water, Forest, Grass] 42 clumpOver = [Rock, Water, Forest, Grass]
43 drawClumps 0 rg m = (m,rg) 43 drawClumps :: Int -> Map -> IO Map
44 drawClumps num rg m = do 44 drawClumps 0 m = return m
45 let (area,rg1) = randomR (1,300) rg :: (Int,StdGen) 45 drawClumps num m = do
46 let (clumpType,rg2) = randomSetElement rg1 clumpTypes 46 area <- randomRIO (1,300)
47 let (startPoint,rg3) = randomPoint 0 0 149 149 rg2 47 clumpType <- randomSetElement clumpTypes
48 let (m',rg4) = drawClump area clumpType startPoint m rg3 48 startPoint <- randomPoint 0 0 149 149
49 drawClumps (num-1) rg4 m' 49 m' <- drawClump area clumpType startPoint m
50 drawClump 0 clumpType p m rg = (updateMap p clumpType m,rg) 50 drawClumps (num-1) m'
51 drawClump area clumpType p m rg = do 51 drawClump :: Int -> Tile -> Point -> Map -> IO Map
52 drawClump 0 clumpType p m = return $ updateMap p clumpType m
53 drawClump area clumpType p m = do
52 let m' = updateMap p clumpType m 54 let m' = updateMap p clumpType m
53 let legalDirs = legalMoves m' p clumpOver 55 let legalDirs = legalMoves m' p clumpOver
54 if null legalDirs 56 if null legalDirs
55 then (m',rg) 57 then return m'
56 else do 58 else do
57 let (nextDir,rg1) = randomSetElement rg legalDirs 59 nextDir <- randomSetElement legalDirs
58 let nextPoint = stepInDirection p nextDir 60 let nextPoint = stepInDirection p nextDir
59 drawClump (area-1) clumpType nextPoint m' rg1 \ No newline at end of file 61 drawClump (area-1) clumpType nextPoint m' \ No newline at end of file
diff --git a/Fallen/Point.hs b/Fallen/Point.hs index 321f3b0..0dec4bc 100644 --- a/Fallen/Point.hs +++ b/Fallen/Point.hs
@@ -34,10 +34,10 @@ module Fallen.Point
34 West -> East 34 West -> East
35 35
36 -- randomPoint :: Int -> Int -> Int -> Int -> IO Point 36 -- randomPoint :: Int -> Int -> Int -> Int -> IO Point
37 randomPoint minX minY maxX maxY rg = do 37 randomPoint minX minY maxX maxY = do
38 let (x,rg1) = randomR (minX, maxX) rg :: (Int,StdGen) 38 x <- randomRIO (minX, maxX)
39 let (y,rg2) = randomR (minY, maxY) rg1 :: (Int,StdGen) 39 y <- randomRIO (minY, maxY)
40 ((x,y),rg2) 40 return (x,y)
41 41
42 -- dirToPoint :: Point -> Point -> [Direction] 42 -- dirToPoint :: Point -> Point -> [Direction]
43 dirToPoint p1 p2 = horizDirToPoint p1 p2 ++ vertDirToPoint p1 p2 where 43 dirToPoint p1 p2 = horizDirToPoint p1 p2 ++ vertDirToPoint p1 p2 where
diff --git a/Fallen/Util.hs b/Fallen/Util.hs index dd01fff..bf528c2 100644 --- a/Fallen/Util.hs +++ b/Fallen/Util.hs
@@ -3,6 +3,6 @@ module Fallen.Util
3) where 3) where
4 import System.Random 4 import System.Random
5 5
6 randomSetElement rg set = do 6 randomSetElement set = do
7 let (index,rg') = randomR (0,length set - 1) rg :: (Int,StdGen) 7 index <- randomRIO (0, length set - 1)
8 (set !! index, rg') \ No newline at end of file 8 return $ set !! index \ No newline at end of file