From e77c8b23c148ffaa5991da18c981e61db2a5e55c Mon Sep 17 00:00:00 2001
From: Kelly Rauchenberger <fefferburbia@gmail.com>
Date: Mon, 1 Apr 2013 23:01:59 -0400
Subject: Initial commit

Haskell version now has most of the functionality from the C++ version, except for color, and
overworld generation is REALLY slow.
---
 Fallen/Map/Overworld.hs | 59 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100644 Fallen/Map/Overworld.hs

(limited to 'Fallen/Map/Overworld.hs')

diff --git a/Fallen/Map/Overworld.hs b/Fallen/Map/Overworld.hs
new file mode 100644
index 0000000..308aad0
--- /dev/null
+++ b/Fallen/Map/Overworld.hs
@@ -0,0 +1,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
\ No newline at end of file
-- 
cgit 1.4.1