diff options
-rw-r--r-- | Fallen/Map/Overworld.hs | 68 | ||||
-rw-r--r-- | Fallen/Point.hs | 8 | ||||
-rw-r--r-- | Fallen/Util.hs | 6 | ||||
-rw-r--r-- | Main.hs | 21 |
4 files changed, 52 insertions, 51 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 |
diff --git a/Main.hs b/Main.hs index 4908c59..4b859fb 100644 --- a/Main.hs +++ b/Main.hs | |||
@@ -8,32 +8,31 @@ module Main where | |||
8 | 8 | ||
9 | -- main :: () | 9 | -- main :: () |
10 | main = do | 10 | main = do |
11 | rg <- getStdGen | 11 | m <- initOverworld |
12 | let (m,rg') = initOverworld rg | ||
13 | initCurses | 12 | initCurses |
14 | keypad stdScr True | 13 | keypad stdScr True |
15 | echo False | 14 | echo False |
16 | cursSet CursorInvisible | 15 | cursSet CursorInvisible |
17 | startColor | 16 | startColor |
18 | mainLoop (75,75) m rg' | 17 | mainLoop (75,75) m |
19 | endWin | 18 | endWin |
20 | 19 | ||
21 | mainLoop player m rg = do | 20 | mainLoop player m = do |
22 | render player m | 21 | render player m |
23 | input <- getCh | 22 | input <- getCh |
24 | case input of | 23 | case input of |
25 | KeyLeft -> moveIfPassable player m rg West | 24 | KeyLeft -> moveIfPassable player m West |
26 | KeyRight -> moveIfPassable player m rg East | 25 | KeyRight -> moveIfPassable player m East |
27 | KeyUp -> moveIfPassable player m rg North | 26 | KeyUp -> moveIfPassable player m North |
28 | KeyDown -> moveIfPassable player m rg South | 27 | KeyDown -> moveIfPassable player m South |
29 | _ -> putStrLn "endgame" | 28 | _ -> putStrLn "endgame" |
30 | 29 | ||
31 | moveIfPassable player m rg dir = do | 30 | moveIfPassable player m dir = do |
32 | let p' = stepInDirection player dir | 31 | let p' = stepInDirection player dir |
33 | let t' = getTileAtPos m p' | 32 | let t' = getTileAtPos m p' |
34 | if t' `elem` passableTiles | 33 | if t' `elem` passableTiles |
35 | then mainLoop p' m rg | 34 | then mainLoop p' m |
36 | else mainLoop player m rg | 35 | else mainLoop player m |
37 | 36 | ||
38 | -- render :: Point -> Map -> Window -> () | 37 | -- render :: Point -> Map -> Window -> () |
39 | render (px,py) m = do | 38 | render (px,py) m = do |