diff --git a/shaders/map/fragment.shader b/shaders/map/fragment.shader index e211418..6afdbdd 100644 --- a/shaders/map/fragment.shader +++ b/shaders/map/fragment.shader @@ -96,8 +96,8 @@ float snoise(vec3 v) float fog(float dist) { dist = max(0,dist - 50); - dist = dist * 0.05; -// dist = dist*dist; + dist = dist * 0.005; + dist = dist*dist; return 1-exp(-dist); } diff --git a/src/Main.hs b/src/Main.hs index 5eb376f..a539db6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -117,7 +117,7 @@ main = do let camStack' = Map.empty glHud' <- initHud let zDistClosest' = 2 - zDistFarthest' = zDistClosest' + 10 + zDistFarthest' = zDistClosest' + 100 --TODO: Move near/far/fov to state for runtime-changability & central storage aks = ArrowKeyState { _up = False @@ -190,12 +190,13 @@ run = do cam <- readTVar (state ^. camera) game' <- readTVar (state ^. game) let + scrollFactor = 1 multc = cos $ cam ^. yAngle mults = sin $ cam ^. yAngle - modx x' = x' - 0.2 * kxrot * multc - - 0.2 * kyrot * mults - mody y' = y' + 0.2 * kxrot * mults - - 0.2 * kyrot * multc + modx x' = x' - kxrot * multc * scrollFactor + - kyrot * mults * scrollFactor + mody y' = y' + kxrot * mults * scrollFactor + - kyrot * multc * scrollFactor cam' <- return $ camObject %~ (\c -> moveBy c (\(x,y) -> (modx x,mody y)) (game' ^. currentMap)) $ cam writeTVar (state ^. camera) cam' @@ -232,7 +233,7 @@ run = do now' <- getCurrentTime return (now',tessChange,sleepAmount,ddiff,hasChanged) -- set state with new clock-time - --liftIO $ putStrLn $ unwords ["clockFactor:",show (state ^. io.tessClockFactor),"\ttc:", show (tc (state ^. gl.glMap.stateTessellationFactor)),"\tsleep ",show frameTime,"ms"] + --liftIO $ putStrLn $ unwords ["clockFactor:",show (state ^. io.tessClockFactor),"\ttc:", show (tc (state ^. gl.glMap.stateTessellationFactor)),"\tframe took ",show frameTime,"ms"] if hC then do liftIO $ putStrLn $ unwords ["modifying TessFactor to",show $ tc $ state ^. gl.glMap.stateTessellationFactor] @@ -273,7 +274,7 @@ adjustWindow = do fbHeight = state ^. window.height fov = 90 --field of view near = 1 --near plane - far = 100 --far plane + far = 500 --far plane ratio = fromIntegral fbWidth / fromIntegral fbHeight frust = createFrustum fov near far ratio liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight) diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 6de0cab..1170e66 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -7,7 +7,8 @@ fgColorIndex, fgNormalIndex, fgVertexIndex, mapStride, -getMapBufferObject +getMapBufferObject, +unitLength ) where @@ -39,6 +40,10 @@ type MapEntry = ( ) type GraphicsMap = Array (Int, Int) MapEntry +-- | length of 1 Unit in World-Coordinates +unitLength :: Double +unitLength = 10.0 + -- converts from classical x/z to striped version of a map convertToStripeMap :: PlayMap -> PlayMap convertToStripeMap mp = array (stripify l, stripify u) (map (stripify *** strp) (assocs mp)) @@ -205,6 +210,8 @@ colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0) coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat coordLookup (x,z) y = if even x then - V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight) + (f unitLength) *^ V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight) else - V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight) + (f unitLength) *^ V3 (fromIntegral (x `div` 2) + 0.5) y (fromIntegral (2 * z + 1) * lineHeight) + where + f = fromRational.toRational diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 0f8de54..78e780c 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -1,6 +1,7 @@ module Map.Map where import Map.Types +import Map.Graphics (unitLength) import Data.Array (bounds, (!)) import Data.List (sort, group) @@ -44,21 +45,23 @@ giveMapHeight :: PlayMap -> (Double, Double) -> Double giveMapHeight mop (x, z) - | outsideMap (x,z') = 0.0 - | otherwise = height --sum $ map (\(p,d) -> hlu p * (d / totald)) tups + | outsideMap (x/unitLength,z'/unitLength) = 0.0 + | otherwise = height' --sum $ map (\(p,d) -> hlu p * (d / totald)) tups where z' = z * 2/ sqrt 3 - rx = x - (fromIntegral $ floor (x +0.5)) - rz = z' - (fromIntegral $ floor (z'+0.5)) + rx = (x/unitLength) - (fromIntegral $ floor (x/unitLength )) + rz = (z'/unitLength) - (fromIntegral $ floor (z'/unitLength)) - hoi = map (hlu . clmp . tadd (floor x, floor z')) mods + hoi = map (hlu . clmp . tadd (floor (x/unitLength), floor (z'/unitLength))) mods where mods = [(0,0),(0,1),(1,0),(1,1)] tadd (a,b) (c,d) = (a+c,b+d) + height' = height*unitLength + height = --trace (show [rx,rz] ++ show hoi) - rz * (rx * (hoi !! 0) + (1-rx) * (hoi !! 2)) - + (1-rz) * (rx * (hoi !! 1) + (1-rx) * (hoi !! 3)) + (1-rz) * ((1-rx) * (hoi !! 0) + rx * (hoi !! 2)) + + rz * ((1-rx) * (hoi !! 1) + rx * (hoi !! 3)) outsideMap :: (Double, Double) -> Bool outsideMap (mx, mz) = let ((a,b),(c,d)) = bounds mop diff --git a/src/Render/Misc.hs b/src/Render/Misc.hs index c9519d0..0d7632b 100644 --- a/src/Render/Misc.hs +++ b/src/Render/Misc.hs @@ -68,13 +68,14 @@ createProgramUsing shaders = do createFrustum :: Float -> Float -> Float -> Float -> M44 CFloat createFrustum fov n' f' rat = let - f = realToFrac f' - n = realToFrac n' - s = realToFrac $ recip (tan $ fov*0.5 * pi / 180) + ff = fromRational.toRational + f = ff f' + n = ff n' + s = ff $ recip (tan $ fov*0.5 * pi / 180) (ratw,rath) = if rat > 1 then - (1,1/realToFrac rat) + (1,1/ff rat) else - (realToFrac rat,1) + (ff rat,1) in V4 (V4 (s/ratw) 0 0 0) (V4 0 (s/rath) 0 0) diff --git a/src/Render/Render.hs b/src/Render/Render.hs index bb30e73..5ce4f49 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -189,7 +189,7 @@ initMapShader tessFac (buf, vertDes) = do testobj <- parseIQM "models/holzfaellerHaus1.iqm" cube <- parseIQM "models/box.iqm" - let objs = [ MapObject testobj (L.V3 20 3 20) (MapObjectState ()) + let objs = [ MapObject testobj (L.V3 20 10 20) (MapObjectState ()) , MapObject cube (L.V3 25 5 25) (MapObjectState ()) ] diff --git a/src/Types.hs b/src/Types.hs index 1a5c435..28908a2 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -9,7 +9,7 @@ import qualified Data.HashMap.Strict as Map import Data.Time (UTCTime) import Linear.Matrix (M44) import Linear (V3) -import Control.Monad.RWS.Strict (RWST, liftIO, get) +import Control.Monad.RWS.Strict (RWST, get) import Control.Monad.Writer.Strict --import Control.Monad (when) import Control.Lens diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index bb60306..3696453 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -123,7 +123,7 @@ eventCallback e = do state <- get liftIO $ atomically $ do cam <- readTVar (state ^. camera) - let zDist' = (cam ^. zDist) + realToFrac (negate vscroll) + let zDist' = (cam ^. zDist) + 4*realToFrac (negate vscroll) zDist'' = curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist' cam' <- return $ zDist .~ zDist'' $ cam writeTVar (state ^. camera) cam'