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

compensating for stripe depth

Browse Source
This commit is contained in:
Jonas Betzendahl 2014-05-16 15:58:07 +02:00
parent 1c1aedda30
commit 15d55e1577
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Map/Graphics.hs
View File

@ -30,7 +30,6 @@ import Linear
import Control.Arrow ((***)) import Control.Arrow ((***))
import Map.Types import Map.Types
import Map.Creation
type Height = Float type Height = Float

23
src/Map/Map.hs
View File

@ -48,14 +48,14 @@ giveMapHeight :: PlayMap
-> (Float, Float) -- ^ Coordinates on X/Z-axes -> (Float, Float) -- ^ Coordinates on X/Z-axes
-> Float -- ^ Terrain Height at that position -> Float -- ^ Terrain Height at that position
giveMapHeight mp (x,z) giveMapHeight mp (x,z)
| outsideMap (x,z) = 0.0 | outsideMap (x',z) = 0.0
| (isInt z 6) && (isInt x 6) = hlu (round x, round z) | (isInt z 6) && (isInt x' 6) = hlu (round x', round z)
| (isInt z 6) = let dist_down = x - fromIntegral ((floor x) :: Int) | (isInt z 6) = let dist_down = x' - fromIntegral ((floor x') :: Int)
dist_up = fromIntegral ((ceiling x) :: Int) - x dist_up = fromIntegral ((ceiling x') :: Int) - x'
in (1 - dist_down) * (hlu (floor x, round z)) + (1 - dist_up) * (hlu (ceiling x, round z)) 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) | (isInt x' 6) = let dist_down = z - fromIntegral ((floor z) :: Int)
dist_up = fromIntegral ((ceiling z) :: Int) - z dist_up = fromIntegral ((ceiling z) :: Int) - z
in (1 - dist_down) * (hlu (round x, floor z)) + (1 - dist_up) * (hlu (round x, ceiling 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] | otherwise = let [a,b,c] = getTrianglePoints [tff,tfc,tcf,tcc]
ar = area (fi a) (fi b) (fi c) ar = area (fi a) (fi b) (fi c)
λa = area (fi b) (fi c) (x, z) / ar λa = area (fi b) (fi c) (x, z) / ar
@ -64,6 +64,9 @@ giveMapHeight mp (x,z)
in (λa * hlu a) + (λb * hlu b) + (λc * hlu c) in (λa * hlu a) + (λb * hlu b) + (λc * hlu c)
where where
-- compensating
x' = x * ((sqrt 3) / 2)
--Returns if q is an int to n decimal places --Returns if q is an int to n decimal places
isInt :: RealFrac b => b -> Int -> Bool isInt :: RealFrac b => b -> Int -> Bool
isInt q n = (round $ 10^((fromIntegral n) :: Integer) * (q - (fromIntegral ((round q):: Integer)))) == (0 :: Integer) isInt q n = (round $ 10^((fromIntegral n) :: Integer) * (q - (fromIntegral ((round q):: Integer)))) == (0 :: Integer)
@ -94,9 +97,9 @@ giveMapHeight mp (x,z)
getTrianglePoints = ((take 3) . (map fst) . (sortBy (compare `on` snd))) getTrianglePoints = ((take 3) . (map fst) . (sortBy (compare `on` snd)))
dist :: (Float, Float) -> (Int, Int) -> Float dist :: (Float, Float) -> (Int, Int) -> Float
dist (x1,z1) (x2,z2) = let x' = x1 - fromIntegral x2 dist (x1,z1) (x2,z2) = let xf = x1 - fromIntegral x2
z' = z1 - fromIntegral z2 zf = z1 - fromIntegral z2
in sqrt $ x'*x' + z'*z' in sqrt $ xf*xf + zf*zf
-- Heron's Formula: http://en.wikipedia.org/wiki/Heron%27s_formula -- Heron's Formula: http://en.wikipedia.org/wiki/Heron%27s_formula
area :: (Float, Float) -> (Float, Float) -> (Float, Float) -> Float area :: (Float, Float) -> (Float, Float) -> (Float, Float) -> Float