From f2fbf101ef8c24380573af789c8abe0d2df83fa8 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Fri, 16 May 2014 11:30:15 +0200 Subject: [PATCH] Camera function not NaNing / breaking anymore / merge tessalation --- src/Map/Creation.hs | 26 ++------------------------ src/Map/Map.hs | 31 ++++++++++++++++++++++++------- 2 files changed, 26 insertions(+), 31 deletions(-) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index 944d2b9..91faee9 100644 --- a/src/Map/Creation.hs +++ b/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 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 53a0976..98c5912 100644 --- a/src/Map/Map.hs +++ b/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] - 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) +giveMapHeight mp (x,z) + | outsideMap (x,z) = 0.0 + | (isInt z 6) && (isInt x 6) = hlu (round x, round z) + | (isInt z 6) = let dist_down = x - fromIntegral ((floor x) :: Int) + dist_up = fromIntegral ((ceiling x) :: Int) - x + 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)