Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Camera function not NaNing / breaking anymore / merge tessalation

Browse Source
This commit is contained in:
Jonas Betzendahl
2014-05-16 11:30:15 +02:00
parent 4285cefa31
commit f2fbf101ef
2 changed files with 26 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
src/Map/Creation.hs
View File

@@ -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

31
src/Map/Map.hs
View File

@@ -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)