Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge branch 'master' into ui

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
COMPILING
View File

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

31
Pioneers.cabal
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
}
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

23
deps/getDeps.sh vendored
View File

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

12
shaders/map/fragment.shader
View File

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

29
shaders/map/tessControl.shader
View File

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

5
shaders/map/tessEval.shader
View File

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

157
shaders/mapobjects/fragment.shader Normal file
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));
}

27
shaders/mapobjects/tessControl.shader Normal file
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;
}
}

149
shaders/mapobjects/tessEval.shader Normal file
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)));
}

18
shaders/mapobjects/vertex.shader Normal file
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;
}

66
src/Main.hs
View File

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

46
src/Map/Combinators.hs
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)

61
src/Map/Creation.hs
View File

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

6
src/Map/Graphics.hs
View File

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

3
src/Map/Map.hs
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
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

63
src/Map/StaticMaps.hs
View File

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

41
src/Render/Render.hs
View File

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

12
src/Types.hs
View File

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

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