Restructured Node constructors. Ripples are getting worse! (╯°□°）╯︵ ┻━┻

Pioneers.cabal

@@ -16,7 +16,6 @@ executable Pioneers
                    Map.Types,
                    Map.Graphics,
                    Map.Creation,
-                   Map.StaticMaps,
                    Importer.IQM.Types,
                    Importer.IQM.Parser,
                    Render.Misc,

src/Map/Creation.hs

@@ -2,7 +2,6 @@ module Map.Creation
 where
 
 import Map.Types
-import Map.StaticMaps
 -- import Map.Map unused (for now)
 
 import Data.Array
@@ -18,6 +17,10 @@ infix 5 -<-
 (-<-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
 f -<- g = f . g
 
+-- entirely empty map, only uses the minimal constructor
+mapEmpty :: PlayMap
+mapEmpty = array ((0,0), (199,199)) [((a,b), Node (a,b) (fromIntegral a, (if even b then (fromIntegral b) else(fromIntegral b) - 0.5), 1) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199]]
+
 exportedMap :: IO PlayMap
 exportedMap = do mounts <- mnt
                  return $ aplAll mounts mapEmpty
@@ -52,7 +55,7 @@ gauss3Dgeneral :: Floating q =>
                   -> q -- ^ Coordinate in question on X
                   -> q -- ^ Coordinate in question on Z
                   -> q -- ^ elevation on coordinate in question
-gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Integer)/(2 * sX^(2 :: Integer)))+((z-z0)^(2 :: Integer)/(2 * sZ^(2 :: Integer)))))
+gauss3Dgeneral amp x0 z0 sX sZ x z = amp * exp(-(((x-x0)^(2 :: Int)/(2 * sX^(2 :: Int)))+((z-z0)^(2 :: Int)/(2 * sZ^(2 :: Int)))))
 
 -- specialised 3D gaussian with an origin on 100/100, an amplitude of 15 and two sigmas of 15
 gauss3D :: Floating q =>
@@ -71,8 +74,8 @@ mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
 --   TODO: Implement Desert-Generator
 heightToTerrain :: MapType -> YCoord -> TileType
 heightToTerrain GrassIslandMap y
-                | y < 0.1   = Ocean
+	| y < 0.1   = Ocean
-                | y < 1     = Beach
+	| y < 1     = Beach
                 | y < 5     = Grass
                 | y < 10    = Hill
                 | otherwise = Mountain
@@ -93,20 +96,17 @@ mnt = do g <- newStdGen
 gaussMountain :: Int -> PlayMap -> PlayMap
 gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp
   where
-    g   = mkStdGen seed
+    gs  = map mkStdGen (map (*seed) [1..])
-    c   = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g)))
+    c   = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) (gs !! 0)), (head (randomRs (b,y) (gs !! 1))))
-    amp = head $ randomRs (5.0, 20.0) g
+    amp = head $ randomRs ((5.0, 20.0) :: (Float, Float)) (gs !! 2)
-    sig = head $ randomRs (5.0, 25.0) g
+    sig = head $ randomRs ((5.0, 25.0) :: (Float, Float)) (gs !! 3)
-    fi  = fromIntegral
     htt = heightToTerrain
 
     -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map
     liftUp :: (Int, Int) -> Node -> Node
-    liftUp (gx,gz) (Full     (x,z) y _ b pl pa r s) = let y_neu = max y e
+    liftUp (gx,gz) (Node (x,z) (rx,rz,y) _ b pl pa r s) = let y_neu = max y e
-                                                      in  Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s
+                                                          in  Node (x,z) (rx, rz, y_neu) (htt GrassIslandMap y_neu) b pl pa r s
-      where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z)
+      where e = gauss3Dgeneral amp (fromIntegral gx) (fromIntegral gz) sig sig rx rz
-    liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain []
-      where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z)
 
 -- | Makes sure the edges of the Map are mountain-free
 makeIsland :: PlayMap -> PlayMap

src/Map/Graphics.hs

@@ -50,16 +50,14 @@ stripify :: (Int,Int) -> (Int,Int)
 stripify (x,z) = (if even z then 2*x else 2*x+1, z `div` 2)
 
 strp :: Node -> Node
-strp (Full    xz y tt bi pli p ri si) = Full    (stripify xz) y tt bi pli p ri si
+strp (Node i (x,z,y) tt bi pli p ri si) = Node (stripify i) (x,z,y) tt bi pli p ri si
-strp (Minimal xz                    ) = Minimal (stripify xz)
 
 -- extract graphics information from Playmap
 convertToGraphicsMap :: PlayMap -> GraphicsMap
 convertToGraphicsMap mp = array (bounds mp) [(i, graphicsyfy (mp ! i))| i <- indices mp]
     where
       graphicsyfy :: Node -> MapEntry
-      graphicsyfy (Minimal _               ) = (1.0, Grass)
+      graphicsyfy (Node _ (_,_,y) t _ _ _ _ _ ) = (y, t)
-      graphicsyfy (Full    _ y t _ _ _ _ _ ) = (y, t)
 
 lineHeight :: GLfloat
 lineHeight = 0.8660254

src/Map/Map.hs

@@ -61,10 +61,7 @@ giveMapHeight mp (x,z) = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc]
 
     -- Height LookUp
     hlu :: (Int, Int) -> Float
-    hlu (k,j) = let node = mp ! (k,j)
+    hlu (k,j) = let (Node _ (_,_,y) _ _ _ _ _ _) = mp ! (k,j) in y
-                in  case node of
-                    (Full    _ y _ _ _ _ _ _) -> y
-                    (Minimal _              ) -> 1.0
 
     ff  = (floor   x, floor   z) :: (Int, Int)
     fc  = (floor   x, ceiling z) :: (Int, Int)

src/Map/StaticMaps.hs

@@ -1,49 +0,0 @@
-module Map.StaticMaps
-where
-
-import Map.Types
-import Data.Array
-
--- entirely empty map, only uses the minimal constructor
-mapEmpty :: PlayMap
-mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]]
-
---mapCenterMountain :: PlayMap
---mapCenterMountain = array ((0,0),(199,199)) nodes
---    where
---      nodes    = water ++ beach ++ grass ++ hill ++ mountain
---      water    = [((a,b), Full (a,b) 0.0       Ocean    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) > 95]
---      beach    = [((a,b), Full (a,b) (g2d a b) Beach    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 95, m2d (a,b) > 75]
---      grass    = [((a,b), Full (a,b) (g2d a b) Grass    BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 75, m2d (a,b) > 25]
---      hill     = [((a,b), Full (a,b) (g2d a b) Hill     BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 25, m2d (a,b) > 10]
---      mountain = [((a,b), Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 10]
-
---      g2d :: Int -> Int -> Float
---      g2d x y = gauss3D (fromIntegral x) (fromIntegral y)
-
---      m2d :: (Int,Int) -> Int
---      m2d (x,y) = mnh2D (x,y) (100,100)
-
--- small helper for some hills. Should be replaced by multi-layer perlin-noise
--- TODO: Replace as given in comment.
---_noisyMap :: (Floating q) => q -> q -> q
---_noisyMap x y =    gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y
---                +  gauss3Dgeneral 5  10.0 10.0 10.0 10.0 x y
---                +  gauss3Dgeneral 5  150.0 120.0 10.0 10.0 x y
---                +  gauss3Dgeneral 5  50.0 75.0 10.0 10.0 x y
-
--- generates a noisy map
--- TODO: add real noise to a simple pattern
---mapNoise :: PlayMap
---mapNoise = array ((0,0),(199,199)) nodes
---    where
---      nodes    = [((a,b), Full (a,b)
---                               (height a b)
---                               (heightToTerrain GrassIslandMap $ height a b)
---                               BNothing
---                               NoPlayer
---                               NoPath
---                               Plain
---                               []) | a <- [0..199], b <- [0..199]]
---                 where
---                    height a b = _noisyMap (fromIntegral a) (fromIntegral b)

src/Map/Types.hs

@@ -5,10 +5,12 @@ import Types
 
 import Data.Array
 
-type PlayMap = Array (XCoord, ZCoord) Node 
+type PlayMap = Array (Xindex, Zindex) Node 
 
-type XCoord  = Int
+type Xindex  = Int
-type ZCoord  = Int
+type Zindex  = Int
+type XCoord  = Float
+type ZCoord  = Float
 type YCoord  = Float
 
 data MapType    = GrassIslandMap
@@ -66,7 +68,6 @@ data TileType   = Ocean
                 | Mountain -- ^ Not accessible
                 deriving (Show, Eq)
 
--- TODO: Record Syntax
+-- TODO: Record Syntax?
-data Node = Full    (XCoord, ZCoord) YCoord TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
+data Node = Node (Xindex, Zindex) (XCoord, ZCoord, YCoord) TileType BuildInfo PlayerInfo PathInfo ResInfo StorInfo
-          | Minimal (XCoord, ZCoord) -- defaults to empty green grass node on height 1
           deriving (Show)