From 3b8d3f8f9e47391ee7dc498714ed7ecdf54e4bfe Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 21 Jan 2014 16:18:48 +0100 Subject: [PATCH 01/22] tessellationgit status --- deps/getDeps.sh | 24 +++++++++++++++++++++++- shaders/fragment.shader | 23 +++++++++++++++++------ shaders/vertex.shader | 34 ++++++++++------------------------ src/Main.hs | 10 +++++++--- src/Render/Render.hs | 26 ++++++++++++++++++-------- 5 files changed, 75 insertions(+), 42 deletions(-) diff --git a/deps/getDeps.sh b/deps/getDeps.sh index e70bb7f..43ec790 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -26,8 +26,27 @@ then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb sudo gdebi libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb fi + if [ ! -f "libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb" ] + then + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb + sudo gdebi libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb + fi + if [ ! -f "libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb" ] + then + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb + sudo gdebi libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb + fi + if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ] + then + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb + sudo gdebi libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb + fi + if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ] + then + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb + sudo gdebi libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb + fi fi - ## hack end echo "cloning repositories" @@ -41,6 +60,9 @@ else fi echo "trying to build" + +cabal install haddock + for d in `find . -maxdepth 1 -type d` do if [ "$d" == "." ] diff --git a/shaders/fragment.shader b/shaders/fragment.shader index 7ae05d4..5bc334c 100644 --- a/shaders/fragment.shader +++ b/shaders/fragment.shader @@ -1,12 +1,23 @@ -#version 330 +#version 400 -//color from earlier stages -smooth in vec4 fg_SmoothColor; +smooth in vec3 teNormal; +in vec4 teColor; -out vec4 fg_FragColor; +out vec4 fgColor; + +uniform mat4 ViewMatrix; void main(void) { -//copy-shader - fg_FragColor = fg_SmoothColor; + //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; + + + fgColor = teColor * mix(dark, light, a); } \ No newline at end of file diff --git a/shaders/vertex.shader b/shaders/vertex.shader index 324aa46..70b8530 100644 --- a/shaders/vertex.shader +++ b/shaders/vertex.shader @@ -1,32 +1,18 @@ -#version 330 - -//constant projection matrix -uniform mat4 fg_ProjectionMatrix; -uniform mat4 fg_ViewMatrix; -uniform mat3 fg_NormalMatrix; +#version 400 //vertex-data -in vec4 fg_Color; -in vec3 fg_VertexIn; -in vec3 fg_NormalIn; +in vec4 Color; +in vec3 Position; +in vec3 Normal; //output-data for later stages -smooth out vec4 fg_SmoothColor; +out vec4 vColor; +out vec3 vPosition; +out vec3 vNormal; void main() { - vec3 fg_Normal = fg_NormalMatrix * fg_NormalIn; //vec3(0,1,0); - //transform vec3 into vec4, setting w to 1 - vec4 fg_Vertex = vec4(fg_VertexIn, 1.0); - 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(fg_ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz; - - - float costheta = dot(normalize(fg_Normal), lightDir); - float a = costheta * 0.5 + 0.5; - - fg_SmoothColor = fg_Color * mix(dark, light, a);// + 0.001* fg_Normal.xyzx; - gl_Position = fg_ProjectionMatrix * fg_ViewMatrix * fg_Vertex; + vPosition = Position; + vNormal = Normal; + vColor = Color; } \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 47222b3..94c85c2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -35,6 +35,7 @@ import qualified Graphics.Rendering.OpenGL.GL as GL import Graphics.Rendering.OpenGL.Raw.Core31 import Data.Time (getCurrentTime, UTCTime, diffUTCTime) +import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader -- Our modules import Map.Map import Render.Misc (checkError, @@ -122,8 +123,8 @@ main = do now <- getCurrentTime putStrLn "foo" - let zDistClosest = 10 - zDistFarthest = zDistClosest + 20 + let zDistClosest = 1 + zDistFarthest = zDistClosest + 30 fov = 90 --field of view near = 1 --near plane far = 100 --far plane @@ -231,8 +232,11 @@ draw = do GL.vertexAttribPointer vi GL.$= fgVertexIndex GL.vertexAttribArray vi GL.$= GL.Enabled checkError "beforeDraw" + + glPatchParameteri gl_PATCH_VERTICES 3 + glPolygonMode gl_FRONT gl_LINE - GL.drawArrays GL.Triangles 0 numVert + glDrawArrays gl_PATCHES 0 (fromIntegral numVert) checkError "draw" diff --git a/src/Render/Render.hs b/src/Render/Render.hs index c7e9d5b..362714d 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -18,6 +18,10 @@ import Render.Misc vertexShaderFile :: String vertexShaderFile = "shaders/vertex.shader" +tessControlShaderFile :: String +tessControlShaderFile = "shaders/tessControl.shader" +tessEvalShaderFile :: String +tessEvalShaderFile = "shaders/tessEval.shader" fragmentShaderFile :: String fragmentShaderFile = "shaders/fragment.shader" @@ -45,37 +49,43 @@ initShader :: IO ( ) initShader = do ! vertexSource <- B.readFile vertexShaderFile + ! tessControlSource <- B.readFile tessControlShaderFile + ! tessEvalSource <- B.readFile tessEvalShaderFile ! fragmentSource <- B.readFile fragmentShaderFile vertexShader <- compileShaderSource VertexShader vertexSource checkError "compile Vertex" + tessControlShader <- compileShaderSource TessControlShader tessControlSource + checkError "compile Vertex" + tessEvalShader <- compileShaderSource TessEvaluationShader tessEvalSource + checkError "compile Vertex" fragmentShader <- compileShaderSource FragmentShader fragmentSource checkError "compile Frag" - program <- createProgramUsing [vertexShader, fragmentShader] + program <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShader] checkError "compile Program" currentProgram $= Just program - projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix") + projectionMatrixIndex <- get (uniformLocation program "ProjectionMatrix") checkError "projMat" - viewMatrixIndex <- get (uniformLocation program "fg_ViewMatrix") + viewMatrixIndex <- get (uniformLocation program "ViewMatrix") checkError "viewMat" - modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix") + modelMatrixIndex <- get (uniformLocation program "ModelMatrix") checkError "modelMat" - normalMatrixIndex <- get (uniformLocation program "fg_NormalMatrix") + normalMatrixIndex <- get (uniformLocation program "NormalMatrix") checkError "normalMat" - vertexIndex <- get (attribLocation program "fg_VertexIn") + vertexIndex <- get (attribLocation program "Position") vertexAttribArray vertexIndex $= Enabled checkError "vertexInd" - normalIndex <- get (attribLocation program "fg_NormalIn") + normalIndex <- get (attribLocation program "Normal") vertexAttribArray normalIndex $= Enabled checkError "normalInd" - colorIndex <- get (attribLocation program "fg_Color") + colorIndex <- get (attribLocation program "Color") vertexAttribArray colorIndex $= Enabled checkError "colorInd" From 8b7d2d6c1a9e61585a34e411c10dd267bf45888f Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 21 Jan 2014 16:19:07 +0100 Subject: [PATCH 02/22] forgot shaders -.- --- shaders/tessControl.shader | 26 +++++++++++++++++++++++ shaders/tessEval.shader | 42 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+) create mode 100644 shaders/tessControl.shader create mode 100644 shaders/tessEval.shader diff --git a/shaders/tessControl.shader b/shaders/tessControl.shader new file mode 100644 index 0000000..36bae7f --- /dev/null +++ b/shaders/tessControl.shader @@ -0,0 +1,26 @@ +#version 400 + +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/tessEval.shader b/shaders/tessEval.shader new file mode 100644 index 0000000..35ae2d7 --- /dev/null +++ b/shaders/tessEval.shader @@ -0,0 +1,42 @@ +#version 400 + +layout(triangles, equal_spacing, cw) in; +in vec3 tcPosition[]; +in vec4 tcColor[]; +in vec3 tcNormal[]; +//out vec3 tePosition; +out vec4 teColor; +smooth out vec3 teNormal; +//out vec3 tePatchDistance; +//constant projection matrix +uniform mat4 ProjectionMatrix; +uniform mat4 ViewMatrix; +uniform mat3 NormalMatrix; + +void main() +{ + vec3 p0 = gl_TessCoord.x * tcPosition[0]; + vec3 p1 = gl_TessCoord.y * tcPosition[1]; + vec3 p2 = gl_TessCoord.z * tcPosition[2]; + //tePatchDistance = gl_TessCoord; + vec3 tePosition = p0 + p1 + p2; + + 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; + + //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; + + vec4 c0 = gl_TessCoord.x * tcColor[0]; + vec4 c1 = gl_TessCoord.y * tcColor[1]; + vec4 c2 = gl_TessCoord.z * tcColor[2]; + teColor = c0 + c1 + c2; + + gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition+tessNormal*standout, 1); +} \ No newline at end of file From 080776b25c1d79a18867c671a69995a2eecdf828 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 21 Jan 2014 16:44:42 +0100 Subject: [PATCH 03/22] keyboard-controls for tessellation --- src/Main.hs | 26 +++++++++++++++++++++++++- src/Render/Render.hs | 11 ++++++++++- 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 94c85c2..d98b377 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -93,6 +93,9 @@ data State = State , shdrViewMatIndex :: !GL.UniformLocation , shdrModelMatIndex :: !GL.UniformLocation , shdrNormalMatIndex :: !GL.UniformLocation + , shdrTessInnerIndex :: !GL.UniformLocation + , shdrTessOuterIndex :: !GL.UniformLocation + , stateTessellationFactor :: !Int --- the map , stateMap :: !GL.BufferObject , mapVert :: !GL.NumArrayIndices @@ -116,7 +119,7 @@ main = do initRendering --generate map vertices (mapBuffer, vert) <- getMapBufferObject - (ci, ni, vi, pri, vii, mi, nmi) <- initShader + (ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initShader putStrLn "foo" eventQueue <- newTQueueIO :: IO (TQueue Event) putStrLn "foo" @@ -165,12 +168,15 @@ main = do , shdrViewMatIndex = vii , shdrModelMatIndex = mi , shdrNormalMatIndex = nmi + , shdrTessInnerIndex = tli + , shdrTessOuterIndex = tlo , stateMap = mapBuffer , mapVert = vert , stateFrustum = frust , stateWinClose = False , stateClock = now , stateArrowsPressed = aks + , stateTessellationFactor = 4 } putStrLn "init done." @@ -189,6 +195,8 @@ draw = do (GL.UniformLocation proj) = shdrProjMatIndex state (GL.UniformLocation nmat) = shdrNormalMatIndex state (GL.UniformLocation vmat) = shdrViewMatIndex state + (GL.UniformLocation tli) = shdrTessInnerIndex state + (GL.UniformLocation tlo) = shdrTessOuterIndex state vi = shdrVertexIndex state ni = shdrNormalIndex state ci = shdrColorIndex state @@ -198,6 +206,7 @@ draw = do camX = statePositionX state camY = statePositionY state zDist = stateZDist state + tessFac = stateTessellationFactor state liftIO $ do --(vi,GL.UniformLocation proj) <- initShader GL.clear [GL.ColorBuffer, GL.DepthBuffer] @@ -223,6 +232,9 @@ draw = do glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat))) checkError "nmat" + + glUniform1f tli (fromIntegral tessFac) + glUniform1f tlo (fromIntegral tessFac) GL.bindBuffer GL.ArrayBuffer GL.$= Just map' GL.vertexAttribPointer ci GL.$= fgColorIndex @@ -387,6 +399,18 @@ processEvent e = do arrowDown = movement == KeyDown } } + SDL.KeypadPlus -> when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + SDL.KeypadMinus -> when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] _ -> return () MouseMotion _ id st (Position x y) xrel yrel -> do state <- get diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 362714d..5c00dab 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -46,6 +46,8 @@ initShader :: IO ( , UniformLocation -- ^ ViewMat , UniformLocation -- ^ ModelMat , UniformLocation -- ^ NormalMat + , UniformLocation -- ^ TessLevelInner + , UniformLocation -- ^ TessLevelOuter ) initShader = do ! vertexSource <- B.readFile vertexShaderFile @@ -77,6 +79,13 @@ initShader = do normalMatrixIndex <- get (uniformLocation program "NormalMatrix") checkError "normalMat" + tessLevelInner <- get (uniformLocation program "TessLevelInner") + checkError "TessLevelInner" + + tessLevelOuter <- get (uniformLocation program "TessLevelOuter") + checkError "TessLevelOuter" + + vertexIndex <- get (attribLocation program "Position") vertexAttribArray vertexIndex $= Enabled checkError "vertexInd" @@ -95,7 +104,7 @@ initShader = do putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)] checkError "initShader" - return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex) + return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter) initRendering :: IO () initRendering = do From 5f313c4495bf5334a21295a9df8648cb06f960aa Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 14:04:18 +0100 Subject: [PATCH 04/22] Window shows fps-count + proc-tex-shader - added fps to window-name - hsSDL2 needs update (as i changed functions in there which got merged) - wrote simplistic procedural texture shader --- shaders/3rdParty/noise2D.glsl | 70 +++++++++++++++++++ shaders/3rdParty/noise3D.glsl | 102 +++++++++++++++++++++++++++ shaders/3rdParty/noise4D.glsl | 128 ++++++++++++++++++++++++++++++++++ shaders/fragment.shader | 124 +++++++++++++++++++++++++++++++- shaders/tessEval.shader | 31 ++++---- src/Main.hs | 5 +- src/Render/Misc.hs | 6 +- 7 files changed, 447 insertions(+), 19 deletions(-) create mode 100644 shaders/3rdParty/noise2D.glsl create mode 100644 shaders/3rdParty/noise3D.glsl create mode 100644 shaders/3rdParty/noise4D.glsl diff --git a/shaders/3rdParty/noise2D.glsl b/shaders/3rdParty/noise2D.glsl new file mode 100644 index 0000000..cf99353 --- /dev/null +++ b/shaders/3rdParty/noise2D.glsl @@ -0,0 +1,70 @@ +// +// Description : Array and textureless GLSL 2D simplex noise function. +// Author : Ian McEwan, Ashima Arts. +// Maintainer : ijm +// Lastmod : 20110822 (ijm) +// License : Copyright (C) 2011 Ashima Arts. All rights reserved. +// Distributed under the MIT License. See LICENSE file. +// https://github.com/ashima/webgl-noise +// + +vec3 mod289(vec3 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec2 mod289(vec2 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; +} + +vec3 permute(vec3 x) { + return mod289(((x*34.0)+1.0)*x); +} + +float snoise(vec2 v) + { + const vec4 C = vec4(0.211324865405187, // (3.0-sqrt(3.0))/6.0 + 0.366025403784439, // 0.5*(sqrt(3.0)-1.0) + -0.577350269189626, // -1.0 + 2.0 * C.x + 0.024390243902439); // 1.0 / 41.0 +// First corner + vec2 i = floor(v + dot(v, C.yy) ); + vec2 x0 = v - i + dot(i, C.xx); + +// Other corners + vec2 i1; + //i1.x = step( x0.y, x0.x ); // x0.x > x0.y ? 1.0 : 0.0 + //i1.y = 1.0 - i1.x; + i1 = (x0.x > x0.y) ? vec2(1.0, 0.0) : vec2(0.0, 1.0); + // x0 = x0 - 0.0 + 0.0 * C.xx ; + // x1 = x0 - i1 + 1.0 * C.xx ; + // x2 = x0 - 1.0 + 2.0 * C.xx ; + vec4 x12 = x0.xyxy + C.xxzz; + x12.xy -= i1; + +// Permutations + i = mod289(i); // Avoid truncation effects in permutation + vec3 p = permute( permute( i.y + vec3(0.0, i1.y, 1.0 )) + + i.x + vec3(0.0, i1.x, 1.0 )); + + vec3 m = max(0.5 - vec3(dot(x0,x0), dot(x12.xy,x12.xy), dot(x12.zw,x12.zw)), 0.0); + m = m*m ; + m = m*m ; + +// Gradients: 41 points uniformly over a line, mapped onto a diamond. +// The ring size 17*17 = 289 is close to a multiple of 41 (41*7 = 287) + + vec3 x = 2.0 * fract(p * C.www) - 1.0; + vec3 h = abs(x) - 0.5; + vec3 ox = floor(x + 0.5); + vec3 a0 = x - ox; + +// Normalise gradients implicitly by scaling m +// Approximation of: m *= inversesqrt( a0*a0 + h*h ); + m *= 1.79284291400159 - 0.85373472095314 * ( a0*a0 + h*h ); + +// Compute final noise value at P + vec3 g; + g.x = a0.x * x0.x + h.x * x0.y; + g.yz = a0.yz * x12.xz + h.yz * x12.yw; + return 130.0 * dot(m, g); +} diff --git a/shaders/3rdParty/noise3D.glsl b/shaders/3rdParty/noise3D.glsl new file mode 100644 index 0000000..ea75001 --- /dev/null +++ b/shaders/3rdParty/noise3D.glsl @@ -0,0 +1,102 @@ +// +// Description : Array and textureless GLSL 2D/3D/4D simplex +// noise functions. +// Author : Ian McEwan, Ashima Arts. +// Maintainer : ijm +// Lastmod : 20110822 (ijm) +// License : Copyright (C) 2011 Ashima Arts. All rights reserved. +// Distributed under the MIT License. See LICENSE file. +// https://github.com/ashima/webgl-noise +// + +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) ) ); + } diff --git a/shaders/3rdParty/noise4D.glsl b/shaders/3rdParty/noise4D.glsl new file mode 100644 index 0000000..93786ae --- /dev/null +++ b/shaders/3rdParty/noise4D.glsl @@ -0,0 +1,128 @@ +// +// Description : Array and textureless GLSL 2D/3D/4D simplex +// noise functions. +// Author : Ian McEwan, Ashima Arts. +// Maintainer : ijm +// Lastmod : 20110822 (ijm) +// License : Copyright (C) 2011 Ashima Arts. All rights reserved. +// Distributed under the MIT License. See LICENSE file. +// https://github.com/ashima/webgl-noise +// + +vec4 mod289(vec4 x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; } + +float mod289(float x) { + return x - floor(x * (1.0 / 289.0)) * 289.0; } + +vec4 permute(vec4 x) { + return mod289(((x*34.0)+1.0)*x); +} + +float permute(float x) { + return mod289(((x*34.0)+1.0)*x); +} + +vec4 taylorInvSqrt(vec4 r) +{ + return 1.79284291400159 - 0.85373472095314 * r; +} + +float taylorInvSqrt(float r) +{ + return 1.79284291400159 - 0.85373472095314 * r; +} + +vec4 grad4(float j, vec4 ip) + { + const vec4 ones = vec4(1.0, 1.0, 1.0, -1.0); + vec4 p,s; + + p.xyz = floor( fract (vec3(j) * ip.xyz) * 7.0) * ip.z - 1.0; + p.w = 1.5 - dot(abs(p.xyz), ones.xyz); + s = vec4(lessThan(p, vec4(0.0))); + p.xyz = p.xyz + (s.xyz*2.0 - 1.0) * s.www; + + return p; + } + +// (sqrt(5) - 1)/4 = F4, used once below +#define F4 0.309016994374947451 + +float snoise(vec4 v) + { + const vec4 C = vec4( 0.138196601125011, // (5 - sqrt(5))/20 G4 + 0.276393202250021, // 2 * G4 + 0.414589803375032, // 3 * G4 + -0.447213595499958); // -1 + 4 * G4 + +// First corner + vec4 i = floor(v + dot(v, vec4(F4)) ); + vec4 x0 = v - i + dot(i, C.xxxx); + +// Other corners + +// Rank sorting originally contributed by Bill Licea-Kane, AMD (formerly ATI) + vec4 i0; + vec3 isX = step( x0.yzw, x0.xxx ); + vec3 isYZ = step( x0.zww, x0.yyz ); +// i0.x = dot( isX, vec3( 1.0 ) ); + i0.x = isX.x + isX.y + isX.z; + i0.yzw = 1.0 - isX; +// i0.y += dot( isYZ.xy, vec2( 1.0 ) ); + i0.y += isYZ.x + isYZ.y; + i0.zw += 1.0 - isYZ.xy; + i0.z += isYZ.z; + i0.w += 1.0 - isYZ.z; + + // i0 now contains the unique values 0,1,2,3 in each channel + vec4 i3 = clamp( i0, 0.0, 1.0 ); + vec4 i2 = clamp( i0-1.0, 0.0, 1.0 ); + vec4 i1 = clamp( i0-2.0, 0.0, 1.0 ); + + // x0 = x0 - 0.0 + 0.0 * C.xxxx + // x1 = x0 - i1 + 1.0 * C.xxxx + // x2 = x0 - i2 + 2.0 * C.xxxx + // x3 = x0 - i3 + 3.0 * C.xxxx + // x4 = x0 - 1.0 + 4.0 * C.xxxx + vec4 x1 = x0 - i1 + C.xxxx; + vec4 x2 = x0 - i2 + C.yyyy; + vec4 x3 = x0 - i3 + C.zzzz; + vec4 x4 = x0 + C.wwww; + +// Permutations + i = mod289(i); + float j0 = permute( permute( permute( permute(i.w) + i.z) + i.y) + i.x); + vec4 j1 = permute( permute( permute( permute ( + i.w + vec4(i1.w, i2.w, i3.w, 1.0 )) + + i.z + vec4(i1.z, i2.z, i3.z, 1.0 )) + + i.y + vec4(i1.y, i2.y, i3.y, 1.0 )) + + i.x + vec4(i1.x, i2.x, i3.x, 1.0 )); + +// Gradients: 7x7x6 points over a cube, mapped onto a 4-cross polytope +// 7*7*6 = 294, which is close to the ring size 17*17 = 289. + vec4 ip = vec4(1.0/294.0, 1.0/49.0, 1.0/7.0, 0.0) ; + + vec4 p0 = grad4(j0, ip); + vec4 p1 = grad4(j1.x, ip); + vec4 p2 = grad4(j1.y, ip); + vec4 p3 = grad4(j1.z, ip); + vec4 p4 = grad4(j1.w, ip); + +// 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; + p4 *= taylorInvSqrt(dot(p4,p4)); + +// Mix contributions from the five corners + vec3 m0 = max(0.6 - vec3(dot(x0,x0), dot(x1,x1), dot(x2,x2)), 0.0); + vec2 m1 = max(0.6 - vec2(dot(x3,x3), dot(x4,x4) ), 0.0); + m0 = m0 * m0; + m1 = m1 * m1; + return 49.0 * ( dot(m0*m0, vec3( dot( p0, x0 ), dot( p1, x1 ), dot( p2, x2 ))) + + dot(m1*m1, vec2( dot( p3, x3 ), dot( p4, x4 ) ) ) ) ; + + } diff --git a/shaders/fragment.shader b/shaders/fragment.shader index 5bc334c..aeb0ffc 100644 --- a/shaders/fragment.shader +++ b/shaders/fragment.shader @@ -1,6 +1,103 @@ #version 400 +//#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) ) ); + } + + smooth in vec3 teNormal; +smooth in vec3 tePosition; +smooth in float gmix; in vec4 teColor; out vec4 fgColor; @@ -18,6 +115,31 @@ void main(void) 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] - fgColor = teColor * mix(dark, light, a); + //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); } \ No newline at end of file diff --git a/shaders/tessEval.shader b/shaders/tessEval.shader index 35ae2d7..d0c6648 100644 --- a/shaders/tessEval.shader +++ b/shaders/tessEval.shader @@ -4,9 +4,10 @@ layout(triangles, equal_spacing, cw) in; in vec3 tcPosition[]; in vec4 tcColor[]; in vec3 tcNormal[]; -//out vec3 tePosition; +out vec3 tePosition; out vec4 teColor; smooth out vec3 teNormal; +smooth out float gmix; //mixture of gravel //out vec3 tePatchDistance; //constant projection matrix uniform mat4 ProjectionMatrix; @@ -15,28 +16,34 @@ uniform mat3 NormalMatrix; void main() { - vec3 p0 = gl_TessCoord.x * tcPosition[0]; - vec3 p1 = gl_TessCoord.y * tcPosition[1]; - vec3 p2 = gl_TessCoord.z * tcPosition[2]; - //tePatchDistance = gl_TessCoord; - vec3 tePosition = p0 + p1 + p2; - + //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; + gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1); - vec4 c0 = gl_TessCoord.x * tcColor[0]; - vec4 c1 = gl_TessCoord.y * tcColor[1]; - vec4 c2 = gl_TessCoord.z * tcColor[2]; - teColor = c0 + c1 + c2; + //COLOR-BLENDING + vec4 c0 = sqrt(gl_TessCoord.x) * tcColor[0]; + vec4 c1 = sqrt(gl_TessCoord.y) * tcColor[1]; + vec4 c2 = sqrt(gl_TessCoord.z) * tcColor[2]; + teColor = (c0 + c1 + c2)/(sqrt(gl_TessCoord.x)+sqrt(gl_TessCoord.y)+sqrt(gl_TessCoord.z)); + + //mix gravel based on incline (sin (normal,up)) + gmix = length(cross(tessNormal, vec3(0,1,0))); - gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition+tessNormal*standout, 1); } \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index d98b377..dcde748 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -315,6 +315,8 @@ run = do mt <- liftIO $ do now <- getCurrentTime diff <- return $ diffUTCTime now (stateClock state) -- get time-diffs + title <- return $ unwords ["Pioneers @ ",show $ ((round .fromRational.toRational $ 1/diff)::Int),"fps"] + setWindowTitle win $ title sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds threadDelay sleepAmount return now @@ -447,5 +449,4 @@ processEvent e = do } Quit -> modify $ \s -> s {stateWinClose = True} -- there is more (joystic, touchInterface, ...), but currently ignored - _ -> return () - liftIO $ putStrLn $ unwords ["Processing Event:",(show e)] \ No newline at end of file + _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file diff --git a/src/Render/Misc.hs b/src/Render/Misc.hs index 2143126..f8016f5 100644 --- a/src/Render/Misc.hs +++ b/src/Render/Misc.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Render.Misc where import Control.Monad import qualified Data.ByteString as B (ByteString) -import Foreign.Marshal.Array (allocaArray, - pokeArray) -import Foreign.C (CFloat) import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GL.StateVar import Graphics.Rendering.OpenGL.GL.StringQueries @@ -12,7 +10,7 @@ import Graphics.Rendering.OpenGL.GLU.Errors import Graphics.Rendering.OpenGL.Raw.Core31 import System.IO (hPutStrLn, stderr) import Linear - +import Foreign.C (CFloat) up :: V3 CFloat up = V3 0 1 0 From 98fd45214ec69a7eaa7eb1fe6b933615ce7e41a3 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 15:16:08 +0100 Subject: [PATCH 05/22] added travis.yml --- .travis.yml | 1 + 1 file changed, 1 insertion(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..999bd37 --- /dev/null +++ b/.travis.yml @@ -0,0 +1 @@ +language: haskell From a272e583bb903ebf3816fedfd26177943c90bdcc Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 15:28:29 +0100 Subject: [PATCH 06/22] travis-changes --- .travis.prepare.sh | 4 ++++ .travis.yml | 2 ++ deps/getDeps.sh | 26 +++++++++++++++----------- 3 files changed, 21 insertions(+), 11 deletions(-) create mode 100644 .travis.prepare.sh diff --git a/.travis.prepare.sh b/.travis.prepare.sh new file mode 100644 index 0000000..691cf47 --- /dev/null +++ b/.travis.prepare.sh @@ -0,0 +1,4 @@ +#!/bin/bash +cd deps +./getDeps.sh +cd .. diff --git a/.travis.yml b/.travis.yml index 999bd37..bd80cbd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1 +1,3 @@ language: haskell +before_install: + ./travis.prepare.sh diff --git a/deps/getDeps.sh b/deps/getDeps.sh index 43ec790..4514f31 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -2,10 +2,14 @@ #hack until saucy has 2.0.1 instead of 2.0.0 -sudo apt-get install dialog - -dialog --yesno "Install libSDL2.0.1 from ubuntu trusty?\nCurrently needed for saucy as they only serve 2.0.0 in the repos\n\nThe script will try to download the trusty-packages and resolve dependencies via gdebi" 20 75 -install=${?} +if [ "$1" != "ni" ] +then + sudo apt-get install dialog + dialog --yesno "Install libSDL2.0.1 from ubuntu trusty?\nCurrently needed for saucy as they only serve 2.0.0 in the repos\n\nThe script will try to download the trusty-packages and resolve dependencies via gdebi" 20 75 + install=${?} +else + install=0 +fi if [[ $install -eq 0 ]] then @@ -14,37 +18,37 @@ then if [ ! -f "libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb - sudo gdebi libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb + sudo gdebi --n libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb fi if [ ! -f "libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb - sudo gdebi libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb + sudo gdebi --n libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb fi if [ ! -f "libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb - sudo gdebi libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb + sudo gdebi --n libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb fi if [ ! -f "libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb - sudo gdebi libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb + sudo gdebi --n libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb fi if [ ! -f "libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb - sudo gdebi libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb + sudo gdebi --n libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb fi if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb - sudo gdebi libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb + sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb fi if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ] then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb - sudo gdebi libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb + sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb fi fi ## hack end From fe675019eff164cace421b12578f33282b764a57 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 15:33:27 +0100 Subject: [PATCH 07/22] formatting in yml --- .travis.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index bd80cbd..32391d8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,2 @@ language: haskell -before_install: - ./travis.prepare.sh +before_install: ./travis.prepare.sh From 84e8403209139dc4914de1453838858cce49edf3 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 15:36:20 +0100 Subject: [PATCH 08/22] meh .. travis -.- --- .travis.prepare.sh | 0 .travis.yml | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 .travis.prepare.sh diff --git a/.travis.prepare.sh b/.travis.prepare.sh old mode 100644 new mode 100755 diff --git a/.travis.yml b/.travis.yml index 32391d8..3b05233 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,2 +1,2 @@ language: haskell -before_install: ./travis.prepare.sh +before_install: sh .travis.prepare.sh From a0381396771679e9473cc1d15d302e81b271fd78 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Jan 2014 15:38:25 +0100 Subject: [PATCH 09/22] forget ni-switch.. --- .travis.prepare.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.prepare.sh b/.travis.prepare.sh index 691cf47..eb8fac5 100755 --- a/.travis.prepare.sh +++ b/.travis.prepare.sh @@ -1,4 +1,4 @@ #!/bin/bash cd deps -./getDeps.sh +./getDeps.sh ni #non-interactively.. cd .. From 0d887354d5d96ffcd36e8b77838407b691b501f8 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 13:58:12 +0100 Subject: [PATCH 10/22] added resize-handler, made event-code not as wide --- src/Main.hs | 173 +++++++++++++++++++++++++++++----------------------- 1 file changed, 96 insertions(+), 77 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index dcde748..85ce4bd 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -369,84 +369,103 @@ processEvents = do processEvent :: Event -> Pioneers () processEvent e = do case eventData e of - Window _ winEvent -> - case winEvent of - Closing -> modify $ \s -> s { - stateWinClose = True - } - _ -> return () - Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey - -- need modifiers? use "keyModifiers key" to get them - case keyScancode key of - Escape -> modify $ \s -> s { - stateWinClose = True - } - SDL.Left -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowLeft = movement == KeyDown - } - } - SDL.Right -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowRight = movement == KeyDown - } - } - SDL.Up -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowUp = movement == KeyDown - } - } - SDL.Down -> modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowDown = movement == KeyDown - } - } - SDL.KeypadPlus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 - } - state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] - SDL.KeypadMinus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 - } - state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] - _ -> return () - MouseMotion _ id st (Position x y) xrel yrel -> do - state <- get - when (stateMouseDown state && not (stateDragging state)) $ - put $ state - { stateDragging = True - , stateDragStartX = fromIntegral x - , stateDragStartY = fromIntegral y - , stateDragStartXAngle = stateXAngle state - , stateDragStartYAngle = stateYAngle state + Window _ winEvent -> + case winEvent of + Closing -> + modify $ \s -> s { + stateWinClose = True } + Resized {windowResizedTo=size} -> do + modify $ \s -> s { + stateWindowWidth = sizeWidth size + ,stateWindowHeight = sizeHeight size + } + adjustWindow + SizeChanged -> + adjustWindow + _ -> + liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",(show e)] + Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey + -- need modifiers? use "keyModifiers key" to get them + case keyScancode key of + Escape -> modify $ \s -> s { - stateCursorPosX = fromIntegral x - , stateCursorPosY = fromIntegral y + stateWinClose = True } - MouseButton _ id button state (Position x y) -> - case button of - LeftButton -> do - let pressed = state == Pressed - modify $ \s -> s - { stateMouseDown = pressed - } - unless pressed $ - modify $ \s -> s - { stateDragging = False - } - _ -> return () - MouseWheel _ id hscroll vscroll -> do - env <- ask - modify $ \s -> s - { stateZDist = - let zDist' = stateZDist s + realToFrac (negate $ vscroll) - in curb (envZDistClosest env) (envZDistFarthest env) zDist' + SDL.Left -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowLeft = movement == KeyDown + } } - Quit -> modify $ \s -> s {stateWinClose = True} - -- there is more (joystic, touchInterface, ...), but currently ignored - _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file + SDL.Right -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowRight = movement == KeyDown + } + } + SDL.Up -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowUp = movement == KeyDown + } + } + SDL.Down -> + modify $ \s -> s { + stateArrowsPressed = (stateArrowsPressed s) { + arrowDown = movement == KeyDown + } + } + SDL.KeypadPlus -> + when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + SDL.KeypadMinus -> + when (movement == KeyDown) $ do + modify $ \s -> s { + stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 + } + state <- get + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + _ -> + return () + MouseMotion _ id st (Position x y) xrel yrel -> do + state <- get + when (stateMouseDown state && not (stateDragging state)) $ + put $ state + { stateDragging = True + , stateDragStartX = fromIntegral x + , stateDragStartY = fromIntegral y + , stateDragStartXAngle = stateXAngle state + , stateDragStartYAngle = stateYAngle state + } + modify $ \s -> s { + stateCursorPosX = fromIntegral x + , stateCursorPosY = fromIntegral y + } + MouseButton _ id button state (Position x y) -> + case button of + LeftButton -> do + let pressed = state == Pressed + modify $ \s -> s { + stateMouseDown = pressed + } + unless pressed $ + modify $ \s -> s { + stateDragging = False + } + _ -> + return () + MouseWheel _ id hscroll vscroll -> do + env <- ask + modify $ \s -> s + { stateZDist = + let zDist' = stateZDist s + realToFrac (negate $ vscroll) + in curb (envZDistClosest env) (envZDistFarthest env) zDist' + } + Quit -> modify $ \s -> s {stateWinClose = True} + -- there is more (joystic, touchInterface, ...), but currently ignored + _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file From 02c02454fd64989eb6557cd1c8275e3260184654 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 14:11:16 +0100 Subject: [PATCH 11/22] cleaned up - removed unused imports - removed unneccessary $ - removed unneccessary () - changed variables hiding functions --- src/Main.hs | 53 ++++++++++++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 85ce4bd..6bfeaa8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,18 +2,14 @@ module Main where -- Monad-foo and higher functional stuff -import Control.Applicative import Control.Monad (unless, void, when, join) -import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Control.Arrow ((***)) -- data consistency/conversion import Control.Concurrent (threadDelay) -import Control.Concurrent.STM (TQueue, atomically, - newTQueueIO, - tryReadTQueue, - writeTQueue, isEmptyTQueue, - STM) +import Control.Concurrent.STM (TQueue, + newTQueueIO) + import Control.Monad.RWS.Strict (RWST, ask, asks, evalRWST, get, liftIO, modify, put) @@ -24,7 +20,7 @@ import Foreign (Ptr, castPtr, with) import Foreign.C (CFloat) -- Math -import Control.Lens (transposeOf, (^.)) +import Control.Lens ((^.)) import Linear as L -- GUI @@ -40,7 +36,7 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader import Map.Map import Render.Misc (checkError, createFrustum, getCam, - lookAt, up, curb) + curb) import Render.Render (initRendering, initShader) @@ -128,6 +124,7 @@ main = do let zDistClosest = 1 zDistFarthest = zDistClosest + 30 + --TODO: Move near/far/fov to state for runtime-changability & central storage fov = 90 --field of view near = 1 --near plane far = 100 --far plane @@ -188,7 +185,6 @@ main = do draw :: Pioneers () draw = do - env <- ask state <- get let xa = stateXAngle state ya = stateYAngle state @@ -212,23 +208,23 @@ draw = do GL.clear [GL.ColorBuffer, GL.DepthBuffer] checkError "foo" --set up projection (= copy from state) - with (distribute $ frust) $ \ptr -> + with (distribute frust) $ \ptr -> glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) checkError "foo" --set up camera let ! cam = getCam (camX,camY) zDist xa ya - with (distribute $ cam) $ \ptr -> + with (distribute cam) $ \ptr -> glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) checkError "foo" --set up normal--Mat transpose((model*camera)^-1) - let normal = (case inv33 ((fmap (^._xyz) cam) ^. _xyz) of + let normal = (case inv33 (fmap (^. _xyz) cam ^. _xyz) of (Just a) -> a Nothing -> eye3) :: M33 CFloat - nmap = (collect (fmap id) normal) :: M33 CFloat --transpose... + nmap = collect id normal :: M33 CFloat --transpose... - with (distribute $ nmap) $ \ptr -> + with (distribute nmap) $ \ptr -> glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat))) checkError "nmat" @@ -260,8 +256,7 @@ run = do -- draw Scene draw - liftIO $ do - glSwapWindow win + liftIO $ glSwapWindow win -- getEvents & process processEvents @@ -292,7 +287,7 @@ run = do -- get cursor-keys - if pressed --TODO: Add sin/cos from stateYAngle - (kxrot, kyrot) <- fmap ((join (***)) fromIntegral) getArrowMovement + (kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement modify $ \s -> let multc = cos $ stateYAngle s @@ -315,8 +310,8 @@ run = do mt <- liftIO $ do now <- getCurrentTime diff <- return $ diffUTCTime now (stateClock state) -- get time-diffs - title <- return $ unwords ["Pioneers @ ",show $ ((round .fromRational.toRational $ 1/diff)::Int),"fps"] - setWindowTitle win $ title + title <- return $ unwords ["Pioneers @ ",show ((round .fromRational.toRational $ 1.0/diff)::Int),"fps"] + setWindowTitle win title sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds threadDelay sleepAmount return now @@ -384,8 +379,8 @@ processEvent e = do SizeChanged -> adjustWindow _ -> - liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",(show e)] - Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey + liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] + Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey -- need modifiers? use "keyModifiers key" to get them case keyScancode key of Escape -> @@ -419,20 +414,20 @@ processEvent e = do SDL.KeypadPlus -> when (movement == KeyDown) $ do modify $ \s -> s { - stateTessellationFactor = min ((stateTessellationFactor s)+1) 5 + stateTessellationFactor = min (stateTessellationFactor s + 1) 5 } state <- get liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] SDL.KeypadMinus -> when (movement == KeyDown) $ do modify $ \s -> s { - stateTessellationFactor = max ((stateTessellationFactor s)-1) 1 + stateTessellationFactor = max (stateTessellationFactor s - 1) 1 } state <- get liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] _ -> return () - MouseMotion _ id st (Position x y) xrel yrel -> do + MouseMotion _ mouseId st (Position x y) xrel yrel -> do state <- get when (stateMouseDown state && not (stateDragging state)) $ put $ state @@ -446,7 +441,7 @@ processEvent e = do stateCursorPosX = fromIntegral x , stateCursorPosY = fromIntegral y } - MouseButton _ id button state (Position x y) -> + MouseButton _ mouseId button state (Position x y) -> case button of LeftButton -> do let pressed = state == Pressed @@ -459,13 +454,13 @@ processEvent e = do } _ -> return () - MouseWheel _ id hscroll vscroll -> do + MouseWheel _ mouseId hscroll vscroll -> do env <- ask modify $ \s -> s { stateZDist = - let zDist' = stateZDist s + realToFrac (negate $ vscroll) + let zDist' = stateZDist s + realToFrac (negate vscroll) in curb (envZDistClosest env) (envZDistFarthest env) zDist' } Quit -> modify $ \s -> s {stateWinClose = True} -- there is more (joystic, touchInterface, ...), but currently ignored - _ -> liftIO $ putStrLn $ unwords ["Not processing Event:",(show e)] \ No newline at end of file + _ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e] \ No newline at end of file From 2d97d4e8caa0d6495e8e282013349cee06ad9709 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Tue, 4 Feb 2014 14:15:15 +0100 Subject: [PATCH 12/22] added performance-compile-options - added various GHC-Option to perform a better compile - Using LLVM to optimize further --- Pioneers.cabal | 2 +- src/Main.hs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index e12f96b..338f404 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -6,7 +6,7 @@ author: sdressel executable Pioneers hs-source-dirs: src - ghc-options: -Wall + ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm other-modules: Map.Map, Render.Misc, diff --git a/src/Main.hs b/src/Main.hs index 6bfeaa8..a872a91 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -378,8 +378,9 @@ processEvent e = do adjustWindow SizeChanged -> adjustWindow - _ -> - liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] + _ -> + return () + --liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey -- need modifiers? use "keyModifiers key" to get them case keyScancode key of From 1126cfc25af9e74d0f8abe8a55a70bcb3821691d Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 5 Feb 2014 16:33:32 +0100 Subject: [PATCH 13/22] moved types to types - moved types to types - added callback - included sdl-ttf --- Pioneers.cabal | 7 +++-- deps/getDeps.sh | 11 ++++++- src/Main.hs | 84 +++++++++++++------------------------------------ 3 files changed, 36 insertions(+), 66 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index 338f404..f49b250 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -11,7 +11,9 @@ executable Pioneers Map.Map, Render.Misc, Render.Render, - Render.RenderObject + Render.RenderObject, + UI.Callbacks, + Types main-is: Main.hs build-depends: base >=4.6, @@ -29,5 +31,6 @@ executable Pioneers linear >=1.3.1 && <1.4, lens >=3.10.1 && <3.11, SDL2 >= 0.1.0, - time >=1.4.0 && <1.5 + time >=1.4.0 && <1.5, + SDL2-ttf >=0.1.0 && <0.2 diff --git a/deps/getDeps.sh b/deps/getDeps.sh index 4514f31..5c3ccad 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -63,6 +63,15 @@ else cd .. fi +if [ ! -d "hsSDL2-ttf" ] +then + git clone https://github.com/osa1/hsSDL2-ttf hsSDL2-ttf +else + cd hsSDL2-ttf + git pull + cd .. +fi + echo "trying to build" cabal install haddock @@ -79,7 +88,7 @@ do cabal configure cabal build cabal haddock --hyperlink-source - cabal install + cabal install --force-reinstalls cd .. fi done diff --git a/src/Main.hs b/src/Main.hs index a872a91..b0445db 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, DoAndIfThenElse #-} module Main where -- Monad-foo and higher functional stuff @@ -25,6 +25,8 @@ import Linear as L -- GUI import Graphics.UI.SDL as SDL +import Graphics.UI.SDL.TTF as TTF +import Graphics.UI.SDL.TTF.Types -- Render import qualified Graphics.Rendering.OpenGL.GL as GL @@ -39,66 +41,11 @@ import Render.Misc (checkError, curb) import Render.Render (initRendering, initShader) +import UI.Callbacks +import Types import qualified Debug.Trace as D (trace) -data ArrowKeyState = ArrowKeyState { - arrowUp :: !Bool - ,arrowDown :: !Bool - ,arrowLeft :: !Bool - ,arrowRight :: !Bool -} - ---Static Read-Only-State -data Env = Env - { envEventsChan :: TQueue Event - , envWindow :: !Window - , envZDistClosest :: !Double - , envZDistFarthest :: !Double - --, envGLContext :: !GLContext - } - ---Mutable State -data State = State - { stateWindowWidth :: !Int - , stateWindowHeight :: !Int - , stateWinClose :: !Bool - , stateClock :: !UTCTime - --- IO - , stateXAngle :: !Double - , stateYAngle :: !Double - , stateZDist :: !Double - , stateMouseDown :: !Bool - , stateDragging :: !Bool - , stateDragStartX :: !Double - , stateDragStartY :: !Double - , stateDragStartXAngle :: !Double - , stateDragStartYAngle :: !Double - , statePositionX :: !Double - , statePositionY :: !Double - , stateCursorPosX :: !Double - , stateCursorPosY :: !Double - , stateArrowsPressed :: !ArrowKeyState - , stateFrustum :: !(M44 CFloat) - --- pointer to bindings for locations inside the compiled shader - --- mutable because shaders may be changed in the future. - , shdrVertexIndex :: !GL.AttribLocation - , shdrColorIndex :: !GL.AttribLocation - , shdrNormalIndex :: !GL.AttribLocation - , shdrProjMatIndex :: !GL.UniformLocation - , shdrViewMatIndex :: !GL.UniformLocation - , shdrModelMatIndex :: !GL.UniformLocation - , shdrNormalMatIndex :: !GL.UniformLocation - , shdrTessInnerIndex :: !GL.UniformLocation - , shdrTessOuterIndex :: !GL.UniformLocation - , stateTessellationFactor :: !Int - --- the map - , stateMap :: !GL.BufferObject - , mapVert :: !GL.NumArrayIndices - } - -type Pioneers = RWST Env () State IO - -------------------------------------------------------------------------------- main :: IO () main = do @@ -108,9 +55,10 @@ main = do ,WindowResizable -- and resizable ,WindowInputFocus -- focused (=> active) ,WindowMouseFocus -- Mouse into it - --,WindowInputGrabbed-- never let go of input (KB/Mouse) + ,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window -> do withOpenGL window $ do + TTF.withInit $ do (Size fbWidth fbHeight) <- glGetDrawableSize window initRendering --generate map vertices @@ -121,6 +69,9 @@ main = do 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 let zDistClosest = 1 zDistFarthest = zDistClosest + 30 @@ -141,6 +92,7 @@ main = do , envWindow = window , envZDistClosest = zDistClosest , envZDistFarthest = zDistFarthest + , envFont = font } state = State { stateWindowWidth = fbWidth @@ -449,10 +401,16 @@ processEvent e = do modify $ \s -> s { stateMouseDown = pressed } - unless pressed $ - modify $ \s -> s { - stateDragging = False - } + unless pressed $ do + st <- get + if stateDragging st then + modify $ \s -> s { + stateDragging = False + } + else + clickHandler (UI.Callbacks.Pixel x y) + RightButton -> do + when (state == Released) $ alternateClickHandler (UI.Callbacks.Pixel x y) _ -> return () MouseWheel _ mouseId hscroll vscroll -> do From 95a7a5b9f1ba0ce6f650f179639f6bb9e0960275 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 5 Feb 2014 21:06:19 +0100 Subject: [PATCH 14/22] forgot files -.- --- src/Types.hs | 71 +++++++++++++++++++++++++++++++++++++++++++++ src/UI/Callbacks.hs | 20 +++++++++++++ 2 files changed, 91 insertions(+) create mode 100644 src/Types.hs create mode 100644 src/UI/Callbacks.hs diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..c896bba --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,71 @@ +module Types where + +import Control.Concurrent.STM (TQueue) +import qualified Graphics.Rendering.OpenGL.GL as GL +import Graphics.UI.SDL as SDL +import Foreign.C (CFloat) +import Data.Time (UTCTime) +import Linear.Matrix (M44) +import Control.Monad.RWS.Strict (RWST) +import Graphics.UI.SDL.TTF.Types as TTF + + + + +data ArrowKeyState = ArrowKeyState { + arrowUp :: !Bool + ,arrowDown :: !Bool + ,arrowLeft :: !Bool + ,arrowRight :: !Bool +} + +--Static Read-Only-State +data Env = Env + { envEventsChan :: TQueue Event + , envWindow :: !Window + , envZDistClosest :: !Double + , envZDistFarthest :: !Double + --, envGLContext :: !GLContext + , envFont :: TTF.TTFFont + } + +--Mutable State +data State = State + { stateWindowWidth :: !Int + , stateWindowHeight :: !Int + , stateWinClose :: !Bool + , stateClock :: !UTCTime + --- IO + , stateXAngle :: !Double + , stateYAngle :: !Double + , stateZDist :: !Double + , stateMouseDown :: !Bool + , stateDragging :: !Bool + , stateDragStartX :: !Double + , stateDragStartY :: !Double + , stateDragStartXAngle :: !Double + , stateDragStartYAngle :: !Double + , statePositionX :: !Double + , statePositionY :: !Double + , stateCursorPosX :: !Double + , stateCursorPosY :: !Double + , stateArrowsPressed :: !ArrowKeyState + , stateFrustum :: !(M44 CFloat) + --- pointer to bindings for locations inside the compiled shader + --- mutable because shaders may be changed in the future. + , shdrVertexIndex :: !GL.AttribLocation + , shdrColorIndex :: !GL.AttribLocation + , shdrNormalIndex :: !GL.AttribLocation + , shdrProjMatIndex :: !GL.UniformLocation + , shdrViewMatIndex :: !GL.UniformLocation + , shdrModelMatIndex :: !GL.UniformLocation + , shdrNormalMatIndex :: !GL.UniformLocation + , shdrTessInnerIndex :: !GL.UniformLocation + , shdrTessOuterIndex :: !GL.UniformLocation + , stateTessellationFactor :: !Int + --- the map + , stateMap :: !GL.BufferObject + , mapVert :: !GL.NumArrayIndices + } + +type Pioneers = RWST Env () State IO \ No newline at end of file diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs new file mode 100644 index 0000000..b4daff3 --- /dev/null +++ b/src/UI/Callbacks.hs @@ -0,0 +1,20 @@ +module UI.Callbacks where + +import Control.Monad.Trans (liftIO) +import Types + +data Pixel = Pixel Int Int + +-- | Handler for UI-Inputs. +-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ... +clickHandler :: Pixel -> Pioneers () +clickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"] + +-- | Handler for UI-Inputs. +-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ... +alternateClickHandler :: Pixel -> Pioneers () +alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"] + + +--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc. +--TODO: Maybe queues are better? From 47e49660cf525b4a28d4b2233e0ab9b43b03fe6a Mon Sep 17 00:00:00 2001 From: tpajenka Date: Fri, 7 Feb 2014 17:08:17 +0100 Subject: [PATCH 15/22] changed window position --- src/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Main.hs b/src/Main.hs index dcde748..c6bdfef 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -107,7 +107,7 @@ type Pioneers = RWST Env () State IO main :: IO () main = do SDL.withInit [InitVideo, InitAudio] $ do --also: InitNoParachute -> faster, without parachute! - SDL.withWindow "Pioneers" (Position 1500 100) (Size 1024 768) [WindowOpengl -- we want openGL + SDL.withWindow "Pioneers" (Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL ,WindowShown -- window should be visible ,WindowResizable -- and resizable ,WindowInputFocus -- focused (=> active) From 5da90f83c6a9b491ffa9c10764b80eb2e3c8027a Mon Sep 17 00:00:00 2001 From: tpajenka Date: Fri, 7 Feb 2014 17:15:17 +0100 Subject: [PATCH 16/22] corrected tessEval.shader --- shaders/tessEval.shader | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shaders/tessEval.shader b/shaders/tessEval.shader index d0c6648..7ed631a 100644 --- a/shaders/tessEval.shader +++ b/shaders/tessEval.shader @@ -4,8 +4,8 @@ layout(triangles, equal_spacing, cw) in; in vec3 tcPosition[]; in vec4 tcColor[]; in vec3 tcNormal[]; -out vec3 tePosition; out vec4 teColor; +smooth out vec3 tePosition; smooth out vec3 teNormal; smooth out float gmix; //mixture of gravel //out vec3 tePatchDistance; From cc6dfb28a709deac645878134871a5e5632ffbba Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 10 Feb 2014 16:26:03 +0100 Subject: [PATCH 17/22] minor clean --- src/Map/Map.hs | 49 ++----------------------------------------------- 1 file changed, 2 insertions(+), 47 deletions(-) diff --git a/src/Map/Map.hs b/src/Map/Map.hs index 49d73fc..586a019 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -89,52 +89,7 @@ prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfl prettyMap (a:b:c:d:x:y:z:u:v:w:ms) = (a,b,c,d,x,y,z,u,v,w):(prettyMap ms) prettyMap _ = [] -generateCube :: [GLfloat] -generateCube = [ -- lower plane - -3.0,-3.0,-3.0, - 3.0,-3.0,3.0, - 3.0,-3.0,-3.0, - -3.0,-3.0,-3.0, - -3.0,-3.0,3.0, - 3.0,-3.0,3.0, - -- upper plane - -3.0,3.0,-3.0, - 3.0,3.0,3.0, - 3.0,3.0,-3.0, - -3.0,3.0,-3.0, - -3.0,3.0,3.0, - 3.0,3.0,3.0, - -- left plane - -3.0,-3.0,-3.0, - -3.0,3.0,3.0, - -3.0,-3.0,3.0, - -3.0,-3.0,-3.0, - -3.0,3.0,3.0, - -3.0,3.0,-3.0, - -- right plane - 3.0,-3.0,-3.0, - 3.0,3.0,3.0, - 3.0,-3.0,3.0, - 3.0,-3.0,-3.0, - 3.0,3.0,3.0, - 3.0,3.0,-3.0, - -- front plane - -3.0,-3.0,-3.0, - 3.0,3.0,-3.0, - 3.0,-3.0,-3.0, - -3.0,-3.0,-3.0, - 3.0,3.0,-3.0, - -3.0,3.0,-3.0, - -- back plane - -3.0,-3.0,3.0, - 3.0,3.0,3.0, - 3.0,-3.0,3.0, - -3.0,-3.0,3.0, - 3.0,3.0,3.0, - -3.0,3.0,3.0 - ] - -generateTriangles :: PlayMap -> [GLfloat] +generateTriangles :: PlayMap -> [GLfloat] generateTriangles map' = let ((xl,yl),(xh,yh)) = bounds map' in P.concat [P.concat $ P.map (generateFirstTriLine map' y) [xl .. xh - 2] @@ -234,7 +189,7 @@ colorLookup hs t = if inRange (bounds hs) t then c else (0.0, 0.0, 0.0) Mountain -> (0.5, 0.5, 0.5) coordLookup :: (Int,Int) -> GLfloat -> V3 GLfloat -coordLookup (x,z) y = +coordLookup (x,z) y = if even x then V3 (fromIntegral $ x `div` 2) y (fromIntegral (2 * z) * lineHeight) else From e846e13ea7ee4ea4485268b67d19857c946946da Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 10 Feb 2014 16:33:52 +0100 Subject: [PATCH 18/22] corrected dependencies --- deps/getDeps.sh | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/deps/getDeps.sh b/deps/getDeps.sh index 5c3ccad..4f6df0c 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -42,13 +42,13 @@ then fi if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ] then - wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb - sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb + sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb fi if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ] then - wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb - sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb + wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb + sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb fi fi ## hack end From 99f7e1593a2f5a939f488b549f9783cc1a32410b Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Mon, 10 Feb 2014 16:41:17 +0100 Subject: [PATCH 19/22] corrected deps - may break now forever --- deps/getDeps.sh | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/deps/getDeps.sh b/deps/getDeps.sh index 4f6df0c..3097a54 100755 --- a/deps/getDeps.sh +++ b/deps/getDeps.sh @@ -40,16 +40,22 @@ then wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb sudo gdebi --n libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb fi - if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ] - then - wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb - sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb - fi - if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ] - then - wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb - sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb - fi +# this update would need tons of further package-updates... like killing libsdl1.2:i386 +# if [ ! -f "libtiff5_4.0.3-7_amd64.deb" ] +# then +# wget http://de.archive.ubuntu.com/ubuntu/pool/main/t/tiff/libtiff5_4.0.3-7_amd64.deb +# sudo gdebi --n libtiff5_4.0.3-7_amd64.deb +# fi +# if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ] +# then +# wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb +# sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb +# fi +# if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ] +# then +# wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb +# sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb +# fi fi ## hack end From d5310478c08e297bfd8cd645d8d95ae8892f8a6c Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sun, 23 Feb 2014 13:32:20 +0100 Subject: [PATCH 20/22] converted Types to Labels - Types is converted to Lebles (monomorphic lenses) - Main initializes type now - All other stuff in Main still calls old syntax. refs #467 @3h --- Pioneers.cabal | 2 +- src/Main.hs | 118 +++++++++++++++++++++++----------------- src/Types.hs | 142 +++++++++++++++++++++++++++++++------------------ 3 files changed, 161 insertions(+), 101 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index f49b250..68b447c 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -32,5 +32,5 @@ executable Pioneers lens >=3.10.1 && <3.11, SDL2 >= 0.1.0, time >=1.4.0 && <1.5, - SDL2-ttf >=0.1.0 && <0.2 + fclabels >=2.0.0 && <3 diff --git a/src/Main.hs b/src/Main.hs index 3a26626..2bc245f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -24,9 +24,9 @@ import Control.Lens ((^.)) import Linear as L -- GUI -import Graphics.UI.SDL as SDL -import Graphics.UI.SDL.TTF as TTF -import Graphics.UI.SDL.TTF.Types +import Graphics.UI.SDL as SDL hiding (Position) +--import Graphics.UI.SDL.TTF as TTF +--import Graphics.UI.SDL.TTF.Types -- Render import qualified Graphics.Rendering.OpenGL.GL as GL @@ -58,7 +58,7 @@ main = do ,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window -> do withOpenGL window $ do - TTF.withInit $ do + --TTF.withInit $ do (Size fbWidth fbHeight) <- glGetDrawableSize window initRendering --generate map vertices @@ -69,9 +69,9 @@ main = do 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 + --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 + --TTF.setFontStyle font TTFNormal + --TTF.setFontHinting font TTFHNormal let zDistClosest = 1 zDistFarthest = zDistClosest + 30 @@ -82,50 +82,72 @@ main = do ratio = fromIntegral fbWidth / fromIntegral fbHeight frust = createFrustum fov near far ratio aks = ArrowKeyState { - arrowUp = False - ,arrowDown = False - ,arrowLeft = False - ,arrowRight = False + _up = False + , _down = False + , _left = False + , _right = False } + glMap = GLMapState + { _shdrVertexIndex = vi + , _shdrNormalIndex = ni + , _shdrColorIndex = ci + , _shdrProjMatIndex = pri + , _shdrViewMatIndex = vii + , _shdrModelMatIndex = mi + , _shdrNormalMatIndex = nmi + , _shdrTessInnerIndex = tli + , _shdrTessOuterIndex = tlo + , _stateTessellationFactor = 4 + , _stateMap = mapBuffer + , _mapVert = vert + } env = Env - { envEventsChan = eventQueue - , envWindow = window - , envZDistClosest = zDistClosest - , envZDistFarthest = zDistFarthest - , envFont = font + { _eventsChan = eventQueue + , _windowObject = window + , _zDistClosest = zDistClosest + , _zDistFarthest = zDistFarthest + --, envFont = font } state = State - { stateWindowWidth = fbWidth - , stateWindowHeight = fbHeight - , stateXAngle = pi/6 - , stateYAngle = pi/2 - , stateZDist = 10 - , statePositionX = 5 - , statePositionY = 5 - , stateCursorPosX = 0 - , stateCursorPosY = 0 - , stateMouseDown = False - , stateDragging = False - , stateDragStartX = 0 - , stateDragStartY = 0 - , stateDragStartXAngle = 0 - , stateDragStartYAngle = 0 - , shdrVertexIndex = vi - , shdrNormalIndex = ni - , shdrColorIndex = ci - , shdrProjMatIndex = pri - , shdrViewMatIndex = vii - , shdrModelMatIndex = mi - , shdrNormalMatIndex = nmi - , shdrTessInnerIndex = tli - , shdrTessOuterIndex = tlo - , stateMap = mapBuffer - , mapVert = vert - , stateFrustum = frust - , stateWinClose = False - , stateClock = now - , stateArrowsPressed = aks - , stateTessellationFactor = 4 + { _window = WindowState + { _width = fbWidth + , _height = fbHeight + , _shouldClose = False + } + , _camera = CameraState + { _xAngle = pi/6 + , _yAngle = pi/2 + , _zDist = 10 + , _frustum = frust + , _camPosition = Position + { Types._x = 5 + , Types._y = 5 + } + } + , _io = IOState + { _clock = now + } + , _mouse = MouseState + { _isDown = False + , _isDragging = False + , _dragStartX = 0 + , _dragStartY = 0 + , _dragStartXAngle = 0 + , _dragStartYAngle = 0 + , _mousePosition = Position + { Types._x = 5 + , Types._y = 5 + } + } + , _keyboard = KeyboardState + { _arrowsPressed = aks + } + , _gl = GLState + { _glMap = glMap + } + , _game = GameState + { + } } putStrLn "init done." @@ -138,7 +160,7 @@ main = do draw :: Pioneers () draw = do state <- get - let xa = stateXAngle state + let xa = get (camera . xAngle) state --stateXAngle state ya = stateYAngle state (GL.UniformLocation proj) = shdrProjMatIndex state (GL.UniformLocation nmat) = shdrNormalMatIndex state diff --git a/src/Types.hs b/src/Types.hs index c896bba..ce9c885 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,71 +1,109 @@ +{-# LANGUAGE TemplateHaskell #-} module Types where import Control.Concurrent.STM (TQueue) import qualified Graphics.Rendering.OpenGL.GL as GL -import Graphics.UI.SDL as SDL +import Graphics.UI.SDL as SDL (Event, Window) import Foreign.C (CFloat) import Data.Time (UTCTime) import Linear.Matrix (M44) import Control.Monad.RWS.Strict (RWST) -import Graphics.UI.SDL.TTF.Types as TTF +--import Graphics.UI.SDL.TTF.Types as TTF +import Control.Lens +import Data.Label - - -data ArrowKeyState = ArrowKeyState { - arrowUp :: !Bool - ,arrowDown :: !Bool - ,arrowLeft :: !Bool - ,arrowRight :: !Bool -} - --Static Read-Only-State data Env = Env - { envEventsChan :: TQueue Event - , envWindow :: !Window - , envZDistClosest :: !Double - , envZDistFarthest :: !Double + { _eventsChan :: TQueue Event + , _windowObject :: !Window + , _zDistClosest :: !Double + , _zDistFarthest :: !Double --, envGLContext :: !GLContext - , envFont :: TTF.TTFFont + --, envFont :: TTF.TTFFont } --Mutable State -data State = State - { stateWindowWidth :: !Int - , stateWindowHeight :: !Int - , stateWinClose :: !Bool - , stateClock :: !UTCTime - --- IO - , stateXAngle :: !Double - , stateYAngle :: !Double - , stateZDist :: !Double - , stateMouseDown :: !Bool - , stateDragging :: !Bool - , stateDragStartX :: !Double - , stateDragStartY :: !Double - , stateDragStartXAngle :: !Double - , stateDragStartYAngle :: !Double - , statePositionX :: !Double - , statePositionY :: !Double - , stateCursorPosX :: !Double - , stateCursorPosY :: !Double - , stateArrowsPressed :: !ArrowKeyState - , stateFrustum :: !(M44 CFloat) - --- pointer to bindings for locations inside the compiled shader - --- mutable because shaders may be changed in the future. - , shdrVertexIndex :: !GL.AttribLocation - , shdrColorIndex :: !GL.AttribLocation - , shdrNormalIndex :: !GL.AttribLocation - , shdrProjMatIndex :: !GL.UniformLocation - , shdrViewMatIndex :: !GL.UniformLocation - , shdrModelMatIndex :: !GL.UniformLocation - , shdrNormalMatIndex :: !GL.UniformLocation - , shdrTessInnerIndex :: !GL.UniformLocation - , shdrTessOuterIndex :: !GL.UniformLocation - , stateTessellationFactor :: !Int - --- the map - , stateMap :: !GL.BufferObject - , mapVert :: !GL.NumArrayIndices + +data Position = Position + { _x :: !Double + , _y :: !Double } +data WindowState = WindowState + { _width :: !Int + , _height :: !Int + , _shouldClose :: !Bool + } + +data CameraState = CameraState + { _xAngle :: !Double + , _yAngle :: !Double + , _zDist :: !Double + , _frustum :: !(M44 CFloat) + , _camPosition :: !Position --TODO: Get rid of cam-prefix + } + +data IOState = IOState + { _clock :: !UTCTime + } + +data GameState = GameState + { + } + +data MouseState = MouseState + { _isDown :: !Bool + , _isDragging :: !Bool + , _dragStartX :: !Double + , _dragStartY :: !Double + , _dragStartXAngle :: !Double + , _dragStartYAngle :: !Double + , _mousePosition :: !Position --TODO: Get rid of mouse-prefix + } + +data ArrowKeyState = ArrowKeyState { + _up :: !Bool + ,_down :: !Bool + ,_left :: !Bool + ,_right :: !Bool +} + +data KeyboardState = KeyboardState + { _arrowsPressed :: !ArrowKeyState + } + +data GLMapState = GLMapState + { _shdrVertexIndex :: !GL.AttribLocation + , _shdrColorIndex :: !GL.AttribLocation + , _shdrNormalIndex :: !GL.AttribLocation + , _shdrProjMatIndex :: !GL.UniformLocation + , _shdrViewMatIndex :: !GL.UniformLocation + , _shdrModelMatIndex :: !GL.UniformLocation + , _shdrNormalMatIndex :: !GL.UniformLocation + , _shdrTessInnerIndex :: !GL.UniformLocation + , _shdrTessOuterIndex :: !GL.UniformLocation + , _stateTessellationFactor :: !Int + , _stateMap :: !GL.BufferObject + , _mapVert :: !GL.NumArrayIndices + } + +data GLState = GLState + { _glMap :: !GLMapState + } + +data State = State + { _window :: !WindowState + , _camera :: !CameraState + , _io :: !IOState + , _mouse :: !MouseState + , _keyboard :: !KeyboardState + , _gl :: !GLState + , _game :: !GameState + } + +$(mkLabels [''State, ''GLState, ''GLMapState, ''KeyboardState, ''ArrowKeyState, + ''MouseState, ''GameState, ''IOState, ''CameraState, ''WindowState, + ''Position, ''Env]) + type Pioneers = RWST Env () State IO \ No newline at end of file From 517f2eb0b6190d30e4a29f666a6daea00613c39a Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 28 Feb 2014 14:44:58 +0100 Subject: [PATCH 21/22] removed SDL-ttf as it breaks for now --- Pioneers.cabal | 3 +-- src/Main.hs | 7 ------- src/Types.hs | 3 +-- 3 files changed, 2 insertions(+), 11 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index f49b250..2a39666 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -31,6 +31,5 @@ executable Pioneers linear >=1.3.1 && <1.4, lens >=3.10.1 && <3.11, SDL2 >= 0.1.0, - time >=1.4.0 && <1.5, - SDL2-ttf >=0.1.0 && <0.2 + time >=1.4.0 && <1.5 diff --git a/src/Main.hs b/src/Main.hs index 3a26626..142b6cf 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -25,8 +25,6 @@ import Linear as L -- GUI import Graphics.UI.SDL as SDL -import Graphics.UI.SDL.TTF as TTF -import Graphics.UI.SDL.TTF.Types -- Render import qualified Graphics.Rendering.OpenGL.GL as GL @@ -58,7 +56,6 @@ main = do ,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window -> do withOpenGL window $ do - TTF.withInit $ do (Size fbWidth fbHeight) <- glGetDrawableSize window initRendering --generate map vertices @@ -69,9 +66,6 @@ main = do 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 let zDistClosest = 1 zDistFarthest = zDistClosest + 30 @@ -92,7 +86,6 @@ main = do , envWindow = window , envZDistClosest = zDistClosest , envZDistFarthest = zDistFarthest - , envFont = font } state = State { stateWindowWidth = fbWidth diff --git a/src/Types.hs b/src/Types.hs index c896bba..f60cdda 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -7,7 +7,6 @@ import Foreign.C (CFloat) import Data.Time (UTCTime) import Linear.Matrix (M44) import Control.Monad.RWS.Strict (RWST) -import Graphics.UI.SDL.TTF.Types as TTF @@ -26,7 +25,7 @@ data Env = Env , envZDistClosest :: !Double , envZDistFarthest :: !Double --, envGLContext :: !GLContext - , envFont :: TTF.TTFFont + --, envFont :: TTF.TTFFont } --Mutable State From 5a70a22da69410ee32f69d24046e38ca287efa77 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 5 Mar 2014 14:42:26 +0100 Subject: [PATCH 22/22] converted to lenses --- src/Main.hs | 225 +++++++++++++++++++++------------------------------ src/Types.hs | 16 +++- 2 files changed, 106 insertions(+), 135 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 2bc245f..1233375 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -20,11 +20,12 @@ import Foreign (Ptr, castPtr, with) import Foreign.C (CFloat) -- Math -import Control.Lens ((^.)) +import Control.Lens ((^.), (.~), (%~)) import Linear as L -- GUI -import Graphics.UI.SDL as SDL hiding (Position) +import qualified Graphics.UI.SDL as SDL (Position) +import Graphics.UI.SDL as SDL --import Graphics.UI.SDL.TTF as TTF --import Graphics.UI.SDL.TTF.Types @@ -50,7 +51,7 @@ import qualified Debug.Trace as D (trace) main :: IO () main = do SDL.withInit [InitVideo, InitAudio] $ do --also: InitNoParachute -> faster, without parachute! - SDL.withWindow "Pioneers" (Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL + 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) @@ -119,7 +120,7 @@ main = do , _yAngle = pi/2 , _zDist = 10 , _frustum = frust - , _camPosition = Position + , _camPosition = Types.Position { Types._x = 5 , Types._y = 5 } @@ -134,7 +135,7 @@ main = do , _dragStartY = 0 , _dragStartXAngle = 0 , _dragStartYAngle = 0 - , _mousePosition = Position + , _mousePosition = Types.Position { Types._x = 5 , Types._y = 5 } @@ -160,23 +161,23 @@ main = do draw :: Pioneers () draw = do state <- get - let xa = get (camera . xAngle) state --stateXAngle state - ya = stateYAngle state - (GL.UniformLocation proj) = shdrProjMatIndex state - (GL.UniformLocation nmat) = shdrNormalMatIndex state - (GL.UniformLocation vmat) = shdrViewMatIndex state - (GL.UniformLocation tli) = shdrTessInnerIndex state - (GL.UniformLocation tlo) = shdrTessOuterIndex state - vi = shdrVertexIndex state - ni = shdrNormalIndex state - ci = shdrColorIndex state - numVert = mapVert state - map' = stateMap state - frust = stateFrustum state - camX = statePositionX state - camY = statePositionY state - zDist = stateZDist state - tessFac = stateTessellationFactor state + let xa = state ^. camera.xAngle + ya = state ^. camera.yAngle + (GL.UniformLocation proj) = state ^. gl.glMap.shdrProjMatIndex + (GL.UniformLocation nmat) = state ^. gl.glMap.shdrNormalMatIndex + (GL.UniformLocation vmat) = state ^. gl.glMap.shdrViewMatIndex + (GL.UniformLocation tli) = state ^. gl.glMap.shdrTessInnerIndex + (GL.UniformLocation tlo) = state ^. gl.glMap.shdrTessOuterIndex + vi = state ^. gl.glMap.shdrVertexIndex + ni = state ^. gl.glMap.shdrNormalIndex + ci = state ^. gl.glMap.shdrColorIndex + numVert = state ^. gl.glMap.mapVert + map' = state ^. gl.glMap.stateMap + frust = state ^. camera.frustum + camX = state ^. camera.camPosition.x + camY = state ^. camera.camPosition.y + zDist' = state ^. camera.zDist + tessFac = state ^. gl.glMap.stateTessellationFactor liftIO $ do --(vi,GL.UniformLocation proj) <- initShader GL.clear [GL.ColorBuffer, GL.DepthBuffer] @@ -187,7 +188,7 @@ draw = do checkError "foo" --set up camera - let ! cam = getCam (camX,camY) zDist xa ya + let ! cam = getCam (camX,camY) zDist' xa ya with (distribute cam) $ \ptr -> glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat))) checkError "foo" @@ -226,11 +227,11 @@ draw = do run :: Pioneers () run = do - win <- asks envWindow + env <- ask -- draw Scene draw - liftIO $ glSwapWindow win + liftIO $ glSwapWindow (env ^. windowObject) -- getEvents & process processEvents @@ -238,15 +239,15 @@ run = do state <- get -- change in camera-angle - when (stateDragging state) $ do - let sodx = stateDragStartX state - sody = stateDragStartY state - sodxa = stateDragStartXAngle state - sodya = stateDragStartYAngle state - x = stateCursorPosX state - y = stateCursorPosY state - let myrot = (x - sodx) / 2 - mxrot = (y - sody) / 2 + when (state ^. mouse.isDragging) $ do + let sodx = state ^. mouse.dragStartX + sody = state ^. mouse.dragStartY + sodxa = state ^. mouse.dragStartXAngle + sodya = state ^. mouse.dragStartYAngle + x' = state ^. mouse.mousePosition.x + y' = state ^. mouse.mousePosition.y + myrot = (x' - sodx) / 2 + mxrot = (y' - sody) / 2 newXAngle = curb (pi/12) (0.45*pi) newXAngle' newXAngle' = sodxa + mxrot/100 newYAngle @@ -254,26 +255,23 @@ run = do | newYAngle' < (-pi) = newYAngle' + 2 * pi | otherwise = newYAngle' newYAngle' = sodya + myrot/100 - put $ state - { stateXAngle = newXAngle - , stateYAngle = newYAngle - } + + modify $ ((camera.xAngle) .~ newXAngle) + . ((camera.yAngle) .~ newYAngle) -- get cursor-keys - if pressed --TODO: Add sin/cos from stateYAngle (kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement - modify $ \s -> - let - multc = cos $ stateYAngle s - mults = sin $ stateYAngle s - in - s { - statePositionX = statePositionX s - 0.2 * kxrot * multc - - 0.2 * kyrot * mults - , statePositionY = statePositionY s + 0.2 * kxrot * mults - - 0.2 * kyrot * multc - } - + let + multc = cos $ state ^. camera.yAngle + mults = sin $ state ^. camera.yAngle + modx x' = x' - 0.2 * kxrot * multc + - 0.2 * kyrot * mults + mody y' = y' - 0.2 * kxrot * mults + - 0.2 * kyrot * multc + modify $ (camera.camPosition.x %~ modx) + . (camera.camPosition.y %~ mody) + {- --modify the state with all that happened in mt time. mt <- liftIO GLFW.getTime @@ -281,49 +279,45 @@ run = do { } -} + mt <- liftIO $ do now <- getCurrentTime - diff <- return $ diffUTCTime now (stateClock state) -- get time-diffs + diff <- return $ diffUTCTime now (state ^. io.clock) -- get time-diffs title <- return $ unwords ["Pioneers @ ",show ((round .fromRational.toRational $ 1.0/diff)::Int),"fps"] - setWindowTitle win title + setWindowTitle (env ^. windowObject) title sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds threadDelay sleepAmount return now -- set state with new clock-time - modify $ \s -> s - { - stateClock = mt - } - shouldClose <- return $ stateWinClose state + modify $ io.clock .~ mt + shouldClose <- return $ state ^. window.shouldClose unless shouldClose run getArrowMovement :: Pioneers (Int, Int) getArrowMovement = do state <- get - aks <- return $ stateArrowsPressed state + aks <- return $ state ^. (keyboard.arrowsPressed) let horz = left' + right' vert = up'+down' - left' = if arrowLeft aks then -1 else 0 - right' = if arrowRight aks then 1 else 0 - up' = if arrowUp aks then -1 else 0 - down' = if arrowDown aks then 1 else 0 + left' = if aks ^. left then -1 else 0 + right' = if aks ^. right then 1 else 0 + up' = if aks ^. up then -1 else 0 + down' = if aks ^. down then 1 else 0 return (horz,vert) adjustWindow :: Pioneers () adjustWindow = do state <- get - let fbWidth = stateWindowWidth state - fbHeight = stateWindowHeight state + let fbWidth = state ^. window.width + fbHeight = state ^. window.height fov = 90 --field of view near = 1 --near plane far = 100 --far plane ratio = fromIntegral fbWidth / fromIntegral fbHeight frust = createFrustum fov near far ratio liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight) - put $ state { - stateFrustum = frust - } + modify $ camera.frustum .~ frust processEvents :: Pioneers () @@ -337,18 +331,15 @@ processEvents = do processEvent :: Event -> Pioneers () processEvent e = do + return () case eventData e of Window _ winEvent -> case winEvent of Closing -> - modify $ \s -> s { - stateWinClose = True - } + modify $ window.shouldClose .~ True Resized {windowResizedTo=size} -> do - modify $ \s -> s { - stateWindowWidth = sizeWidth size - ,stateWindowHeight = sizeHeight size - } + modify $ (window.width .~ (sizeWidth size)) + . (window.height .~ (sizeHeight size)) adjustWindow SizeChanged -> adjustWindow @@ -357,78 +348,50 @@ processEvent e = do --liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e] Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey -- need modifiers? use "keyModifiers key" to get them + let aks = keyboard.arrowsPressed in case keyScancode key of Escape -> - modify $ \s -> s { - stateWinClose = True - } + modify $ window.shouldClose .~ True SDL.Left -> - modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowLeft = movement == KeyDown - } - } + modify $ aks.left .~ (movement == KeyDown) SDL.Right -> - modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowRight = movement == KeyDown - } - } + modify $ aks.right .~ (movement == KeyDown) SDL.Up -> - modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowUp = movement == KeyDown - } - } + modify $ aks.up .~ (movement == KeyDown) SDL.Down -> - modify $ \s -> s { - stateArrowsPressed = (stateArrowsPressed s) { - arrowDown = movement == KeyDown - } - } + modify $ aks.down .~ (movement == KeyDown) SDL.KeypadPlus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = min (stateTessellationFactor s + 1) 5 - } + modify $ (gl.glMap.stateTessellationFactor) %~ ((min 5) . (+1)) state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor] SDL.KeypadMinus -> when (movement == KeyDown) $ do - modify $ \s -> s { - stateTessellationFactor = max (stateTessellationFactor s - 1) 1 - } + modify $ (gl.glMap.stateTessellationFactor) %~ ((max 1) . (+(-1))) state <- get - liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ stateTessellationFactor state] + liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor] _ -> return () - MouseMotion _ mouseId st (Position x y) xrel yrel -> do + MouseMotion _ mouseId st (SDL.Position x y) xrel yrel -> do state <- get - when (stateMouseDown state && not (stateDragging state)) $ - put $ state - { stateDragging = True - , stateDragStartX = fromIntegral x - , stateDragStartY = fromIntegral y - , stateDragStartXAngle = stateXAngle state - , stateDragStartYAngle = stateYAngle state - } - modify $ \s -> s { - stateCursorPosX = fromIntegral x - , stateCursorPosY = fromIntegral y - } - MouseButton _ mouseId button state (Position x y) -> + when (state ^. mouse.isDown && not (state ^. mouse.isDragging)) $ + modify $ (mouse.isDragging .~ True) + . (mouse.dragStartX .~ (fromIntegral x)) + . (mouse.dragStartY .~ (fromIntegral y)) + . (mouse.dragStartXAngle .~ (state ^. camera.xAngle)) + . (mouse.dragStartYAngle .~ (state ^. camera.yAngle)) + + modify $ (mouse.mousePosition. Types.x .~ (fromIntegral x)) + . (mouse.mousePosition. Types.y .~ (fromIntegral y)) + MouseButton _ mouseId button state (SDL.Position x y) -> case button of LeftButton -> do let pressed = state == Pressed - modify $ \s -> s { - stateMouseDown = pressed - } + modify $ mouse.isDown .~ pressed unless pressed $ do st <- get - if stateDragging st then - modify $ \s -> s { - stateDragging = False - } + if st ^. mouse.isDragging then + modify $ mouse.isDragging .~ False else clickHandler (UI.Callbacks.Pixel x y) RightButton -> do @@ -437,11 +400,9 @@ processEvent e = do return () MouseWheel _ mouseId hscroll vscroll -> do env <- ask - modify $ \s -> s - { stateZDist = - let zDist' = stateZDist s + realToFrac (negate vscroll) - in curb (envZDistClosest env) (envZDistFarthest env) zDist' - } - Quit -> modify $ \s -> s {stateWinClose = True} + state <- get + let zDist' = (state ^. camera.zDist) + realToFrac (negate vscroll) in + modify $ camera.zDist .~ (curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist') + Quit -> modify $ window.shouldClose .~ True -- there is more (joystic, touchInterface, ...), but currently ignored _ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e] diff --git a/src/Types.hs b/src/Types.hs index 8e9031d..ab7788a 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -101,8 +101,18 @@ data State = State , _game :: !GameState } -$(mkLabels [''State, ''GLState, ''GLMapState, ''KeyboardState, ''ArrowKeyState, - ''MouseState, ''GameState, ''IOState, ''CameraState, ''WindowState, - ''Position, ''Env]) +$(makeLenses ''State) +$(makeLenses ''GLState) +$(makeLenses ''GLMapState) +$(makeLenses ''KeyboardState) +$(makeLenses ''ArrowKeyState) +$(makeLenses ''MouseState) +$(makeLenses ''GameState) +$(makeLenses ''IOState) +$(makeLenses ''CameraState) +$(makeLenses ''WindowState) +$(makeLenses ''Position) +$(makeLenses ''Env) + type Pioneers = RWST Env () State IO \ No newline at end of file