From f5f1f760cda8d82835389ada0da71cf7e83be56e Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Sun, 27 Apr 2014 23:49:15 +0200 Subject: [PATCH 01/18] Added first test suite with first test (questionable .cabal though) --- Pioneers.cabal | 31 +++++++++++++++++++++++++++++++ src/Map/Map.hs | 2 +- tests/MainTestSuite.hs | 20 ++++++++++++++++++++ 3 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 tests/MainTestSuite.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index 4aad55e..633c0c5 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -12,6 +12,8 @@ executable Pioneers ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm } other-modules: + Map.Map, + Map.Combinators, Map.Types, Map.Graphics, Map.Creation, @@ -49,3 +51,32 @@ executable Pioneers attoparsec-binary >= 0.1 Default-Language: Haskell2010 +test-suite QuickCheckTests + type: exitcode-stdio-1.0 + hs-source-dirs: tests, src + main-is: MainTestSuite.hs + build-depends: base, + OpenGL >=2.9, + bytestring >=0.10, + OpenGLRaw >=1.4, + text >=0.11, + array >=0.4, + random >=1.0.1, + transformers >=0.3.0, + unordered-containers >= 0.2.1, + hashable >= 1.0.1.1, + mtl >=2.1.2, + stm >=2.4.2, + vector >=0.10.9 && <0.11, + distributive >=0.3.2, + linear >=1.3.1, + lens >=4.0, + SDL2 >= 0.1.0, + time >=1.4.0, + GLUtil >= 0.7, + attoparsec >= 0.11.2, + attoparsec-binary >= 0.1, + QuickCheck, + test-framework, + test-framework-quickcheck2 + Default-Language: Haskell2010 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index e358cee..ba697c0 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -40,5 +40,5 @@ giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in remdups :: Ord a => [a] -> [a] remdups = map head . group . sort -prop_rd_idempot :: Ord a => [a] -> Bool +prop_rd_idempot :: [Int] -> Bool prop_rd_idempot xs = remdups xs == (remdups . remdups) xs diff --git a/tests/MainTestSuite.hs b/tests/MainTestSuite.hs new file mode 100644 index 0000000..9c46a05 --- /dev/null +++ b/tests/MainTestSuite.hs @@ -0,0 +1,20 @@ +module Main where + +import Test.Framework +import Test.Framework.Providers.QuickCheck2 + +import Map.Map + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = + [ + testGroup "Map.Map" + [ + testProperty "remdups idempotency" prop_rd_idempot + ] + ] + + From 777c868de0aee39f58d272c7f5ebdb2abddfdc83 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Mon, 28 Apr 2014 10:37:31 +0200 Subject: [PATCH 02/18] Fixed shadowing in aplAll --- src/Map/Creation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index d677cdd..da0a12b 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -31,7 +31,7 @@ aplByNode :: (Node -> Node) -> (Node -> Bool) -> PlayMap -> PlayMap aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) else (ab,c))) (assocs mp)) aplAll :: [a -> a] -> a -> a -aplAll fs m = foldl (\ m f -> f m) m fs +aplAll fs m = foldl (\ n f -> f n) m fs -- general 3D-Gaussian gauss3Dgeneral :: Floating q => From 07dac9aad1bc0955d49bc2b32fd181fd72b9e523 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Mon, 28 Apr 2014 16:34:13 +0200 Subject: [PATCH 03/18] Added first test suite for Mapping --- Pioneers.cabal | 5 +++-- src/Map/Map.hs | 3 --- tests/MainTestSuite.hs | 20 -------------------- tests/Map/MapTestSuite.hs | 23 +++++++++++++++++++++++ 4 files changed, 26 insertions(+), 25 deletions(-) delete mode 100644 tests/MainTestSuite.hs create mode 100644 tests/Map/MapTestSuite.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index 633c0c5..de59517 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -53,8 +53,8 @@ executable Pioneers test-suite QuickCheckTests type: exitcode-stdio-1.0 - hs-source-dirs: tests, src - main-is: MainTestSuite.hs + hs-source-dirs: tests/Map, src + main-is: MapTestSuite.hs build-depends: base, OpenGL >=2.9, bytestring >=0.10, @@ -78,5 +78,6 @@ test-suite QuickCheckTests attoparsec-binary >= 0.1, QuickCheck, test-framework, + test-framework-th, test-framework-quickcheck2 Default-Language: Haskell2010 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index ba697c0..7ea3593 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -39,6 +39,3 @@ giveNeighbourhood mp n (a,b) = let ns = giveNeighbours mp (a,b) in -- removing duplicates in O(n log n), losing order and adding Ord requirement remdups :: Ord a => [a] -> [a] remdups = map head . group . sort - -prop_rd_idempot :: [Int] -> Bool -prop_rd_idempot xs = remdups xs == (remdups . remdups) xs diff --git a/tests/MainTestSuite.hs b/tests/MainTestSuite.hs deleted file mode 100644 index 9c46a05..0000000 --- a/tests/MainTestSuite.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Main where - -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Map.Map - -main :: IO () -main = defaultMain tests - -tests :: [Test] -tests = - [ - testGroup "Map.Map" - [ - testProperty "remdups idempotency" prop_rd_idempot - ] - ] - - diff --git a/tests/Map/MapTestSuite.hs b/tests/Map/MapTestSuite.hs new file mode 100644 index 0000000..e6a715d --- /dev/null +++ b/tests/Map/MapTestSuite.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Main where + +import Test.QuickCheck + +import Test.Framework +import Test.Framework.TH +import Test.Framework.Providers.QuickCheck2 + +import Map.Map + +main :: IO () +main = $(defaultMainGenerator) + +prop_rd_idempot :: [Int] -> Bool +prop_rd_idempot xs = remdups xs == (remdups . remdups) xs + +prop_rd_length :: [Int] -> Bool +prop_rd_length xs = length (remdups xs) <= length xs + +prop_rd_sorted :: [Int] -> Property +prop_rd_sorted xs = (not . null) xs ==> head (remdups xs) == minimum xs From 6c4e63f085d70acf8ac2679d3bd26d87f19b35db Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Tue, 29 Apr 2014 00:18:38 +0200 Subject: [PATCH 04/18] cosmetics --- Pioneers.cabal | 2 +- src/Map/Combinators.hs | 2 +- src/Map/Creation.hs | 12 +----------- 3 files changed, 3 insertions(+), 13 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index de59517..ec1f70a 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -51,7 +51,7 @@ executable Pioneers attoparsec-binary >= 0.1 Default-Language: Haskell2010 -test-suite QuickCheckTests +test-suite MapTests type: exitcode-stdio-1.0 hs-source-dirs: tests/Map, src main-is: MapTestSuite.hs diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs index 9dabb89..7837fac 100644 --- a/src/Map/Combinators.hs +++ b/src/Map/Combinators.hs @@ -31,7 +31,7 @@ gaussMountain :: Int -> PlayMap -> PlayMap gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp where g = mkStdGen seed - c = head $ randomRs (bounds mp) g + c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g))) amp = head $ randomRs (5.0, 20.0) g sig = head $ randomRs (5.0, 25.0) g fi = fromIntegral diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index da0a12b..b5d4ec3 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -2,19 +2,9 @@ module Map.Creation where import Map.Types -import Map.Map +-- import Map.Map unused (for now) import Data.Array -import System.Random - --- Orphan instance since this isn't where either Random nor Tuples are defined -instance (Random x, Random y) => Random (x, y) where - randomR ((x1, y1), (x2, y2)) gen1 = let (a, gen2) = randomR (x1, x2) gen1 - (b, gen3) = randomR (y1, y2) gen2 - in ((a, b), gen3) - - random gen1 = let (a, gen2) = random gen1 - (b, gen3) = random gen2 in ((a,b), gen3) -- | Generate a new Map of given Type and Size -- From 683b72a413b356d99635d31ddc6ed0fae9e22955 Mon Sep 17 00:00:00 2001 From: Jonas Betzendahl Date: Tue, 29 Apr 2014 01:05:05 +0200 Subject: [PATCH 05/18] Refactoring & more cosmetics --- Pioneers.cabal | 1 - src/Map/Combinators.hs | 46 ------------------------------ src/Map/Creation.hs | 53 +++++++++++++++++++++++++++++++++++ src/Map/Graphics.hs | 6 ++-- src/Map/StaticMaps.hs | 63 +++++++++++++++++++++--------------------- 5 files changed, 86 insertions(+), 83 deletions(-) delete mode 100644 src/Map/Combinators.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index ec1f70a..fadfec1 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -13,7 +13,6 @@ executable Pioneers } other-modules: Map.Map, - Map.Combinators, Map.Types, Map.Graphics, Map.Creation, diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs deleted file mode 100644 index 7837fac..0000000 --- a/src/Map/Combinators.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Map.Combinators where - -import Map.Types -import Map.Creation - -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 - -lake :: Int -> PlayMap -> PlayMap -lake = undefined - -river :: Int -> PlayMap -> PlayMap -river = undefined - -mnt :: IO [PlayMap -> PlayMap] -mnt = do g <- newStdGen - let seeds = take 10 $ randoms g - return $ map gaussMountain seeds - -gaussMountain :: Int -> PlayMap -> PlayMap -gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp - where - g = mkStdGen seed - c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g))) - amp = head $ randomRs (5.0, 20.0) g - sig = head $ randomRs (5.0, 25.0) g - fi = fromIntegral - htt = heightToTerrain - - -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map - liftUp :: (Int, Int) -> Node -> Node - liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e - in Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s - where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) - liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] - where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) diff --git a/src/Map/Creation.hs b/src/Map/Creation.hs index b5d4ec3..554cb6c 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -2,9 +2,25 @@ module Map.Creation where import Map.Types +import Map.StaticMaps -- 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 + +exportedMap :: IO PlayMap +exportedMap = do mounts <- mnt + return $ aplAll mounts mapEmpty -- | Generate a new Map of given Type and Size -- @@ -23,6 +39,9 @@ aplByNode f g mp = array (bounds mp) (map (\(ab,c) -> (if g c then (ab, f c) els aplAll :: [a -> a] -> a -> a aplAll fs m = foldl (\ n f -> f n) m fs +aplAllM :: Monad m => [m a -> m a] -> m a -> m a +aplAllM fs x = foldl (\ n f -> f n) x fs + -- general 3D-Gaussian gauss3Dgeneral :: Floating q => q -- ^ Amplitude @@ -58,3 +77,37 @@ heightToTerrain GrassIslandMap y | y < 10 = Hill | otherwise = Mountain heightToTerrain _ _ = undefined + + +lake :: Int -> PlayMap -> PlayMap +lake = undefined + +river :: Int -> PlayMap -> PlayMap +river = undefined + +mnt :: IO [PlayMap -> PlayMap] +mnt = do g <- newStdGen + let seeds = take 10 $ randoms g + return $ map (gaussMountain) seeds + +gaussMountain :: Int -> PlayMap -> PlayMap +gaussMountain seed mp = aplByPlace (liftUp c) (\(_,_) -> True) mp + where + g = mkStdGen seed + c = let ((a,b), (x,y)) = bounds mp in (head (randomRs (a,x) g), (head (randomRs (b,y) g))) + amp = head $ randomRs (5.0, 20.0) g + sig = head $ randomRs (5.0, 25.0) g + fi = fromIntegral + htt = heightToTerrain + + -- TODO: Fix Lambda to True with sensible function, maybe rework giveNeighbourhood in Map.Map + liftUp :: (Int, Int) -> Node -> Node + liftUp (gx,gz) (Full (x,z) y _ b pl pa r s) = let y_neu = max y e + in Full (x,z) y_neu (htt GrassIslandMap y_neu) b pl pa r s + where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) + liftUp (gx, gz) (Minimal (x,z)) = Full (x,z) e (htt GrassIslandMap e) BFlag NoPlayer NoPath Plain [] + where e = gauss3Dgeneral amp (fi gx) (fi gz) sig sig (fi x) (fi z) + +-- | Makes sure the edges of the Map are mountain-free +makeIsland :: PlayMap -> PlayMap +makeIsland = undefined -- tomorrow.... diff --git a/src/Map/Graphics.hs b/src/Map/Graphics.hs index 5cc198a..858b1f4 100644 --- a/src/Map/Graphics.hs +++ b/src/Map/Graphics.hs @@ -30,9 +30,7 @@ import Linear import Control.Arrow ((***)) import Map.Types -import Map.StaticMaps import Map.Creation -import Map.Combinators type Height = Float @@ -91,8 +89,8 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal getMapBufferObject :: IO (BufferObject, NumArrayIndices) getMapBufferObject = do - mountains <- mnt - myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty + eMap <- exportedMap + myMap' <- return $ convertToGraphicsMap $ convertToStripeMap eMap ! myMap <- return $ generateTriangles myMap' len <- return $ fromIntegral $ P.length myMap `div` numComponents putStrLn $ P.unwords ["num verts in map:",show len] diff --git a/src/Map/StaticMaps.hs b/src/Map/StaticMaps.hs index 74ea371..5ef9942 100644 --- a/src/Map/StaticMaps.hs +++ b/src/Map/StaticMaps.hs @@ -3,48 +3,47 @@ where import Map.Types import Data.Array -import Map.Creation -- entirely empty map, only uses the minimal constructor mapEmpty :: PlayMap mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]] -mapCenterMountain :: PlayMap -mapCenterMountain = array ((0,0),(199,199)) nodes - where - nodes = water ++ beach ++ grass ++ hill ++ mountain - water = [((a,b), Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) > 95] - beach = [((a,b), Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 95, m2d (a,b) > 75] - grass = [((a,b), Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 75, m2d (a,b) > 25] - hill = [((a,b), Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 25, m2d (a,b) > 10] - mountain = [((a,b), Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 10] +--mapCenterMountain :: PlayMap +--mapCenterMountain = array ((0,0),(199,199)) nodes +-- where +-- nodes = water ++ beach ++ grass ++ hill ++ mountain +-- water = [((a,b), Full (a,b) 0.0 Ocean BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) > 95] +-- beach = [((a,b), Full (a,b) (g2d a b) Beach BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 95, m2d (a,b) > 75] +-- grass = [((a,b), Full (a,b) (g2d a b) Grass BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 75, m2d (a,b) > 25] +-- hill = [((a,b), Full (a,b) (g2d a b) Hill BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 25, m2d (a,b) > 10] +-- mountain = [((a,b), Full (a,b) (g2d a b) Mountain BNothing NoPlayer NoPath Plain []) | a <- [0..199], b <- [0..199], m2d (a,b) <= 10] - g2d :: Int -> Int -> Float - g2d x y = gauss3D (fromIntegral x) (fromIntegral y) +-- g2d :: Int -> Int -> Float +-- g2d x y = gauss3D (fromIntegral x) (fromIntegral y) - m2d :: (Int,Int) -> Int - m2d (x,y) = mnh2D (x,y) (100,100) +-- m2d :: (Int,Int) -> Int +-- m2d (x,y) = mnh2D (x,y) (100,100) -- small helper for some hills. Should be replaced by multi-layer perlin-noise -- TODO: Replace as given in comment. -_noisyMap :: (Floating q) => q -> q -> q -_noisyMap x y = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y - + gauss3Dgeneral 5 10.0 10.0 10.0 10.0 x y - + gauss3Dgeneral 5 150.0 120.0 10.0 10.0 x y - + gauss3Dgeneral 5 50.0 75.0 10.0 10.0 x y +--_noisyMap :: (Floating q) => q -> q -> q +--_noisyMap x y = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y +-- + gauss3Dgeneral 5 10.0 10.0 10.0 10.0 x y +-- + gauss3Dgeneral 5 150.0 120.0 10.0 10.0 x y +-- + gauss3Dgeneral 5 50.0 75.0 10.0 10.0 x y -- generates a noisy map -- TODO: add real noise to a simple pattern -mapNoise :: PlayMap -mapNoise = array ((0,0),(199,199)) nodes - where - nodes = [((a,b), Full (a,b) - (height a b) - (heightToTerrain GrassIslandMap $ height a b) - BNothing - NoPlayer - NoPath - Plain - []) | a <- [0..199], b <- [0..199]] - where - height a b = _noisyMap (fromIntegral a) (fromIntegral b) +--mapNoise :: PlayMap +--mapNoise = array ((0,0),(199,199)) nodes +-- where +-- nodes = [((a,b), Full (a,b) +-- (height a b) +-- (heightToTerrain GrassIslandMap $ height a b) +-- BNothing +-- NoPlayer +-- NoPath +-- Plain +-- []) | a <- [0..199], b <- [0..199]] +-- where +-- height a b = _noisyMap (fromIntegral a) (fromIntegral b) From 1f6551cf08b6d328101ceaa868f06b583914ae58 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 2 May 2014 16:15:58 +0200 Subject: [PATCH 06/18] WIP DOES NOT WORK --- src/Render/Render.hs | 28 ++++++++++++++++++++++++++++ src/Types.hs | 6 ++++++ 2 files changed, 34 insertions(+) diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 6b3e4d3..a8fafe1 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -22,6 +22,7 @@ import Types import Render.Misc import Render.Types import Graphics.GLUtil.BufferObjects (makeBuffer) +import Importer.IQM.Parser mapVertexShaderFile :: String mapVertexShaderFile = "shaders/map/vertex.shader" @@ -32,6 +33,11 @@ mapTessEvalShaderFile = "shaders/map/tessEval.shader" mapFragmentShaderFile :: String mapFragmentShaderFile = "shaders/map/fragment.shader" +objectVertexShaderFile :: String +objectVertexShaderFile = "shaders/objects/vertex.shader" +objectFragmentShaderFile :: String +objectFragmentShaderFile = "shaders/objects/fragment.shader" + uiVertexShaderFile :: String uiVertexShaderFile = "shaders/ui/vertex.shader" uiFragmentShaderFile :: String @@ -113,6 +119,21 @@ initMapShader tessFac (buf, vertDes) = do texts <- genObjectNames 6 + testobj <- parseIQM "sample.iqm" + + let + objs = [GLObject testobj (Coord3D 0 10 0)] + + ! vertexSource' <- B.readFile objectVertexShaderFile + ! fragmentSource' <- B.readFile objectFragmentShaderFile + vertexShader' <- compileShaderSource VertexShader vertexSource' + checkError "compile Object-Vertex" + fragmentShader' <- compileShaderSource FragmentShader fragmentSource' + checkError "compile Object-Fragment" + objProgram <- createProgramUsing [vertexShader', fragmentShader'] + checkError "compile Object-Program" + + currentProgram $= Just objProgram checkError "initShader" return GLMapState @@ -132,6 +153,8 @@ initMapShader tessFac (buf, vertDes) = do , _mapVert = vertDes , _overviewTexture = overTex , _mapTextures = texts + , _mapObjects = objs + , _objectProgram = objProgram } initHud :: IO GLHud @@ -354,6 +377,11 @@ render = do cullFace $= Just Front glDrawArrays gl_PATCHES 0 (fromIntegral numVert) + + + currentProgram $= Just (state ^. gl.glMap.objectProgram) + + checkError "draw map" -- set sample 1 as target in renderbuffer diff --git a/src/Types.hs b/src/Types.hs index 115796a..c75dce9 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -13,7 +13,9 @@ import Control.Lens import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) import Render.Types import UI.UIBaseData +import Importer.IQM.Types +data Coord3D a = Coord3D a a a --Static Read-Only-State data Env = Env @@ -113,8 +115,12 @@ data GLMapState = GLMapState , _renderedMapTexture :: !TextureObject --TODO: Probably move to UI? , _overviewTexture :: !TextureObject , _mapTextures :: ![TextureObject] --TODO: Fix size on list? + , _objectProgram :: !GL.Program + , _mapObjects :: ![GLObject] } +data GLObject = GLObject IQM (Coord3D Double) + data GLHud = GLHud { _hudTexture :: !TextureObject -- ^ HUD-Texture itself , _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader From 91fbbb73505337291d31e3bb27a8f08050b62fff Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 3 May 2014 15:17:33 +0200 Subject: [PATCH 07/18] started to render iqm - nothing visible now. --- shaders/mapobjects/fragment.shader | 157 ++++++++++++++++++++++++++ shaders/mapobjects/tessControl.shader | 27 +++++ shaders/mapobjects/tessEval.shader | 149 ++++++++++++++++++++++++ shaders/mapobjects/vertex.shader | 18 +++ src/Render/Render.hs | 12 ++ src/Types.hs | 10 ++ 6 files changed, 373 insertions(+) create mode 100644 shaders/mapobjects/fragment.shader create mode 100644 shaders/mapobjects/tessControl.shader create mode 100644 shaders/mapobjects/tessEval.shader create mode 100644 shaders/mapobjects/vertex.shader diff --git a/shaders/mapobjects/fragment.shader b/shaders/mapobjects/fragment.shader new file mode 100644 index 0000000..ec6ac9f --- /dev/null +++ b/shaders/mapobjects/fragment.shader @@ -0,0 +1,157 @@ +#version 330 + +//#include "3rdParty/noise.glsl" + +vec3 mod289(vec3 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec4 mod289(vec4 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec4 permute(vec4 x) { + return mod289(((x*34.0)+1.0)*x); +} + +vec4 taylorInvSqrt(vec4 r) +{ + return 1.79284291400159 - 0.85373472095314 * r; +} + +float snoise(vec3 v) + { + const vec2 C = vec2(1.0/6.0, 1.0/3.0) ; + const vec4 D = vec4(0.0, 0.5, 1.0, 2.0); + +// First corner + vec3 i = floor(v + dot(v, C.yyy) ); + vec3 x0 = v - i + dot(i, C.xxx) ; + +// Other corners + vec3 g = step(x0.yzx, x0.xyz); + vec3 l = 1.0 - g; + vec3 i1 = min( g.xyz, l.zxy ); + vec3 i2 = max( g.xyz, l.zxy ); + + // x0 = x0 - 0.0 + 0.0 * C.xxx; + // x1 = x0 - i1 + 1.0 * C.xxx; + // x2 = x0 - i2 + 2.0 * C.xxx; + // x3 = x0 - 1.0 + 3.0 * C.xxx; + vec3 x1 = x0 - i1 + C.xxx; + vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y + vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y + +// Permutations + i = mod289(i); + vec4 p = permute( permute( permute( + i.z + vec4(0.0, i1.z, i2.z, 1.0 )) + + i.y + vec4(0.0, i1.y, i2.y, 1.0 )) + + i.x + vec4(0.0, i1.x, i2.x, 1.0 )); + +// Gradients: 7x7 points over a square, mapped onto an octahedron. +// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294) + float n_ = 0.142857142857; // 1.0/7.0 + vec3 ns = n_ * D.wyz - D.xzx; + + vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7) + + vec4 x_ = floor(j * ns.z); + vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N) + + vec4 x = x_ *ns.x + ns.yyyy; + vec4 y = y_ *ns.x + ns.yyyy; + vec4 h = 1.0 - abs(x) - abs(y); + + vec4 b0 = vec4( x.xy, y.xy ); + vec4 b1 = vec4( x.zw, y.zw ); + + //vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0; + //vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0; + vec4 s0 = floor(b0)*2.0 + 1.0; + vec4 s1 = floor(b1)*2.0 + 1.0; + vec4 sh = -step(h, vec4(0.0)); + + vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ; + vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ; + + vec3 p0 = vec3(a0.xy,h.x); + vec3 p1 = vec3(a0.zw,h.y); + vec3 p2 = vec3(a1.xy,h.z); + vec3 p3 = vec3(a1.zw,h.w); + +//Normalise gradients + vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3))); + p0 *= norm.x; + p1 *= norm.y; + p2 *= norm.z; + p3 *= norm.w; + +// Mix final noise value + vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0); + m = m * m; + return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1), + dot(p2,x2), dot(p3,x3) ) ); + } + +float fog(float dist) { + dist = max(0,dist - 50); + dist = dist * 0.05; +// dist = dist*dist; + return 1-exp(-dist); +} + +smooth in vec3 teNormal; +smooth in vec3 tePosition; +smooth in float fogDist; +smooth in float gmix; +in vec4 teColor; + +out vec4 fgColor; + +uniform mat4 ViewMatrix; +uniform mat4 ProjectionMatrix; + +void main(void) +{ + //fog color + vec4 fogColor = vec4(0.6,0.7,0.8,1.0); + + //heliospheric lighting + vec4 light = vec4(1.0,1.0,1.0,1.0); + vec4 dark = vec4(0.0,0.0,0.0,1.0); + //direction to sun from origin + vec3 lightDir = normalize(ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz; + + float costheta = dot(teNormal, lightDir); + float a = costheta * 0.5 + 0.5; + + //create gravel-texel + vec3 uvw = tePosition; + // Six components of noise in a fractal sum + //float n = snoise(uvw * 10); + float n = 0; + n += 0.5 * snoise(uvw * 20.0); + //n += 0.25 * snoise(uvw * 40.0); + //n += 0.125 * snoise(uvw * 80.0); + //n += 0.0625 * snoise(uvw * 160.0); + //n += 0.03125 * snoise(uvw * 320.0); + n = abs(n*2);//[0,1] + + //dirt + float d = snoise(uvw); + d += 0.5 * snoise(uvw * 2); + d += 0.25 * snoise(uvw * 4); + d = d/3*2 +0.5; + + // base, dirt, noise-level*(above 0?)*(linear blend by y) + vec4 texBase = mix(teColor, vec4(0.45,0.27,0.1,1),d*d*step(0.01,tePosition.y)*clamp(tePosition.y/2,0,2)); + // stone highlights + vec4 texHighlights = mix(texBase, vec4(0.9*n,0.9*n,0.9*n,1),n*n*n); + //mix highlights into Color with inclination, if inclination^2 > 0.35 + vec4 texColor = mix(texBase,texHighlights, (gmix*(1-gmix))*4*(gmix*(1-gmix))*4); + vec4 Color = texColor; + + fgColor = Color * mix(dark, light, a); + fgColor = mix(fgColor,fogColor,fog(fogDist)); +} \ No newline at end of file diff --git a/shaders/mapobjects/tessControl.shader b/shaders/mapobjects/tessControl.shader new file mode 100644 index 0000000..e7a5d25 --- /dev/null +++ b/shaders/mapobjects/tessControl.shader @@ -0,0 +1,27 @@ +#version 330 +#extension GL_ARB_tessellation_shader : require + +layout(vertices = 3) out; +in vec3 vPosition[]; +in vec4 vColor[]; +in vec3 vNormal[]; +out vec3 tcPosition[]; +out vec4 tcColor[]; +out vec3 tcNormal[]; +uniform float TessLevelInner = 1.0; // controlled by keyboard buttons +uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons + +#define ID gl_InvocationID + +void main() +{ + tcPosition[ID] = vPosition[ID]; + tcColor[ID] = vColor[ID]; + tcNormal[ID] = vNormal[ID]; + if (ID == 0) { + gl_TessLevelInner[0] = TessLevelInner; + gl_TessLevelOuter[0] = TessLevelOuter; + gl_TessLevelOuter[1] = TessLevelOuter; + gl_TessLevelOuter[2] = TessLevelOuter; + } +} \ No newline at end of file diff --git a/shaders/mapobjects/tessEval.shader b/shaders/mapobjects/tessEval.shader new file mode 100644 index 0000000..51cc5b3 --- /dev/null +++ b/shaders/mapobjects/tessEval.shader @@ -0,0 +1,149 @@ +#version 330 + +#extension GL_ARB_tessellation_shader : require + +//#include "shaders/3rdParty/noise.glsl" + +vec3 mod289(vec3 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec4 mod289(vec4 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec4 permute(vec4 x) { + return mod289(((x*34.0)+1.0)*x); +} + +vec4 taylorInvSqrt(vec4 r) +{ + return 1.79284291400159 - 0.85373472095314 * r; +} + +float snoise(vec3 v) + { + const vec2 C = vec2(1.0/6.0, 1.0/3.0) ; + const vec4 D = vec4(0.0, 0.5, 1.0, 2.0); + +// First corner + vec3 i = floor(v + dot(v, C.yyy) ); + vec3 x0 = v - i + dot(i, C.xxx) ; + +// Other corners + vec3 g = step(x0.yzx, x0.xyz); + vec3 l = 1.0 - g; + vec3 i1 = min( g.xyz, l.zxy ); + vec3 i2 = max( g.xyz, l.zxy ); + + // x0 = x0 - 0.0 + 0.0 * C.xxx; + // x1 = x0 - i1 + 1.0 * C.xxx; + // x2 = x0 - i2 + 2.0 * C.xxx; + // x3 = x0 - 1.0 + 3.0 * C.xxx; + vec3 x1 = x0 - i1 + C.xxx; + vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y + vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y + +// Permutations + i = mod289(i); + vec4 p = permute( permute( permute( + i.z + vec4(0.0, i1.z, i2.z, 1.0 )) + + i.y + vec4(0.0, i1.y, i2.y, 1.0 )) + + i.x + vec4(0.0, i1.x, i2.x, 1.0 )); + +// Gradients: 7x7 points over a square, mapped onto an octahedron. +// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294) + float n_ = 0.142857142857; // 1.0/7.0 + vec3 ns = n_ * D.wyz - D.xzx; + + vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7) + + vec4 x_ = floor(j * ns.z); + vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N) + + vec4 x = x_ *ns.x + ns.yyyy; + vec4 y = y_ *ns.x + ns.yyyy; + vec4 h = 1.0 - abs(x) - abs(y); + + vec4 b0 = vec4( x.xy, y.xy ); + vec4 b1 = vec4( x.zw, y.zw ); + + //vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0; + //vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0; + vec4 s0 = floor(b0)*2.0 + 1.0; + vec4 s1 = floor(b1)*2.0 + 1.0; + vec4 sh = -step(h, vec4(0.0)); + + vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ; + vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ; + + vec3 p0 = vec3(a0.xy,h.x); + vec3 p1 = vec3(a0.zw,h.y); + vec3 p2 = vec3(a1.xy,h.z); + vec3 p3 = vec3(a1.zw,h.w); + +//Normalise gradients + vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3))); + p0 *= norm.x; + p1 *= norm.y; + p2 *= norm.z; + p3 *= norm.w; + +// Mix final noise value + vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0); + m = m * m; + return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1), + dot(p2,x2), dot(p3,x3) ) ); + } + + +layout(triangles, equal_spacing, cw) in; +in vec3 tcPosition[]; +in vec4 tcColor[]; +in vec3 tcNormal[]; +out vec4 teColor; +smooth out vec3 tePosition; +smooth out vec3 teNormal; +smooth out float fogDist; +smooth out float gmix; //mixture of gravel +//out vec3 tePatchDistance; +//constant projection matrix +uniform mat4 ProjectionMatrix; +uniform mat4 ViewMatrix; +uniform mat3 NormalMatrix; + +void main() +{ + //NORMAL + vec3 n0 = gl_TessCoord.x * tcNormal[0]; + vec3 n1 = gl_TessCoord.y * tcNormal[1]; + vec3 n2 = gl_TessCoord.z * tcNormal[2]; + vec3 tessNormal = normalize(n0 + n1 + n2); + teNormal = NormalMatrix * tessNormal; + + //POSITION + vec3 p0 = gl_TessCoord.x * tcPosition[0]; + vec3 p1 = gl_TessCoord.y * tcPosition[1]; + vec3 p2 = gl_TessCoord.z * tcPosition[2]; + tePosition = p0 + p1 + p2; + + //sin(a,b) = length(cross(a,b)) + float i0 = (1-gl_TessCoord.x)*gl_TessCoord.x * length(cross(tcNormal[0],tessNormal)); + float i1 = (1-gl_TessCoord.y)*gl_TessCoord.y * length(cross(tcNormal[1],tessNormal)); + float i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal)); + float standout = i0+i1+i2; + tePosition = tePosition+tessNormal*standout; + tePosition = tePosition+0.05*snoise(tePosition); + gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1); + fogDist = gl_Position.z; + + //COLOR-BLENDING + vec4 c0 = (1-exp(gl_TessCoord.x)) * tcColor[0]; + vec4 c1 = (1-exp(gl_TessCoord.y)) * tcColor[1]; + vec4 c2 = (1-exp(gl_TessCoord.z)) * tcColor[2]; + teColor = (c0 + c1 + c2)/((1-exp(gl_TessCoord.x))+(1-exp(gl_TessCoord.y))+(1-exp(gl_TessCoord.z))); + + //mix gravel based on incline (sin (normal,up)) + gmix = length(cross(tessNormal, vec3(0,1,0))); + +} diff --git a/shaders/mapobjects/vertex.shader b/shaders/mapobjects/vertex.shader new file mode 100644 index 0000000..c6e3c7c --- /dev/null +++ b/shaders/mapobjects/vertex.shader @@ -0,0 +1,18 @@ +#version 330 + +//vertex-data +in vec4 Color; +in vec3 Position; +in vec3 Normal; + +//output-data for later stages +out vec4 vColor; +out vec3 vPosition; +out vec3 vNormal; + +void main() +{ + vPosition = Position; + vNormal = Normal; + vColor = Color; +} \ No newline at end of file diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 6b3e4d3..64cc307 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -132,6 +132,8 @@ initMapShader tessFac (buf, vertDes) = do , _mapVert = vertDes , _overviewTexture = overTex , _mapTextures = texts + , _objectsProgram = program + , _mapObjects = [] } initHud :: IO GLHud @@ -265,6 +267,10 @@ renderOverview = do checkError "draw map" -} +renderObject :: MapObject -> IO () +renderObject (MapObject model (L.V3 x y z) _{-state-}) = + undefined + render :: Pioneers () render = do @@ -356,6 +362,12 @@ render = do glDrawArrays gl_PATCHES 0 (fromIntegral numVert) checkError "draw map" + ---- RENDER MAPOBJECTS -------------------------------------------- + + currentProgram $= Just (state ^. gl.glMap.objectsProgram) + + mapM_ renderObject (state ^. gl.glMap.mapObjects) + -- set sample 1 as target in renderbuffer {-framebufferRenderbuffer DrawFramebuffer --write-only diff --git a/src/Types.hs b/src/Types.hs index 115796a..8f6aae6 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -8,11 +8,13 @@ import Foreign.C (CFloat) import qualified Data.HashMap.Strict as Map import Data.Time (UTCTime) import Linear.Matrix (M44) +import Linear (V3) import Control.Monad.RWS.Strict (RWST) import Control.Lens import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) import Render.Types import UI.UIBaseData +import Importer.IQM.Types --Static Read-Only-State @@ -113,8 +115,16 @@ data GLMapState = GLMapState , _renderedMapTexture :: !TextureObject --TODO: Probably move to UI? , _overviewTexture :: !TextureObject , _mapTextures :: ![TextureObject] --TODO: Fix size on list? + , _objectsProgram :: !GL.Program + , _mapObjects :: ![MapObject] } +data MapObject = MapObject !IQM !MapCoordinates !MapObjectState + +data MapObjectState = MapObjectState () + +type MapCoordinates = V3 CFloat + data GLHud = GLHud { _hudTexture :: !TextureObject -- ^ HUD-Texture itself , _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader From f7cc34b3a0d5250f019260b29ac7a6273e6ff277 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 5 May 2014 08:11:33 +0200 Subject: [PATCH 08/18] first try at adaptive performance --- src/Main.hs | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 935f2ec..209ae84 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -228,17 +228,29 @@ run = do } -} - mt <- liftIO $ do - let double = fromRational.toRational :: (Real a) => a -> Double + (mt,tc,sleepAmount) <- liftIO $ do + let double = fromRational.toRational :: (Real a) => a -> Double + targetFramerate = 40.0 + targetFrametime = 1.0/targetFramerate + targetFrametimeμs = targetFrametime * 1000000.0 now <- getCurrentTime diff <- return $ diffUTCTime now (state ^. io.clock) -- get time-diffs title <- return $ unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] setWindowTitle (env ^. windowObject) title - sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds - threadDelay sleepAmount - return now + let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds + tessChange + | (sleepAmount > (floor $0.1*targetFrametimeμs)) && (state ^. gl.glMap.stateTessellationFactor < 5) = ((+)1 :: Int -> Int) + -- > factor < 5 & 10% of frame idle -> increase graphics + | sleepAmount < 0 && (state ^. gl.glMap.stateTessellationFactor > 1) = (flip (-) 1 :: Int -> Int) + -- frame used up completely -> decrease + | otherwise = ((+)0 :: Int -> Int) -- 0ms > x > 10% -> keep settings + when (sleepAmount > 0) $ threadDelay sleepAmount + print targetFrametimeμs + return (now,tessChange,sleepAmount) -- set state with new clock-time - modify $ io.clock .~ mt + modify $ (io.clock .~ mt) + . (gl.glMap.stateTessellationFactor %~ tc) + liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."] shouldClose' <- return $ state ^. window.shouldClose unless shouldClose' run From c37a49a9480d0a40c8192b67eb3b2df073ca86df Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 5 May 2014 08:19:07 +0200 Subject: [PATCH 09/18] added missing hsSDL2-stuff to dependencies. --- deps/getDeps.sh | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/deps/getDeps.sh b/deps/getDeps.sh index bde7d1f..4c17d5e 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -14,7 +14,7 @@ fi if [[ $install -eq 0 ]] then - sudo apt-get install libsdl2-dev libsdl2-ttf-dev + sudo apt-get install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-mixer-dev fi @@ -38,6 +38,25 @@ else cd .. fi +if [ ! -d "hsSDL2-mixer" ] +then + git clone https://github.com/jdeseno/hs-sdl2-mixer hsSDL2-mixer +else + cd hsSDL2-mixer + git pull + cd .. +fi + +if [ ! -d "hsSDL2-image" ] +then + git clone https://github.com/jdeseno/hs-sdl2-image hsSDL2-image +else + cd hsSDL2-image + git pull + cd .. +fi + + echo "trying to build" cabal install haddock @@ -51,7 +70,7 @@ cabal install --only-dependencies cabal build cd .. -for t in "hsSDL2-ttf" +for t in "hsSDL2-ttf" "hsSDL2-mixer" "hsSDL2-image" do echo "building ${t}.." cd "${t}" From 376375008c8044ba6e5cbc25906cf5f5f8a068dc Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 7 May 2014 09:51:35 +0200 Subject: [PATCH 10/18] tessellation-factor is now adaptive - tessellation gets reduced in distance - tess-factor is now adaptive --- shaders/map/tessControl.shader | 31 ++++++++++++++++++++++++++----- src/Main.hs | 12 +++++++----- src/Types.hs | 1 + 3 files changed, 34 insertions(+), 10 deletions(-) diff --git a/shaders/map/tessControl.shader b/shaders/map/tessControl.shader index e7a5d25..a6f81b1 100644 --- a/shaders/map/tessControl.shader +++ b/shaders/map/tessControl.shader @@ -10,6 +10,9 @@ out vec4 tcColor[]; out vec3 tcNormal[]; uniform float TessLevelInner = 1.0; // controlled by keyboard buttons uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons +uniform mat4 ProjectionMatrix; +uniform mat4 ViewMatrix; +uniform mat3 NormalMatrix; #define ID gl_InvocationID @@ -18,10 +21,28 @@ void main() tcPosition[ID] = vPosition[ID]; tcColor[ID] = vColor[ID]; tcNormal[ID] = vNormal[ID]; + float dist = (ProjectionMatrix * ViewMatrix * vec4(vPosition[ID], 1)).z; if (ID == 0) { - gl_TessLevelInner[0] = TessLevelInner; - gl_TessLevelOuter[0] = TessLevelOuter; - gl_TessLevelOuter[1] = TessLevelOuter; - gl_TessLevelOuter[2] = TessLevelOuter; + if (dist < 30) { + gl_TessLevelInner[0] = TessLevelInner; + gl_TessLevelOuter[0] = TessLevelOuter; + gl_TessLevelOuter[1] = TessLevelOuter; + gl_TessLevelOuter[2] = TessLevelOuter; + } else if (dist < 50) { + gl_TessLevelInner[0] = max(TessLevelInner-1.0,1.0); + gl_TessLevelOuter[0] = max(TessLevelOuter-1.0,1.0); + gl_TessLevelOuter[1] = max(TessLevelOuter-1.0,1.0); + gl_TessLevelOuter[2] = max(TessLevelOuter-1.0,1.0); + } else if (dist < 100) { + gl_TessLevelInner[0] = max(TessLevelInner-2.0,1.0); + gl_TessLevelOuter[0] = max(TessLevelOuter-2.0,1.0); + gl_TessLevelOuter[1] = max(TessLevelOuter-2.0,1.0); + gl_TessLevelOuter[2] = max(TessLevelOuter-2.0,1.0); + } else { + gl_TessLevelInner[0] = 1.0; + gl_TessLevelOuter[0] = 1.0; + gl_TessLevelOuter[1] = 1.0; + gl_TessLevelOuter[2] = 1.0; + } } -} \ No newline at end of file +} diff --git a/src/Main.hs b/src/Main.hs index 209ae84..f033a77 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -132,6 +132,7 @@ main = } , _io = IOState { _clock = now + , _tessClockFactor = 0 } , _mouse = MouseState { _isDown = False @@ -234,23 +235,24 @@ run = do targetFrametime = 1.0/targetFramerate targetFrametimeμs = targetFrametime * 1000000.0 now <- getCurrentTime - diff <- return $ diffUTCTime now (state ^. io.clock) -- get time-diffs - title <- return $ unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] + let diff = diffUTCTime now (state ^. io.clock) -- get time-diffs + title = unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] setWindowTitle (env ^. windowObject) title let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds + clockFactor = (state ^. io.tessClockFactor) tessChange - | (sleepAmount > (floor $0.1*targetFrametimeμs)) && (state ^. gl.glMap.stateTessellationFactor < 5) = ((+)1 :: Int -> Int) + | (clockFactor > (2*targetFrametimeμs)) && (state ^. gl.glMap.stateTessellationFactor < 5) = ((+)1 :: Int -> Int) -- > factor < 5 & 10% of frame idle -> increase graphics | sleepAmount < 0 && (state ^. gl.glMap.stateTessellationFactor > 1) = (flip (-) 1 :: Int -> Int) -- frame used up completely -> decrease | otherwise = ((+)0 :: Int -> Int) -- 0ms > x > 10% -> keep settings when (sleepAmount > 0) $ threadDelay sleepAmount - print targetFrametimeμs return (now,tessChange,sleepAmount) -- set state with new clock-time modify $ (io.clock .~ mt) . (gl.glMap.stateTessellationFactor %~ tc) - liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."] + . (io.tessClockFactor %~ (((+) (fromIntegral sleepAmount)).((*) 0.99))) + -- liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."] shouldClose' <- return $ state ^. window.shouldClose unless shouldClose' run diff --git a/src/Types.hs b/src/Types.hs index 8f6aae6..af45b18 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -51,6 +51,7 @@ data CameraState = CameraState data IOState = IOState { _clock :: !UTCTime + , _tessClockFactor :: !Double } data GameState = GameState From a91aad5daabaf4cf52f7dd848e7c528da2aa400e Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 7 May 2014 10:12:18 +0200 Subject: [PATCH 11/18] better noise-function --- shaders/map/tessEval.shader | 3 ++- src/Render/Render.hs | 19 +++++++++++++------ src/Types.hs | 5 ----- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/shaders/map/tessEval.shader b/shaders/map/tessEval.shader index 51cc5b3..2a90b55 100644 --- a/shaders/map/tessEval.shader +++ b/shaders/map/tessEval.shader @@ -133,7 +133,8 @@ void main() float i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal)); float standout = i0+i1+i2; tePosition = tePosition+tessNormal*standout; - tePosition = tePosition+0.05*snoise(tePosition); + vec3 tmp = tePosition+1*snoise(tePosition/20); + tePosition = vec3(tePosition.x, tmp.y, tePosition.z); gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1); fogDist = gl_Position.z; diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 23871f3..4878bc2 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -23,6 +23,7 @@ import Render.Misc import Render.Types import Graphics.GLUtil.BufferObjects (makeBuffer) import Importer.IQM.Parser +import Importer.IQM.Types mapVertexShaderFile :: String mapVertexShaderFile = "shaders/map/vertex.shader" @@ -34,9 +35,9 @@ mapFragmentShaderFile :: String mapFragmentShaderFile = "shaders/map/fragment.shader" objectVertexShaderFile :: String -objectVertexShaderFile = "shaders/objects/vertex.shader" +objectVertexShaderFile = "shaders/mapobjects/vertex.shader" objectFragmentShaderFile :: String -objectFragmentShaderFile = "shaders/objects/fragment.shader" +objectFragmentShaderFile = "shaders/mapobjects/fragment.shader" uiVertexShaderFile :: String uiVertexShaderFile = "shaders/ui/vertex.shader" @@ -122,7 +123,7 @@ initMapShader tessFac (buf, vertDes) = do testobj <- parseIQM "sample.iqm" let - objs = [GLObject testobj (Coord3D 0 10 0)] + objs = [MapObject testobj (L.V3 0 10 0) (MapObjectState ())] ! vertexSource' <- B.readFile objectVertexShaderFile ! fragmentSource' <- B.readFile objectFragmentShaderFile @@ -288,9 +289,15 @@ renderOverview = do checkError "draw map" -} + +-- | renders an IQM-Model at Position with scaling +renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO () +renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do + return () + renderObject :: MapObject -> IO () -renderObject (MapObject model (L.V3 x y z) _{-state-}) = - undefined +renderObject (MapObject model pos@(L.V3 x y z) _{-state-}) = + renderIQM model pos (L.V3 1 1 1) render :: Pioneers () @@ -390,7 +397,7 @@ render = do ---- RENDER MAPOBJECTS -------------------------------------------- - currentProgram $= Just (state ^. gl.glMap.objectsProgram) + currentProgram $= Just (state ^. gl.glMap.objectProgram) mapM_ renderObject (state ^. gl.glMap.mapObjects) diff --git a/src/Types.hs b/src/Types.hs index dd0d029..3b83f11 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -118,11 +118,6 @@ data GLMapState = GLMapState , _overviewTexture :: !TextureObject , _mapTextures :: ![TextureObject] --TODO: Fix size on list? , _objectProgram :: !GL.Program - , _mapObjects :: ![GLObject] - } - -data GLObject = GLObject IQM (Coord3D Double) - , _objectsProgram :: !GL.Program , _mapObjects :: ![MapObject] } From bd7870a76efe5d1cf44c2d43ed1dae822fd6f6e9 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 10 May 2014 17:33:33 +0200 Subject: [PATCH 12/18] forgot change --- COMPILING | 13 ++++++++++--- src/Render/Render.hs | 4 ---- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/COMPILING b/COMPILING index b4c7ad9..a4cb00d 100644 --- a/COMPILING +++ b/COMPILING @@ -1,6 +1,13 @@ +# on ubuntu14.04 (trusty) and later + +just run +> ./build.sh + +# manual installation + set up external dependencies: -> sudo apt-get install libsdl2-dev +> sudo apt-get install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-mixer-dev > cd deps && ./getDeps.sh && cd .. NOTE: ubuntu saucy currently only has libsdl2-dev.2.0.0 in the repositories, but we need libsdl2-dev.2.0.1 @@ -12,8 +19,8 @@ make sure the compiled files are in your PATH (e.g. include $HOME/.cabal/bin in install dependencies & configure app > cabal sandbox init -> cabal sandbox --add-source deps/hsSDL2 -> cabal sandbox --add-source deps/hsSDL2-ttf +> cabal sandbox add-source deps/hsSDL2 +> cabal sandbox add-source deps/hsSDL2-ttf > cabal install --only-dependencies > cabal configure diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 4878bc2..c6e4369 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -389,10 +389,6 @@ render = do glDrawArrays gl_PATCHES 0 (fromIntegral numVert) - - currentProgram $= Just (state ^. gl.glMap.objectProgram) - - checkError "draw map" ---- RENDER MAPOBJECTS -------------------------------------------- From e4fec7c3de60138f50c0f6ae52b9b7ed738cf36c Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 10 May 2014 17:33:33 +0200 Subject: [PATCH 13/18] forgot change, fixed compiling --- COMPILING | 13 ++++++++++--- src/Render/Render.hs | 4 ---- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/COMPILING b/COMPILING index b4c7ad9..a4cb00d 100644 --- a/COMPILING +++ b/COMPILING @@ -1,6 +1,13 @@ +# on ubuntu14.04 (trusty) and later + +just run +> ./build.sh + +# manual installation + set up external dependencies: -> sudo apt-get install libsdl2-dev +> sudo apt-get install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-mixer-dev > cd deps && ./getDeps.sh && cd .. NOTE: ubuntu saucy currently only has libsdl2-dev.2.0.0 in the repositories, but we need libsdl2-dev.2.0.1 @@ -12,8 +19,8 @@ make sure the compiled files are in your PATH (e.g. include $HOME/.cabal/bin in install dependencies & configure app > cabal sandbox init -> cabal sandbox --add-source deps/hsSDL2 -> cabal sandbox --add-source deps/hsSDL2-ttf +> cabal sandbox add-source deps/hsSDL2 +> cabal sandbox add-source deps/hsSDL2-ttf > cabal install --only-dependencies > cabal configure diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 4878bc2..c6e4369 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -389,10 +389,6 @@ render = do glDrawArrays gl_PATCHES 0 (fromIntegral numVert) - - currentProgram $= Just (state ^. gl.glMap.objectProgram) - - checkError "draw map" ---- RENDER MAPOBJECTS -------------------------------------------- From a57cada9459d4bc3af8de651a46c001a96bce98b Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 10 May 2014 20:22:49 +0200 Subject: [PATCH 14/18] changed SDL to qualified import --- src/Main.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index b4eb989..0aa092d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -27,7 +27,7 @@ import Foreign.Marshal.Alloc (allocaBytes) import Control.Lens ((^.), (.~), (%~)) -- GUI -import Graphics.UI.SDL as SDL +import qualified Graphics.UI.SDL as SDL -- Render import qualified Graphics.Rendering.OpenGL.GL as GL @@ -65,15 +65,15 @@ testParser a = putStrLn . show =<< parseIQM a main :: IO () main = - SDL.withInit [InitVideo, InitAudio, InitEvents, InitTimer] $ --also: InitNoParachute -> faster, without parachute! - SDL.withWindow "Pioneers" (SDL.Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL - ,WindowShown -- window should be visible - ,WindowResizable -- and resizable - ,WindowInputFocus -- focused (=> active) - ,WindowMouseFocus -- Mouse into it + SDL.withInit [SDL.InitVideo, SDL.InitAudio, SDL.InitEvents, SDL.InitTimer] $ --also: InitNoParachute -> faster, without parachute! + SDL.withWindow "Pioneers" (SDL.Position 100 100) (SDL.Size 1024 600) [SDL.WindowOpengl -- we want openGL + ,SDL.WindowShown -- window should be visible + ,SDL.WindowResizable -- and resizable + ,SDL.WindowInputFocus -- focused (=> active) + ,SDL.WindowMouseFocus -- Mouse into it --,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window' -> do - withOpenGL window' $ do + SDL.withOpenGL window' $ do --Create Renderbuffer & Framebuffer -- We will render to this buffer to copy the result into textures @@ -82,12 +82,12 @@ main = GL.bindFramebuffer GL.Framebuffer GL.$= frameBuffer GL.bindRenderbuffer GL.Renderbuffer GL.$= renderBuffer - (Size fbWidth fbHeight) <- glGetDrawableSize window' + (SDL.Size fbWidth fbHeight) <- SDL.glGetDrawableSize window' initRendering --generate map vertices glMap' <- initMapShader 4 =<< getMapBufferObject print window' - eventQueue <- newTQueueIO :: IO (TQueue Event) + eventQueue <- newTQueueIO :: IO (TQueue SDL.Event) putStrLn "foo" now <- getCurrentTime putStrLn "foo" @@ -181,7 +181,7 @@ run = do -- draw Scene draw - liftIO $ glSwapWindow (env ^. windowObject) + liftIO $ SDL.glSwapWindow (env ^. windowObject) -- getEvents & process processEvents @@ -237,7 +237,7 @@ run = do now <- getCurrentTime let diff = diffUTCTime now (state ^. io.clock) -- get time-diffs title = unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] - setWindowTitle (env ^. windowObject) title + SDL.setWindowTitle (env ^. windowObject) title let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds clockFactor = (state ^. io.tessClockFactor) tessChange @@ -327,14 +327,14 @@ adjustWindow = do processEvents :: Pioneers () processEvents = do - me <- liftIO pollEvent + me <- liftIO SDL.pollEvent case me of Just e -> do processEvent e processEvents Nothing -> return () -processEvent :: Event -> Pioneers () +processEvent :: SDL.Event -> Pioneers () processEvent e = do eventCallback e -- env <- ask @@ -343,7 +343,7 @@ processEvent e = do case winEvent of SDL.Closing -> modify $ window.shouldClose .~ True - SDL.Resized {windowResizedTo=size} -> do + SDL.Resized {SDL.windowResizedTo=size} -> do modify $ (window . width .~ SDL.sizeWidth size) . (window . height .~ SDL.sizeHeight size) adjustWindow From 8dea8d1ed9e94085577a835ecd2cbc59060fb366 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 11 May 2014 10:52:45 +0200 Subject: [PATCH 15/18] refined shaders - grid is now visible - grid-points are different colored - tesselated triangles wont get "gridded". --- shaders/map/fragment.shader | 14 +++++++++++++- shaders/map/tessEval.shader | 2 ++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/shaders/map/fragment.shader b/shaders/map/fragment.shader index ec6ac9f..e211418 100644 --- a/shaders/map/fragment.shader +++ b/shaders/map/fragment.shader @@ -106,6 +106,7 @@ smooth in vec3 tePosition; smooth in float fogDist; smooth in float gmix; in vec4 teColor; +in vec3 tePatchDistance; out vec4 fgColor; @@ -116,6 +117,10 @@ void main(void) { //fog color vec4 fogColor = vec4(0.6,0.7,0.8,1.0); + //grid color + vec4 grid = vec4(0.0,0.0,0.0,1.0); + //point color + vec4 point = vec4(1.0,0.9,0.1,1.0); //heliospheric lighting vec4 light = vec4(1.0,1.0,1.0,1.0); @@ -154,4 +159,11 @@ void main(void) fgColor = Color * mix(dark, light, a); fgColor = mix(fgColor,fogColor,fog(fogDist)); -} \ No newline at end of file + + //mix onto tri-borders + float mixer = clamp(exp(1.0-50.0*min(tePatchDistance.x,min(tePatchDistance.y,tePatchDistance.z))),0,1); + fgColor = mix(fgColor, grid, mixer); + + mixer = clamp(exp(1.0-50.0*min(tePatchDistance.x+tePatchDistance.y,min(tePatchDistance.x+tePatchDistance.z,tePatchDistance.y+tePatchDistance.z))),0,1); + fgColor = mix(fgColor, point, mixer); +} diff --git a/shaders/map/tessEval.shader b/shaders/map/tessEval.shader index 513df69..c4abf04 100644 --- a/shaders/map/tessEval.shader +++ b/shaders/map/tessEval.shader @@ -106,6 +106,7 @@ smooth out vec3 tePosition; smooth out vec3 teNormal; smooth out float fogDist; smooth out float gmix; //mixture of gravel +out vec3 tePatchDistance; //out vec3 tePatchDistance; //constant projection matrix uniform mat4 ProjectionMatrix; @@ -126,6 +127,7 @@ void main() vec3 p1 = gl_TessCoord.y * tcPosition[1]; vec3 p2 = gl_TessCoord.z * tcPosition[2]; tePosition = p0 + p1 + p2; + tePatchDistance = gl_TessCoord; //sin(a,b) = length(cross(a,b)) float i0 = (1-gl_TessCoord.x)*gl_TessCoord.x * length(cross(tcNormal[0],tessNormal)); From d1adff31d58a35f5fbc4b8935f64035b7179277e Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 11 May 2014 12:38:39 +0200 Subject: [PATCH 16/18] removed some print-foo --- src/Main.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 0aa092d..e7c9ac8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -86,11 +86,8 @@ main = initRendering --generate map vertices glMap' <- initMapShader 4 =<< getMapBufferObject - print window' eventQueue <- newTQueueIO :: IO (TQueue SDL.Event) - putStrLn "foo" now <- getCurrentTime - putStrLn "foo" --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 --TTF.setFontStyle font TTFNormal --TTF.setFontHinting font TTFHNormal From ffc0281ab4d98fc6c21ead6e60e2b99ce4e41e0b Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 11 May 2014 21:12:53 +0200 Subject: [PATCH 17/18] frame-limiter now works correctly, scaling up/down should be smoother --- src/Main.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index e7c9ac8..0a72ba3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -226,29 +226,32 @@ run = do } -} - (mt,tc,sleepAmount) <- liftIO $ do + (mt,tc,sleepAmount,frameTime) <- liftIO $ do let double = fromRational.toRational :: (Real a) => a -> Double - targetFramerate = 40.0 + targetFramerate = 60.0 targetFrametime = 1.0/targetFramerate targetFrametimeμs = targetFrametime * 1000000.0 now <- getCurrentTime let diff = diffUTCTime now (state ^. io.clock) -- get time-diffs title = unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] + ddiff = double diff SDL.setWindowTitle (env ^. windowObject) title let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds clockFactor = (state ^. io.tessClockFactor) tessChange - | (clockFactor > (2*targetFrametimeμs)) && (state ^. gl.glMap.stateTessellationFactor < 5) = ((+)1 :: Int -> Int) - -- > factor < 5 & 10% of frame idle -> increase graphics - | sleepAmount < 0 && (state ^. gl.glMap.stateTessellationFactor > 1) = (flip (-) 1 :: Int -> Int) - -- frame used up completely -> decrease + | (clockFactor < (75*targetFrametime)) && (state ^. gl.glMap.stateTessellationFactor < 5) = ((+)1 :: Int -> Int) + -- > last 100 frames had > 25% leftover (on avg.) + | (clockFactor > (110*targetFrametime)) && (state ^. gl.glMap.stateTessellationFactor > 1) = (flip (-) 1 :: Int -> Int) + -- > last 100 frames had < 90% of target-fps | otherwise = ((+)0 :: Int -> Int) -- 0ms > x > 10% -> keep settings when (sleepAmount > 0) $ threadDelay sleepAmount - return (now,tessChange,sleepAmount) + now' <- getCurrentTime + return (now',tessChange,sleepAmount,ddiff) -- 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"] modify $ (io.clock .~ mt) . (gl.glMap.stateTessellationFactor %~ tc) - . (io.tessClockFactor %~ (((+) (fromIntegral sleepAmount)).((*) 0.99))) + . (io.tessClockFactor %~ (((+) frameTime).((*) 0.99))) -- liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."] shouldClose' <- return $ state ^. window.shouldClose unless shouldClose' run From dba5c9d8098a44421b8b03667d9246c79a4f7ed4 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 12 May 2014 11:30:29 +0200 Subject: [PATCH 18/18] removed debug-print --- src/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Main.hs b/src/Main.hs index 0a72ba3..9196daf 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -248,7 +248,7 @@ run = do now' <- getCurrentTime return (now',tessChange,sleepAmount,ddiff) -- 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)),"\tsleep ",show frameTime,"ms"] modify $ (io.clock .~ mt) . (gl.glMap.stateTessellationFactor %~ tc) . (io.tessClockFactor %~ (((+) frameTime).((*) 0.99)))