Camera function not NaNing / breaking anymore / merge tessalation

src/Map/Creation.hs

@@ -2,21 +2,10 @@ module Map.Creation
 where
 
 import Map.Types
--- import Map.Map unused (for now)
 
 import Data.Array
 import System.Random
 
--- preliminary
-infix 5 ->-
-(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
-f ->- g = g . f
-
--- also preliminary
-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]]
@@ -57,17 +46,6 @@ gauss3Dgeneral :: Floating q =>
                   -> q -- ^ elevation on coordinate in question
 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 =>
-           q     -- ^ X-Coordinate
-           -> q  -- ^ Z-Coordinate
-           -> q  -- ^ elevation on coordinate in quesion
-gauss3D = gauss3Dgeneral 15 100.0 100.0 15.0 15.0
-
--- 2D Manhattan distance
-mnh2D :: (Int,Int) -> (Int,Int) -> Int
-mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
-
 -- | Basic Terrain-Generator. Will not implement "abnormal" Stuff for given Biome
 --   (like Deserts on Grass-Islands or Grass on Deserts)
 --
@@ -75,9 +53,9 @@ mnh2D (a,b) (c,d) = abs (a-c) + abs (b-d)
 heightToTerrain :: MapType -> YCoord -> TileType
 heightToTerrain GrassIslandMap y
                 | y < 0.1   = Ocean
-                | y < 0.2     = Beach
+                | y < 0.2   = Beach
                 | y < 1     = Grass
-                | y < 3    = Hill
+                | y < 3     = Hill
                 | otherwise = Mountain
 heightToTerrain _ _ = undefined
 

src/Map/Map.hs

@@ -1,7 +1,6 @@
 module Map.Map where
 
 import Map.Types
-import Map.Creation
 
 import Data.Function (on)
 import Data.Array    (bounds, (!))
@@ -48,14 +47,32 @@ giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in
 giveMapHeight :: PlayMap
               -> (Float, Float)  -- ^ Coordinates on X/Z-axes 
               -> Float           -- ^ Terrain Height at that position
-giveMapHeight mp (x,z) = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc]
+giveMapHeight mp (x,z)
-                             ar = area (fi a) (fi b) (fi c)
+  | outsideMap (x,z)           = 0.0
-                             λa = area (fi b) (fi c) (x, z) / ar
+  | (isInt z 6) && (isInt x 6) = hlu (round x, round z)
-                             λb = area (fi a) (fi c) (x, z) / ar
+  | (isInt z 6)                = let dist_down = x - fromIntegral ((floor x) :: Int)
-                             λc = area (fi a) (fi b) (x, z) / ar
+                                     dist_up   = fromIntegral ((ceiling x) :: Int) - x
-                         in  (λa * hlu a) + (λb * hlu b) + (λc * hlu c)
+                                 in  (1 - dist_down) * (hlu (floor x, round z)) + (1 - dist_up) * (hlu (ceiling x, round z))
+  |                (isInt x 6) = let dist_down = z - fromIntegral ((floor z) :: Int)
+                                     dist_up   = fromIntegral ((ceiling z) :: Int) - z
+                                 in  (1 - dist_down) * (hlu (round x, floor z)) + (1 - dist_up) * (hlu (round x, ceiling z))
+  | otherwise                  = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc]
+                                     ar = area (fi a) (fi b) (fi c)
+                                     λa = area (fi b) (fi c) (x, z) / ar
+                                     λb = area (fi a) (fi c) (x, z) / ar
+                                     λc = area (fi a) (fi b) (x, z) / ar
+                                 in  (λa * hlu a) + (λb * hlu b) + (λc * hlu c)
   where
 
+    --Returns if q is an int to n decimal places
+    isInt :: RealFrac b => b -> Int -> Bool
+    isInt q n = (round $ 10^((fromIntegral n) :: Integer) * (q - (fromIntegral ((round q):: Integer)))) == (0 :: Integer)
+
+    outsideMap :: (Float, Float) -> Bool
+    outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mp
+                              fr = fromIntegral
+                          in  mx < (fr a) || mx > (fr c) || mz < (fr b) || mz > (fr d)
+ 
     fi :: (Int, Int) -> (Float, Float)
     fi (m, n) = (fromIntegral m, fromIntegral n)