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/Pioneers.cabal b/Pioneers.cabal index 4aad55e..fadfec1 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -12,6 +12,7 @@ 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.Types, Map.Graphics, Map.Creation, @@ -49,3 +50,33 @@ executable Pioneers attoparsec-binary >= 0.1 Default-Language: Haskell2010 +test-suite MapTests + type: exitcode-stdio-1.0 + hs-source-dirs: tests/Map, src + main-is: MapTestSuite.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-th, + test-framework-quickcheck2 + Default-Language: Haskell2010 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}" 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/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/shaders/map/tessEval.shader b/shaders/map/tessEval.shader index 51cc5b3..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)); @@ -133,7 +135,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;//+clamp(tePosition,0,0.05)*snoise(tePosition/2); + tePosition = vec3(tePosition.x, tmp.y, tePosition.z); gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1); fogDist = gl_Position.z; 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/Main.hs b/src/Main.hs index 92d1005..50dced5 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 @@ -66,15 +66,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 @@ -83,15 +83,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) - putStrLn "foo" + eventQueue <- newTQueueIO :: IO (TQueue SDL.Event) now <- getCurrentTime - putStrLn "foo" --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 --TTF.setFontStyle font TTFNormal --TTF.setFontHinting font TTFHNormal @@ -133,6 +130,7 @@ main = } , _io = IOState { _clock = now + , _tessClockFactor = 0 } , _mouse = MouseState { _isDown = False @@ -182,7 +180,7 @@ run = do -- draw Scene draw - liftIO $ glSwapWindow (env ^. windowObject) + liftIO $ SDL.glSwapWindow (env ^. windowObject) -- getEvents & process processEvents @@ -230,17 +228,33 @@ run = do } -} - mt <- liftIO $ do - let double = fromRational.toRational :: (Real a) => a -> Double + (mt,tc,sleepAmount,frameTime) <- liftIO $ do + let double = fromRational.toRational :: (Real a) => a -> Double + targetFramerate = 60.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 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 < (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 + now' <- getCurrentTime + return (now',tessChange,sleepAmount,ddiff) -- set state with new clock-time - modify $ io.clock .~ mt + --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))) + -- liftIO $ putStrLn $ concat $ ["TessFactor at: ",show (state ^. gl.glMap.stateTessellationFactor), " - slept for ",show sleepAmount, "μs."] shouldClose' <- return $ state ^. window.shouldClose unless shouldClose' run @@ -315,14 +329,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 @@ -331,7 +345,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 diff --git a/src/Map/Combinators.hs b/src/Map/Combinators.hs deleted file mode 100644 index 9dabb89..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 = head $ randomRs (bounds mp) 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 d677cdd..554cb6c 100644 --- a/src/Map/Creation.hs +++ b/src/Map/Creation.hs @@ -2,19 +2,25 @@ module Map.Creation where import Map.Types -import Map.Map +import Map.StaticMaps +-- 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) +-- preliminary +infix 5 ->- +(->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap +f ->- g = g . f - random gen1 = let (a, gen2) = random gen1 - (b, gen3) = random gen2 in ((a,b), gen3) +-- 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 -- @@ -31,7 +37,10 @@ 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 + +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 => @@ -68,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/Map.hs b/src/Map/Map.hs index e358cee..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 :: Ord a => [a] -> Bool -prop_rd_idempot xs = remdups xs == (remdups . remdups) xs 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) diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 6b3e4d3..c6e4369 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -22,6 +22,8 @@ import Types 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" @@ -32,6 +34,11 @@ mapTessEvalShaderFile = "shaders/map/tessEval.shader" mapFragmentShaderFile :: String mapFragmentShaderFile = "shaders/map/fragment.shader" +objectVertexShaderFile :: String +objectVertexShaderFile = "shaders/mapobjects/vertex.shader" +objectFragmentShaderFile :: String +objectFragmentShaderFile = "shaders/mapobjects/fragment.shader" + uiVertexShaderFile :: String uiVertexShaderFile = "shaders/ui/vertex.shader" uiFragmentShaderFile :: String @@ -113,6 +120,21 @@ initMapShader tessFac (buf, vertDes) = do texts <- genObjectNames 6 + testobj <- parseIQM "sample.iqm" + + let + objs = [MapObject testobj (L.V3 0 10 0) (MapObjectState ())] + + ! 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 +154,8 @@ initMapShader tessFac (buf, vertDes) = do , _mapVert = vertDes , _overviewTexture = overTex , _mapTextures = texts + , _mapObjects = objs + , _objectProgram = objProgram } initHud :: IO GLHud @@ -266,6 +290,16 @@ renderOverview = do -} +-- | 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 pos@(L.V3 x y z) _{-state-}) = + renderIQM model pos (L.V3 1 1 1) + + render :: Pioneers () render = do state <- RWS.get @@ -354,8 +388,15 @@ render = do cullFace $= Just Front glDrawArrays gl_PATCHES 0 (fromIntegral numVert) + checkError "draw map" + ---- RENDER MAPOBJECTS -------------------------------------------- + + currentProgram $= Just (state ^. gl.glMap.objectProgram) + + 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 7d4e3a2..1574357 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -8,12 +8,15 @@ 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 Importer.IQM.Types import UI.UIBase +data Coord3D a = Coord3D a a a --Static Read-Only-State data Env = Env @@ -49,6 +52,7 @@ data CameraState = CameraState data IOState = IOState { _clock :: !UTCTime + , _tessClockFactor :: !Double } data GameState = GameState @@ -113,8 +117,16 @@ data GLMapState = GLMapState , _renderedMapTexture :: !TextureObject --TODO: Probably move to UI? , _overviewTexture :: !TextureObject , _mapTextures :: ![TextureObject] --TODO: Fix size on list? + , _objectProgram :: !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 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