From 94fc90c32fb9d6694a95a9c191553aa39eabd10a Mon Sep 17 00:00:00 2001 From: Kelly Rauchenberger Date: Tue, 2 Apr 2013 01:57:09 -0400 Subject: Got rid of pure functional randomness and started using IO monad --- Fallen/Map/Overworld.hs | 68 +++++++++++++++++++++++++------------------------ Fallen/Point.hs | 8 +++--- Fallen/Util.hs | 6 ++--- 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 import Fallen.Point -- initOverworld : generate the overworld - initOverworld rg = do + initOverworld = 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) + let m1 = fillMapRect 0 0 150 150 Grass m -- fill with grass + tr <- randomRIO (1,50) + lr <- randomRIO (1,50) + rr <- randomRIO (1,50) + br <- randomRIO (1,50) + m2 <- roughen 150 tr lr rr br m1 -- add surrounding forest + clumps <- randomRIO (30,60) + m3 <- drawClumps clumps m2 + return m3 -- 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 + roughen 0 _ _ _ _ m = return m + roughen w tr lr rr br m = do + let m1 = fillMapRect (w-1) 0 1 tr Forest m + let m2 = fillMapRect 0 (w-1) lr 1 Forest m1 + let m3 = fillMapRect (150-rr-1) (w-1) rr 1 Forest m2 + let m4 = fillMapRect (w-1) (150-br-1) 1 br Forest m3 + str <- randomRIO (-2,2) + slr <- randomRIO (-2,2) + srr <- randomRIO (-2,2) + sbr <- randomRIO (-2,2) + roughen (w-1) (bound tr str) (bound lr slr) (bound rr srr) (bound br sbr) m4 where bound r s | r + s < 1 = 1 | r + s > 50 = 50 @@ -40,20 +40,22 @@ module Fallen.Map.Overworld -- 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 + drawClumps :: Int -> Map -> IO Map + drawClumps 0 m = return m + drawClumps num m = do + area <- randomRIO (1,300) + clumpType <- randomSetElement clumpTypes + startPoint <- randomPoint 0 0 149 149 + m' <- drawClump area clumpType startPoint m + drawClumps (num-1) m' + drawClump :: Int -> Tile -> Point -> Map -> IO Map + drawClump 0 clumpType p m = return $ updateMap p clumpType m + drawClump area clumpType p m = do let m' = updateMap p clumpType m let legalDirs = legalMoves m' p clumpOver if null legalDirs - then (m',rg) + then return m' else do - let (nextDir,rg1) = randomSetElement rg legalDirs + nextDir <- randomSetElement legalDirs let nextPoint = stepInDirection p nextDir - drawClump (area-1) clumpType nextPoint m' rg1 \ No newline at end of file + 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 West -> East -- randomPoint :: Int -> Int -> Int -> Int -> IO Point - randomPoint minX minY maxX maxY rg = do - let (x,rg1) = randomR (minX, maxX) rg :: (Int,StdGen) - let (y,rg2) = randomR (minY, maxY) rg1 :: (Int,StdGen) - ((x,y),rg2) + randomPoint minX minY maxX maxY = do + x <- randomRIO (minX, maxX) + y <- randomRIO (minY, maxY) + return (x,y) -- dirToPoint :: Point -> Point -> [Direction] 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 ) where import System.Random - randomSetElement rg set = do - let (index,rg') = randomR (0,length set - 1) rg :: (Int,StdGen) - (set !! index, rg') \ No newline at end of file + randomSetElement set = do + index <- randomRIO (0, length set - 1) + 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 -- main :: () main = do - rg <- getStdGen - let (m,rg') = initOverworld rg + m <- initOverworld initCurses keypad stdScr True echo False cursSet CursorInvisible startColor - mainLoop (75,75) m rg' + mainLoop (75,75) m endWin - mainLoop player m rg = do + mainLoop player m = do render player m input <- getCh case input of - KeyLeft -> moveIfPassable player m rg West - KeyRight -> moveIfPassable player m rg East - KeyUp -> moveIfPassable player m rg North - KeyDown -> moveIfPassable player m rg South + KeyLeft -> moveIfPassable player m West + KeyRight -> moveIfPassable player m East + KeyUp -> moveIfPassable player m North + KeyDown -> moveIfPassable player m South _ -> putStrLn "endgame" - moveIfPassable player m rg dir = do + moveIfPassable player m dir = do let p' = stepInDirection player dir let t' = getTileAtPos m p' if t' `elem` passableTiles - then mainLoop p' m rg - else mainLoop player m rg + then mainLoop p' m + else mainLoop player m -- render :: Point -> Map -> Window -> () render (px,py) m = do -- cgit 1.4.1