about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--Fallen/Map/Overworld.hs68
-rw-r--r--Fallen/Point.hs8
-rw-r--r--Fallen/Util.hs6
-rw-r--r--Main.hs21
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