Merge branch 'master' into ui

This commit is contained in:
tpajenka 2014-05-15 21:47:15 +02:00
commit c17852d8e1
19 changed files with 657 additions and 132 deletions

View File

@ -1,6 +1,13 @@
# on ubuntu14.04 (trusty) and later
just run
> ./build.sh
# manual installation
set up external dependencies: 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 .. > 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 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 install dependencies & configure app
> cabal sandbox init > cabal sandbox init
> cabal sandbox --add-source deps/hsSDL2 > cabal sandbox add-source deps/hsSDL2
> cabal sandbox --add-source deps/hsSDL2-ttf > cabal sandbox add-source deps/hsSDL2-ttf
> cabal install --only-dependencies > cabal install --only-dependencies
> cabal configure > cabal configure

View File

@ -12,6 +12,7 @@ executable Pioneers
ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm
} }
other-modules: other-modules:
Map.Map,
Map.Types, Map.Types,
Map.Graphics, Map.Graphics,
Map.Creation, Map.Creation,
@ -49,3 +50,33 @@ executable Pioneers
attoparsec-binary >= 0.1 attoparsec-binary >= 0.1
Default-Language: Haskell2010 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

23
deps/getDeps.sh vendored
View File

@ -14,7 +14,7 @@ fi
if [[ $install -eq 0 ]] if [[ $install -eq 0 ]]
then 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 fi
@ -38,6 +38,25 @@ else
cd .. cd ..
fi 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" echo "trying to build"
cabal install haddock cabal install haddock
@ -51,7 +70,7 @@ cabal install --only-dependencies
cabal build cabal build
cd .. cd ..
for t in "hsSDL2-ttf" for t in "hsSDL2-ttf" "hsSDL2-mixer" "hsSDL2-image"
do do
echo "building ${t}.." echo "building ${t}.."
cd "${t}" cd "${t}"

View File

@ -106,6 +106,7 @@ smooth in vec3 tePosition;
smooth in float fogDist; smooth in float fogDist;
smooth in float gmix; smooth in float gmix;
in vec4 teColor; in vec4 teColor;
in vec3 tePatchDistance;
out vec4 fgColor; out vec4 fgColor;
@ -116,6 +117,10 @@ void main(void)
{ {
//fog color //fog color
vec4 fogColor = vec4(0.6,0.7,0.8,1.0); 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 //heliospheric lighting
vec4 light = vec4(1.0,1.0,1.0,1.0); 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 = Color * mix(dark, light, a);
fgColor = mix(fgColor,fogColor,fog(fogDist)); fgColor = mix(fgColor,fogColor,fog(fogDist));
//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);
} }

View File

@ -10,6 +10,9 @@ out vec4 tcColor[];
out vec3 tcNormal[]; out vec3 tcNormal[];
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
uniform float TessLevelOuter = 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 #define ID gl_InvocationID
@ -18,10 +21,28 @@ void main()
tcPosition[ID] = vPosition[ID]; tcPosition[ID] = vPosition[ID];
tcColor[ID] = vColor[ID]; tcColor[ID] = vColor[ID];
tcNormal[ID] = vNormal[ID]; tcNormal[ID] = vNormal[ID];
float dist = (ProjectionMatrix * ViewMatrix * vec4(vPosition[ID], 1)).z;
if (ID == 0) { if (ID == 0) {
if (dist < 30) {
gl_TessLevelInner[0] = TessLevelInner; gl_TessLevelInner[0] = TessLevelInner;
gl_TessLevelOuter[0] = TessLevelOuter; gl_TessLevelOuter[0] = TessLevelOuter;
gl_TessLevelOuter[1] = TessLevelOuter; gl_TessLevelOuter[1] = TessLevelOuter;
gl_TessLevelOuter[2] = 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;
}
} }
} }

View File

@ -106,6 +106,7 @@ smooth out vec3 tePosition;
smooth out vec3 teNormal; smooth out vec3 teNormal;
smooth out float fogDist; smooth out float fogDist;
smooth out float gmix; //mixture of gravel smooth out float gmix; //mixture of gravel
out vec3 tePatchDistance;
//out vec3 tePatchDistance; //out vec3 tePatchDistance;
//constant projection matrix //constant projection matrix
uniform mat4 ProjectionMatrix; uniform mat4 ProjectionMatrix;
@ -126,6 +127,7 @@ void main()
vec3 p1 = gl_TessCoord.y * tcPosition[1]; vec3 p1 = gl_TessCoord.y * tcPosition[1];
vec3 p2 = gl_TessCoord.z * tcPosition[2]; vec3 p2 = gl_TessCoord.z * tcPosition[2];
tePosition = p0 + p1 + p2; tePosition = p0 + p1 + p2;
tePatchDistance = gl_TessCoord;
//sin(a,b) = length(cross(a,b)) //sin(a,b) = length(cross(a,b))
float i0 = (1-gl_TessCoord.x)*gl_TessCoord.x * length(cross(tcNormal[0],tessNormal)); 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 i2 = (1-gl_TessCoord.z)*gl_TessCoord.z * length(cross(tcNormal[2],tessNormal));
float standout = i0+i1+i2; float standout = i0+i1+i2;
tePosition = tePosition+tessNormal*standout; 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); gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1);
fogDist = gl_Position.z; fogDist = gl_Position.z;

View File

@ -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));
}

View File

@ -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;
}
}

View File

@ -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)));
}

View File

@ -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;
}

View File

@ -27,7 +27,7 @@ import Foreign.Marshal.Alloc (allocaBytes)
import Control.Lens ((^.), (.~), (%~)) import Control.Lens ((^.), (.~), (%~))
-- GUI -- GUI
import Graphics.UI.SDL as SDL import qualified Graphics.UI.SDL as SDL
-- Render -- Render
import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GL as GL
@ -66,15 +66,15 @@ testParser a = putStrLn . show =<< parseIQM a
main :: IO () main :: IO ()
main = main =
SDL.withInit [InitVideo, InitAudio, InitEvents, InitTimer] $ --also: InitNoParachute -> faster, without parachute! SDL.withInit [SDL.InitVideo, SDL.InitAudio, SDL.InitEvents, SDL.InitTimer] $ --also: InitNoParachute -> faster, without parachute!
SDL.withWindow "Pioneers" (SDL.Position 100 100) (Size 1024 600) [WindowOpengl -- we want openGL SDL.withWindow "Pioneers" (SDL.Position 100 100) (SDL.Size 1024 600) [SDL.WindowOpengl -- we want openGL
,WindowShown -- window should be visible ,SDL.WindowShown -- window should be visible
,WindowResizable -- and resizable ,SDL.WindowResizable -- and resizable
,WindowInputFocus -- focused (=> active) ,SDL.WindowInputFocus -- focused (=> active)
,WindowMouseFocus -- Mouse into it ,SDL.WindowMouseFocus -- Mouse into it
--,WindowInputGrabbed-- never let go of input (KB/Mouse) --,WindowInputGrabbed-- never let go of input (KB/Mouse)
] $ \window' -> do ] $ \window' -> do
withOpenGL window' $ do SDL.withOpenGL window' $ do
--Create Renderbuffer & Framebuffer --Create Renderbuffer & Framebuffer
-- We will render to this buffer to copy the result into textures -- We will render to this buffer to copy the result into textures
@ -83,15 +83,12 @@ main =
GL.bindFramebuffer GL.Framebuffer GL.$= frameBuffer GL.bindFramebuffer GL.Framebuffer GL.$= frameBuffer
GL.bindRenderbuffer GL.Renderbuffer GL.$= renderBuffer GL.bindRenderbuffer GL.Renderbuffer GL.$= renderBuffer
(Size fbWidth fbHeight) <- glGetDrawableSize window' (SDL.Size fbWidth fbHeight) <- SDL.glGetDrawableSize window'
initRendering initRendering
--generate map vertices --generate map vertices
glMap' <- initMapShader 4 =<< getMapBufferObject glMap' <- initMapShader 4 =<< getMapBufferObject
print window' eventQueue <- newTQueueIO :: IO (TQueue SDL.Event)
eventQueue <- newTQueueIO :: IO (TQueue Event)
putStrLn "foo"
now <- getCurrentTime now <- getCurrentTime
putStrLn "foo"
--font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10 --font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
--TTF.setFontStyle font TTFNormal --TTF.setFontStyle font TTFNormal
--TTF.setFontHinting font TTFHNormal --TTF.setFontHinting font TTFHNormal
@ -133,6 +130,7 @@ main =
} }
, _io = IOState , _io = IOState
{ _clock = now { _clock = now
, _tessClockFactor = 0
} }
, _mouse = MouseState , _mouse = MouseState
{ _isDown = False { _isDown = False
@ -182,7 +180,7 @@ run = do
-- draw Scene -- draw Scene
draw draw
liftIO $ glSwapWindow (env ^. windowObject) liftIO $ SDL.glSwapWindow (env ^. windowObject)
-- getEvents & process -- getEvents & process
processEvents processEvents
@ -230,17 +228,33 @@ run = do
} }
-} -}
mt <- liftIO $ do (mt,tc,sleepAmount,frameTime) <- liftIO $ do
let double = fromRational.toRational :: (Real a) => a -> Double let double = fromRational.toRational :: (Real a) => a -> Double
targetFramerate = 60.0
targetFrametime = 1.0/targetFramerate
targetFrametimeμs = targetFrametime * 1000000.0
now <- getCurrentTime now <- getCurrentTime
diff <- return $ diffUTCTime now (state ^. io.clock) -- get time-diffs let diff = diffUTCTime now (state ^. io.clock) -- get time-diffs
title <- return $ unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"] title = unwords ["Pioneers @ ",show ((round . double $ 1.0/diff)::Int),"fps"]
setWindowTitle (env ^. windowObject) title ddiff = double diff
sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds SDL.setWindowTitle (env ^. windowObject) title
threadDelay sleepAmount let sleepAmount = floor ((targetFrametime - double diff)*1000000) :: Int -- get time until next frame in microseconds
return now 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 -- 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 shouldClose' <- return $ state ^. window.shouldClose
unless shouldClose' run unless shouldClose' run
@ -315,14 +329,14 @@ adjustWindow = do
processEvents :: Pioneers () processEvents :: Pioneers ()
processEvents = do processEvents = do
me <- liftIO pollEvent me <- liftIO SDL.pollEvent
case me of case me of
Just e -> do Just e -> do
processEvent e processEvent e
processEvents processEvents
Nothing -> return () Nothing -> return ()
processEvent :: Event -> Pioneers () processEvent :: SDL.Event -> Pioneers ()
processEvent e = do processEvent e = do
eventCallback e eventCallback e
-- env <- ask -- env <- ask
@ -331,7 +345,7 @@ processEvent e = do
case winEvent of case winEvent of
SDL.Closing -> SDL.Closing ->
modify $ window.shouldClose .~ True modify $ window.shouldClose .~ True
SDL.Resized {windowResizedTo=size} -> do SDL.Resized {SDL.windowResizedTo=size} -> do
modify $ (window . width .~ SDL.sizeWidth size) modify $ (window . width .~ SDL.sizeWidth size)
. (window . height .~ SDL.sizeHeight size) . (window . height .~ SDL.sizeHeight size)
adjustWindow adjustWindow

View File

@ -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)

View File

@ -2,19 +2,25 @@ module Map.Creation
where where
import Map.Types import Map.Types
import Map.Map import Map.StaticMaps
-- import Map.Map unused (for now)
import Data.Array import Data.Array
import System.Random import System.Random
-- Orphan instance since this isn't where either Random nor Tuples are defined -- preliminary
instance (Random x, Random y) => Random (x, y) where infix 5 ->-
randomR ((x1, y1), (x2, y2)) gen1 = let (a, gen2) = randomR (x1, x2) gen1 (->-) :: (PlayMap -> PlayMap) -> (PlayMap -> PlayMap) -> PlayMap -> PlayMap
(b, gen3) = randomR (y1, y2) gen2 f ->- g = g . f
in ((a, b), gen3)
random gen1 = let (a, gen2) = random gen1 -- also preliminary
(b, gen3) = random gen2 in ((a,b), gen3) 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 -- | 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)) 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 :: [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 -- general 3D-Gaussian
gauss3Dgeneral :: Floating q => gauss3Dgeneral :: Floating q =>
@ -68,3 +77,37 @@ heightToTerrain GrassIslandMap y
| y < 10 = Hill | y < 10 = Hill
| otherwise = Mountain | otherwise = Mountain
heightToTerrain _ _ = undefined 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....

View File

@ -30,9 +30,7 @@ import Linear
import Control.Arrow ((***)) import Control.Arrow ((***))
import Map.Types import Map.Types
import Map.StaticMaps
import Map.Creation import Map.Creation
import Map.Combinators
type Height = Float type Height = Float
@ -91,8 +89,8 @@ fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
getMapBufferObject :: IO (BufferObject, NumArrayIndices) getMapBufferObject :: IO (BufferObject, NumArrayIndices)
getMapBufferObject = do getMapBufferObject = do
mountains <- mnt eMap <- exportedMap
myMap' <- return $ convertToGraphicsMap $ convertToStripeMap $ aplAll mountains mapEmpty myMap' <- return $ convertToGraphicsMap $ convertToStripeMap eMap
! myMap <- return $ generateTriangles myMap' ! myMap <- return $ generateTriangles myMap'
len <- return $ fromIntegral $ P.length myMap `div` numComponents len <- return $ fromIntegral $ P.length myMap `div` numComponents
putStrLn $ P.unwords ["num verts in map:",show len] putStrLn $ P.unwords ["num verts in map:",show len]

View File

@ -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 -- removing duplicates in O(n log n), losing order and adding Ord requirement
remdups :: Ord a => [a] -> [a] remdups :: Ord a => [a] -> [a]
remdups = map head . group . sort remdups = map head . group . sort
prop_rd_idempot :: Ord a => [a] -> Bool
prop_rd_idempot xs = remdups xs == (remdups . remdups) xs

View File

@ -3,48 +3,47 @@ where
import Map.Types import Map.Types
import Data.Array import Data.Array
import Map.Creation
-- entirely empty map, only uses the minimal constructor -- entirely empty map, only uses the minimal constructor
mapEmpty :: PlayMap mapEmpty :: PlayMap
mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]] mapEmpty = array ((0,0), (199,199)) [((a,b), Minimal (a,b)) | a <- [0..199], b <- [0..199]]
mapCenterMountain :: PlayMap --mapCenterMountain :: PlayMap
mapCenterMountain = array ((0,0),(199,199)) nodes --mapCenterMountain = array ((0,0),(199,199)) nodes
where -- where
nodes = water ++ beach ++ grass ++ hill ++ mountain -- 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] -- 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] -- 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] -- 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] -- 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] -- 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 :: Int -> Int -> Float
g2d x y = gauss3D (fromIntegral x) (fromIntegral y) -- g2d x y = gauss3D (fromIntegral x) (fromIntegral y)
m2d :: (Int,Int) -> Int -- m2d :: (Int,Int) -> Int
m2d (x,y) = mnh2D (x,y) (100,100) -- m2d (x,y) = mnh2D (x,y) (100,100)
-- small helper for some hills. Should be replaced by multi-layer perlin-noise -- small helper for some hills. Should be replaced by multi-layer perlin-noise
-- TODO: Replace as given in comment. -- TODO: Replace as given in comment.
_noisyMap :: (Floating q) => q -> q -> q --_noisyMap :: (Floating q) => q -> q -> q
_noisyMap x y = gauss3Dgeneral 15 100.0 100.0 15.0 15.0 x y --_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 10.0 10.0 10.0 10.0 x y
+ gauss3Dgeneral 5 150.0 120.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 -- + gauss3Dgeneral 5 50.0 75.0 10.0 10.0 x y
-- generates a noisy map -- generates a noisy map
-- TODO: add real noise to a simple pattern -- TODO: add real noise to a simple pattern
mapNoise :: PlayMap --mapNoise :: PlayMap
mapNoise = array ((0,0),(199,199)) nodes --mapNoise = array ((0,0),(199,199)) nodes
where -- where
nodes = [((a,b), Full (a,b) -- nodes = [((a,b), Full (a,b)
(height a b) -- (height a b)
(heightToTerrain GrassIslandMap $ height a b) -- (heightToTerrain GrassIslandMap $ height a b)
BNothing -- BNothing
NoPlayer -- NoPlayer
NoPath -- NoPath
Plain -- Plain
[]) | a <- [0..199], b <- [0..199]] -- []) | a <- [0..199], b <- [0..199]]
where -- where
height a b = _noisyMap (fromIntegral a) (fromIntegral b) -- height a b = _noisyMap (fromIntegral a) (fromIntegral b)

View File

@ -22,6 +22,8 @@ import Types
import Render.Misc import Render.Misc
import Render.Types import Render.Types
import Graphics.GLUtil.BufferObjects (makeBuffer) import Graphics.GLUtil.BufferObjects (makeBuffer)
import Importer.IQM.Parser
import Importer.IQM.Types
mapVertexShaderFile :: String mapVertexShaderFile :: String
mapVertexShaderFile = "shaders/map/vertex.shader" mapVertexShaderFile = "shaders/map/vertex.shader"
@ -32,6 +34,11 @@ mapTessEvalShaderFile = "shaders/map/tessEval.shader"
mapFragmentShaderFile :: String mapFragmentShaderFile :: String
mapFragmentShaderFile = "shaders/map/fragment.shader" mapFragmentShaderFile = "shaders/map/fragment.shader"
objectVertexShaderFile :: String
objectVertexShaderFile = "shaders/mapobjects/vertex.shader"
objectFragmentShaderFile :: String
objectFragmentShaderFile = "shaders/mapobjects/fragment.shader"
uiVertexShaderFile :: String uiVertexShaderFile :: String
uiVertexShaderFile = "shaders/ui/vertex.shader" uiVertexShaderFile = "shaders/ui/vertex.shader"
uiFragmentShaderFile :: String uiFragmentShaderFile :: String
@ -113,6 +120,21 @@ initMapShader tessFac (buf, vertDes) = do
texts <- genObjectNames 6 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" checkError "initShader"
return GLMapState return GLMapState
@ -132,6 +154,8 @@ initMapShader tessFac (buf, vertDes) = do
, _mapVert = vertDes , _mapVert = vertDes
, _overviewTexture = overTex , _overviewTexture = overTex
, _mapTextures = texts , _mapTextures = texts
, _mapObjects = objs
, _objectProgram = objProgram
} }
initHud :: IO GLHud 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 :: Pioneers ()
render = do render = do
state <- RWS.get state <- RWS.get
@ -354,8 +388,15 @@ render = do
cullFace $= Just Front cullFace $= Just Front
glDrawArrays gl_PATCHES 0 (fromIntegral numVert) glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
checkError "draw map" checkError "draw map"
---- RENDER MAPOBJECTS --------------------------------------------
currentProgram $= Just (state ^. gl.glMap.objectProgram)
mapM_ renderObject (state ^. gl.glMap.mapObjects)
-- set sample 1 as target in renderbuffer -- set sample 1 as target in renderbuffer
{-framebufferRenderbuffer {-framebufferRenderbuffer
DrawFramebuffer --write-only DrawFramebuffer --write-only

View File

@ -8,12 +8,15 @@ import Foreign.C (CFloat)
import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict as Map
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Linear.Matrix (M44) import Linear.Matrix (M44)
import Linear (V3)
import Control.Monad.RWS.Strict (RWST) import Control.Monad.RWS.Strict (RWST)
import Control.Lens import Control.Lens
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
import Render.Types import Render.Types
import Importer.IQM.Types
import UI.UIBase import UI.UIBase
data Coord3D a = Coord3D a a a
--Static Read-Only-State --Static Read-Only-State
data Env = Env data Env = Env
@ -49,6 +52,7 @@ data CameraState = CameraState
data IOState = IOState data IOState = IOState
{ _clock :: !UTCTime { _clock :: !UTCTime
, _tessClockFactor :: !Double
} }
data GameState = GameState data GameState = GameState
@ -113,8 +117,16 @@ data GLMapState = GLMapState
, _renderedMapTexture :: !TextureObject --TODO: Probably move to UI? , _renderedMapTexture :: !TextureObject --TODO: Probably move to UI?
, _overviewTexture :: !TextureObject , _overviewTexture :: !TextureObject
, _mapTextures :: ![TextureObject] --TODO: Fix size on list? , _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 data GLHud = GLHud
{ _hudTexture :: !TextureObject -- ^ HUD-Texture itself { _hudTexture :: !TextureObject -- ^ HUD-Texture itself
, _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader , _hudTexIndex :: !GL.UniformLocation -- ^ Position of Overlay-Texture in Shader

23
tests/Map/MapTestSuite.hs Normal file
View File

@ -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