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

Merge branch 'tessallation' into mapmerge

Browse Source 
Conflicts:
	src/Main.hs
	src/Map/Graphics.hs
This commit is contained in:
Nicole Dresselhaus 2014-03-05 15:02:30 +01:00
commit e6c6442c85
17 changed files with 987 additions and 298 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.travis.prepare.sh Executable file
View File

@ -0,0 +1,4 @@
#!/bin/bash
cd deps
./getDeps.sh ni #non-interactively..
cd ..

2
.travis.yml Normal file
View File

@ -0,0 +1,2 @@
language: haskell
before_install: sh .travis.prepare.sh

9
Pioneers.cabal
View File

@ -6,7 +6,7 @@ author: sdressel
executable Pioneers
hs-source-dirs: src
ghc-options: -Wall
ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm
other-modules:
Map.Types,
Map.Graphics,
@ -14,7 +14,9 @@ executable Pioneers
Map.StaticMaps,
Render.Misc,
Render.Render,
Render.RenderObject
Render.RenderObject,
UI.Callbacks,
Types
main-is: Main.hs
build-depends:
base >=4.6,
@ -32,5 +34,6 @@ executable Pioneers
linear >=1.3.1 && <1.4,
lens >=3.10.1 && <3.11,
SDL2 >= 0.1.0,
time >=1.4.0 && <1.5
time >=1.4.0 && <1.5,
fclabels >=2.0.0 && <3

59
deps/getDeps.sh vendored
View File

@ -2,10 +2,14 @@
#hack until saucy has 2.0.1 instead of 2.0.0
sudo apt-get install dialog
dialog --yesno "Install libSDL2.0.1 from ubuntu trusty?\nCurrently needed for saucy as they only serve 2.0.0 in the repos\n\nThe script will try to download the trusty-packages and resolve dependencies via gdebi" 20 75
install=${?}
if [ "$1" != "ni" ]
then
sudo apt-get install dialog
dialog --yesno "Install libSDL2.0.1 from ubuntu trusty?\nCurrently needed for saucy as they only serve 2.0.0 in the repos\n\nThe script will try to download the trusty-packages and resolve dependencies via gdebi" 20 75
install=${?}
else
install=0
fi
if [[ $install -eq 0 ]]
then
@ -14,20 +18,45 @@ then
if [ ! -f "libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi --n libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb
fi
if [ ! -f "libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi --n libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb
fi
if [ ! -f "libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb
sudo gdebi --n libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb
fi
if [ ! -f "libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb" ]
then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb
sudo gdebi --n libsdl2-ttf-2.0-0_2.0.12+dfsg1-2_amd64.deb
fi
if [ ! -f "libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb" ]
then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-ttf/libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb
sudo gdebi --n libsdl2-ttf-dev_2.0.12+dfsg1-2_amd64.deb
fi
# this update would need tons of further package-updates... like killing libsdl1.2:i386
# if [ ! -f "libtiff5_4.0.3-7_amd64.deb" ]
# then
# wget http://de.archive.ubuntu.com/ubuntu/pool/main/t/tiff/libtiff5_4.0.3-7_amd64.deb
# sudo gdebi --n libtiff5_4.0.3-7_amd64.deb
# fi
# if [ ! -f "libsdl2-image-2.0-0_2.0.0+dfsg-3_amd64.deb" ]
# then
# wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb
# sudo gdebi --n libsdl2-image-2.0-0_2.0.0+dfsg-3build2_amd64.deb
# fi
# if [ ! -f "libsdl2-image-dev_2.0.0+dfsg-3_amd64.deb" ]
# then
# wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2-image/libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb
# sudo gdebi --n libsdl2-image-dev_2.0.0+dfsg-3build2_amd64.deb
# fi
fi
## hack end
echo "cloning repositories"
@ -40,7 +69,19 @@ else
cd ..
fi
if [ ! -d "hsSDL2-ttf" ]
then
git clone https://github.com/osa1/hsSDL2-ttf hsSDL2-ttf
else
cd hsSDL2-ttf
git pull
cd ..
fi
echo "trying to build"
cabal install haddock
for d in `find . -maxdepth 1 -type d`
do
if [ "$d" == "." ]
@ -53,7 +94,7 @@ do
cabal configure
cabal build
cabal haddock --hyperlink-source
cabal install
cabal install --force-reinstalls
cd ..
fi
done

70
shaders/3rdParty/noise2D.glsl vendored Normal file
View File

@ -0,0 +1,70 @@
//
// Description : Array and textureless GLSL 2D simplex noise function.
// Author : Ian McEwan, Ashima Arts.
// Maintainer : ijm
// Lastmod : 20110822 (ijm)
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
// Distributed under the MIT License. See LICENSE file.
// https://github.com/ashima/webgl-noise
//
vec3 mod289(vec3 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec2 mod289(vec2 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec3 permute(vec3 x) {
return mod289(((x*34.0)+1.0)*x);
}
float snoise(vec2 v)
{
const vec4 C = vec4(0.211324865405187, // (3.0-sqrt(3.0))/6.0
0.366025403784439, // 0.5*(sqrt(3.0)-1.0)
-0.577350269189626, // -1.0 + 2.0 * C.x
0.024390243902439); // 1.0 / 41.0
// First corner
vec2 i = floor(v + dot(v, C.yy) );
vec2 x0 = v - i + dot(i, C.xx);
// Other corners
vec2 i1;
//i1.x = step( x0.y, x0.x ); // x0.x > x0.y ? 1.0 : 0.0
//i1.y = 1.0 - i1.x;
i1 = (x0.x > x0.y) ? vec2(1.0, 0.0) : vec2(0.0, 1.0);
// x0 = x0 - 0.0 + 0.0 * C.xx ;
// x1 = x0 - i1 + 1.0 * C.xx ;
// x2 = x0 - 1.0 + 2.0 * C.xx ;
vec4 x12 = x0.xyxy + C.xxzz;
x12.xy -= i1;
// Permutations
i = mod289(i); // Avoid truncation effects in permutation
vec3 p = permute( permute( i.y + vec3(0.0, i1.y, 1.0 ))
+ i.x + vec3(0.0, i1.x, 1.0 ));
vec3 m = max(0.5 - vec3(dot(x0,x0), dot(x12.xy,x12.xy), dot(x12.zw,x12.zw)), 0.0);
m = m*m ;
m = m*m ;
// Gradients: 41 points uniformly over a line, mapped onto a diamond.
// The ring size 17*17 = 289 is close to a multiple of 41 (41*7 = 287)
vec3 x = 2.0 * fract(p * C.www) - 1.0;
vec3 h = abs(x) - 0.5;
vec3 ox = floor(x + 0.5);
vec3 a0 = x - ox;
// Normalise gradients implicitly by scaling m
// Approximation of: m *= inversesqrt( a0*a0 + h*h );
m *= 1.79284291400159 - 0.85373472095314 * ( a0*a0 + h*h );
// Compute final noise value at P
vec3 g;
g.x = a0.x * x0.x + h.x * x0.y;
g.yz = a0.yz * x12.xz + h.yz * x12.yw;
return 130.0 * dot(m, g);
}

102
shaders/3rdParty/noise3D.glsl vendored Normal file
View File

@ -0,0 +1,102 @@
//
// Description : Array and textureless GLSL 2D/3D/4D simplex
// noise functions.
// Author : Ian McEwan, Ashima Arts.
// Maintainer : ijm
// Lastmod : 20110822 (ijm)
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
// Distributed under the MIT License. See LICENSE file.
// https://github.com/ashima/webgl-noise
//
vec3 mod289(vec3 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec4 mod289(vec4 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec4 permute(vec4 x) {
return mod289(((x*34.0)+1.0)*x);
}
vec4 taylorInvSqrt(vec4 r)
{
return 1.79284291400159 - 0.85373472095314 * r;
}
float snoise(vec3 v)
{
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
// First corner
vec3 i = floor(v + dot(v, C.yyy) );
vec3 x0 = v - i + dot(i, C.xxx) ;
// Other corners
vec3 g = step(x0.yzx, x0.xyz);
vec3 l = 1.0 - g;
vec3 i1 = min( g.xyz, l.zxy );
vec3 i2 = max( g.xyz, l.zxy );
// x0 = x0 - 0.0 + 0.0 * C.xxx;
// x1 = x0 - i1 + 1.0 * C.xxx;
// x2 = x0 - i2 + 2.0 * C.xxx;
// x3 = x0 - 1.0 + 3.0 * C.xxx;
vec3 x1 = x0 - i1 + C.xxx;
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
// Permutations
i = mod289(i);
vec4 p = permute( permute( permute(
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
// Gradients: 7x7 points over a square, mapped onto an octahedron.
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
float n_ = 0.142857142857; // 1.0/7.0
vec3 ns = n_ * D.wyz - D.xzx;
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
vec4 x_ = floor(j * ns.z);
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
vec4 x = x_ *ns.x + ns.yyyy;
vec4 y = y_ *ns.x + ns.yyyy;
vec4 h = 1.0 - abs(x) - abs(y);
vec4 b0 = vec4( x.xy, y.xy );
vec4 b1 = vec4( x.zw, y.zw );
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
vec4 s0 = floor(b0)*2.0 + 1.0;
vec4 s1 = floor(b1)*2.0 + 1.0;
vec4 sh = -step(h, vec4(0.0));
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
vec3 p0 = vec3(a0.xy,h.x);
vec3 p1 = vec3(a0.zw,h.y);
vec3 p2 = vec3(a1.xy,h.z);
vec3 p3 = vec3(a1.zw,h.w);
//Normalise gradients
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
p0 *= norm.x;
p1 *= norm.y;
p2 *= norm.z;
p3 *= norm.w;
// Mix final noise value
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
m = m * m;
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
dot(p2,x2), dot(p3,x3) ) );
}

128
shaders/3rdParty/noise4D.glsl vendored Normal file
View File

@ -0,0 +1,128 @@
//
// Description : Array and textureless GLSL 2D/3D/4D simplex
// noise functions.
// Author : Ian McEwan, Ashima Arts.
// Maintainer : ijm
// Lastmod : 20110822 (ijm)
// License : Copyright (C) 2011 Ashima Arts. All rights reserved.
// Distributed under the MIT License. See LICENSE file.
// https://github.com/ashima/webgl-noise
//
vec4 mod289(vec4 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0; }
float mod289(float x) {
return x - floor(x * (1.0 / 289.0)) * 289.0; }
vec4 permute(vec4 x) {
return mod289(((x*34.0)+1.0)*x);
}
float permute(float x) {
return mod289(((x*34.0)+1.0)*x);
}
vec4 taylorInvSqrt(vec4 r)
{
return 1.79284291400159 - 0.85373472095314 * r;
}
float taylorInvSqrt(float r)
{
return 1.79284291400159 - 0.85373472095314 * r;
}
vec4 grad4(float j, vec4 ip)
{
const vec4 ones = vec4(1.0, 1.0, 1.0, -1.0);
vec4 p,s;
p.xyz = floor( fract (vec3(j) * ip.xyz) * 7.0) * ip.z - 1.0;
p.w = 1.5 - dot(abs(p.xyz), ones.xyz);
s = vec4(lessThan(p, vec4(0.0)));
p.xyz = p.xyz + (s.xyz*2.0 - 1.0) * s.www;
return p;
}
// (sqrt(5) - 1)/4 = F4, used once below
#define F4 0.309016994374947451
float snoise(vec4 v)
{
const vec4 C = vec4( 0.138196601125011, // (5 - sqrt(5))/20 G4
0.276393202250021, // 2 * G4
0.414589803375032, // 3 * G4
-0.447213595499958); // -1 + 4 * G4
// First corner
vec4 i = floor(v + dot(v, vec4(F4)) );
vec4 x0 = v - i + dot(i, C.xxxx);
// Other corners
// Rank sorting originally contributed by Bill Licea-Kane, AMD (formerly ATI)
vec4 i0;
vec3 isX = step( x0.yzw, x0.xxx );
vec3 isYZ = step( x0.zww, x0.yyz );
// i0.x = dot( isX, vec3( 1.0 ) );
i0.x = isX.x + isX.y + isX.z;
i0.yzw = 1.0 - isX;
// i0.y += dot( isYZ.xy, vec2( 1.0 ) );
i0.y += isYZ.x + isYZ.y;
i0.zw += 1.0 - isYZ.xy;
i0.z += isYZ.z;
i0.w += 1.0 - isYZ.z;
// i0 now contains the unique values 0,1,2,3 in each channel
vec4 i3 = clamp( i0, 0.0, 1.0 );
vec4 i2 = clamp( i0-1.0, 0.0, 1.0 );
vec4 i1 = clamp( i0-2.0, 0.0, 1.0 );
// x0 = x0 - 0.0 + 0.0 * C.xxxx
// x1 = x0 - i1 + 1.0 * C.xxxx
// x2 = x0 - i2 + 2.0 * C.xxxx
// x3 = x0 - i3 + 3.0 * C.xxxx
// x4 = x0 - 1.0 + 4.0 * C.xxxx
vec4 x1 = x0 - i1 + C.xxxx;
vec4 x2 = x0 - i2 + C.yyyy;
vec4 x3 = x0 - i3 + C.zzzz;
vec4 x4 = x0 + C.wwww;
// Permutations
i = mod289(i);
float j0 = permute( permute( permute( permute(i.w) + i.z) + i.y) + i.x);
vec4 j1 = permute( permute( permute( permute (
i.w + vec4(i1.w, i2.w, i3.w, 1.0 ))
+ i.z + vec4(i1.z, i2.z, i3.z, 1.0 ))
+ i.y + vec4(i1.y, i2.y, i3.y, 1.0 ))
+ i.x + vec4(i1.x, i2.x, i3.x, 1.0 ));
// Gradients: 7x7x6 points over a cube, mapped onto a 4-cross polytope
// 7*7*6 = 294, which is close to the ring size 17*17 = 289.
vec4 ip = vec4(1.0/294.0, 1.0/49.0, 1.0/7.0, 0.0) ;
vec4 p0 = grad4(j0, ip);
vec4 p1 = grad4(j1.x, ip);
vec4 p2 = grad4(j1.y, ip);
vec4 p3 = grad4(j1.z, ip);
vec4 p4 = grad4(j1.w, ip);
// Normalise gradients
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
p0 *= norm.x;
p1 *= norm.y;
p2 *= norm.z;
p3 *= norm.w;
p4 *= taylorInvSqrt(dot(p4,p4));
// Mix contributions from the five corners
vec3 m0 = max(0.6 - vec3(dot(x0,x0), dot(x1,x1), dot(x2,x2)), 0.0);
vec2 m1 = max(0.6 - vec2(dot(x3,x3), dot(x4,x4) ), 0.0);
m0 = m0 * m0;
m1 = m1 * m1;
return 49.0 * ( dot(m0*m0, vec3( dot( p0, x0 ), dot( p1, x1 ), dot( p2, x2 )))
+ dot(m1*m1, vec2( dot( p3, x3 ), dot( p4, x4 ) ) ) ) ;
}

145
shaders/fragment.shader
View File

@ -1,12 +1,145 @@
#version 330
#version 400
//color from earlier stages
smooth in vec4 fg_SmoothColor;
//#include "3rdParty/noise.glsl"
out vec4 fg_FragColor;
vec3 mod289(vec3 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec4 mod289(vec4 x) {
return x - floor(x * (1.0 / 289.0)) * 289.0;
}
vec4 permute(vec4 x) {
return mod289(((x*34.0)+1.0)*x);
}
vec4 taylorInvSqrt(vec4 r)
{
return 1.79284291400159 - 0.85373472095314 * r;
}
float snoise(vec3 v)
{
const vec2 C = vec2(1.0/6.0, 1.0/3.0) ;
const vec4 D = vec4(0.0, 0.5, 1.0, 2.0);
// First corner
vec3 i = floor(v + dot(v, C.yyy) );
vec3 x0 = v - i + dot(i, C.xxx) ;
// Other corners
vec3 g = step(x0.yzx, x0.xyz);
vec3 l = 1.0 - g;
vec3 i1 = min( g.xyz, l.zxy );
vec3 i2 = max( g.xyz, l.zxy );
// x0 = x0 - 0.0 + 0.0 * C.xxx;
// x1 = x0 - i1 + 1.0 * C.xxx;
// x2 = x0 - i2 + 2.0 * C.xxx;
// x3 = x0 - 1.0 + 3.0 * C.xxx;
vec3 x1 = x0 - i1 + C.xxx;
vec3 x2 = x0 - i2 + C.yyy; // 2.0*C.x = 1/3 = C.y
vec3 x3 = x0 - D.yyy; // -1.0+3.0*C.x = -0.5 = -D.y
// Permutations
i = mod289(i);
vec4 p = permute( permute( permute(
i.z + vec4(0.0, i1.z, i2.z, 1.0 ))
+ i.y + vec4(0.0, i1.y, i2.y, 1.0 ))
+ i.x + vec4(0.0, i1.x, i2.x, 1.0 ));
// Gradients: 7x7 points over a square, mapped onto an octahedron.
// The ring size 17*17 = 289 is close to a multiple of 49 (49*6 = 294)
float n_ = 0.142857142857; // 1.0/7.0
vec3 ns = n_ * D.wyz - D.xzx;
vec4 j = p - 49.0 * floor(p * ns.z * ns.z); // mod(p,7*7)
vec4 x_ = floor(j * ns.z);
vec4 y_ = floor(j - 7.0 * x_ ); // mod(j,N)
vec4 x = x_ *ns.x + ns.yyyy;
vec4 y = y_ *ns.x + ns.yyyy;
vec4 h = 1.0 - abs(x) - abs(y);
vec4 b0 = vec4( x.xy, y.xy );
vec4 b1 = vec4( x.zw, y.zw );
//vec4 s0 = vec4(lessThan(b0,0.0))*2.0 - 1.0;
//vec4 s1 = vec4(lessThan(b1,0.0))*2.0 - 1.0;
vec4 s0 = floor(b0)*2.0 + 1.0;
vec4 s1 = floor(b1)*2.0 + 1.0;
vec4 sh = -step(h, vec4(0.0));
vec4 a0 = b0.xzyw + s0.xzyw*sh.xxyy ;
vec4 a1 = b1.xzyw + s1.xzyw*sh.zzww ;
vec3 p0 = vec3(a0.xy,h.x);
vec3 p1 = vec3(a0.zw,h.y);
vec3 p2 = vec3(a1.xy,h.z);
vec3 p3 = vec3(a1.zw,h.w);
//Normalise gradients
vec4 norm = taylorInvSqrt(vec4(dot(p0,p0), dot(p1,p1), dot(p2, p2), dot(p3,p3)));
p0 *= norm.x;
p1 *= norm.y;
p2 *= norm.z;
p3 *= norm.w;
// Mix final noise value
vec4 m = max(0.6 - vec4(dot(x0,x0), dot(x1,x1), dot(x2,x2), dot(x3,x3)), 0.0);
m = m * m;
return 42.0 * dot( m*m, vec4( dot(p0,x0), dot(p1,x1),
dot(p2,x2), dot(p3,x3) ) );
}
smooth in vec3 teNormal;
smooth in vec3 tePosition;
smooth in float gmix;
in vec4 teColor;
out vec4 fgColor;
uniform mat4 ViewMatrix;
void main(void)
{
//copy-shader
fg_FragColor = fg_SmoothColor;
//heliospheric lighting
vec4 light = vec4(1.0,1.0,1.0,1.0);
vec4 dark = vec4(0.0,0.0,0.0,1.0);
//direction to sun from origin
vec3 lightDir = normalize(ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz;
float costheta = dot(teNormal, lightDir);
float a = costheta * 0.5 + 0.5;
//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);
}

26
shaders/tessControl.shader Normal file
View File

@ -0,0 +1,26 @@
#version 400
layout(vertices = 3) out;
in vec3 vPosition[];
in vec4 vColor[];
in vec3 vNormal[];
out vec3 tcPosition[];
out vec4 tcColor[];
out vec3 tcNormal[];
uniform float TessLevelInner = 1.0; // controlled by keyboard buttons
uniform float TessLevelOuter = 1.0; // controlled by keyboard buttons
#define ID gl_InvocationID
void main()
{
tcPosition[ID] = vPosition[ID];
tcColor[ID] = vColor[ID];
tcNormal[ID] = vNormal[ID];
if (ID == 0) {
gl_TessLevelInner[0] = TessLevelInner;
gl_TessLevelOuter[0] = TessLevelOuter;
gl_TessLevelOuter[1] = TessLevelOuter;
gl_TessLevelOuter[2] = TessLevelOuter;
}
}

49
shaders/tessEval.shader Normal file
View File

@ -0,0 +1,49 @@
#version 400
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 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;
gl_Position = ProjectionMatrix * ViewMatrix * vec4(tePosition, 1);
//COLOR-BLENDING
vec4 c0 = sqrt(gl_TessCoord.x) * tcColor[0];
vec4 c1 = sqrt(gl_TessCoord.y) * tcColor[1];
vec4 c2 = sqrt(gl_TessCoord.z) * tcColor[2];
teColor = (c0 + c1 + c2)/(sqrt(gl_TessCoord.x)+sqrt(gl_TessCoord.y)+sqrt(gl_TessCoord.z));
//mix gravel based on incline (sin (normal,up))
gmix = length(cross(tessNormal, vec3(0,1,0)));
}

34
shaders/vertex.shader
View File

@ -1,32 +1,18 @@
#version 330
//constant projection matrix
uniform mat4 fg_ProjectionMatrix;
uniform mat4 fg_ViewMatrix;
uniform mat3 fg_NormalMatrix;
#version 400
//vertex-data
in vec4 fg_Color;
in vec3 fg_VertexIn;
in vec3 fg_NormalIn;
in vec4 Color;
in vec3 Position;
in vec3 Normal;
//output-data for later stages
smooth out vec4 fg_SmoothColor;
out vec4 vColor;
out vec3 vPosition;
out vec3 vNormal;
void main()
{
vec3 fg_Normal = fg_NormalMatrix * fg_NormalIn; //vec3(0,1,0);
//transform vec3 into vec4, setting w to 1
vec4 fg_Vertex = vec4(fg_VertexIn, 1.0);
vec4 light = vec4(1.0,1.0,1.0,1.0);
vec4 dark = vec4(0.0,0.0,0.0,1.0);
//direction to sun from origin
vec3 lightDir = normalize(fg_ViewMatrix * vec4(5.0,5.0,1.0,0.0)).xyz;
float costheta = dot(normalize(fg_Normal), lightDir);
float a = costheta * 0.5 + 0.5;
fg_SmoothColor = fg_Color * mix(dark, light, a);// + 0.001* fg_Normal.xyzx;
gl_Position = fg_ProjectionMatrix * fg_ViewMatrix * fg_Vertex;
vPosition = Position;
vNormal = Normal;
vColor = Color;
}

441
src/Main.hs
View File

@ -1,19 +1,15 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns, DoAndIfThenElse #-}
module Main where
-- Monad-foo and higher functional stuff
import Control.Applicative
import Control.Monad (unless, void, when, join)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Control.Arrow ((***))
-- data consistency/conversion
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM (TQueue, atomically,
newTQueueIO,
tryReadTQueue,
writeTQueue, isEmptyTQueue,
STM)
import Control.Concurrent.STM (TQueue,
newTQueueIO)
import Control.Monad.RWS.Strict (RWST, ask, asks,
evalRWST, get, liftIO,
modify, put)
@ -24,152 +20,135 @@ import Foreign (Ptr, castPtr, with)
import Foreign.C (CFloat)
-- Math
import Control.Lens (transposeOf, (^.))
import Control.Lens ((^.), (.~), (%~))
import Linear as L
-- GUI
import qualified Graphics.UI.SDL as SDL (Position)
import Graphics.UI.SDL as SDL
--import Graphics.UI.SDL.TTF as TTF
--import Graphics.UI.SDL.TTF.Types
-- Render
import qualified Graphics.Rendering.OpenGL.GL as GL
import Graphics.Rendering.OpenGL.Raw.Core31
import Data.Time (getCurrentTime, UTCTime, diffUTCTime)
import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
-- Our modules
import Map.Graphics
import Render.Misc (checkError,
createFrustum, getCam,
lookAt, up, curb)
curb)
import Render.Render (initRendering,
initShader)
import UI.Callbacks
import Types
import qualified Debug.Trace as D (trace)
data ArrowKeyState = ArrowKeyState {
arrowUp :: !Bool
,arrowDown :: !Bool
,arrowLeft :: !Bool
,arrowRight :: !Bool
}
--Static Read-Only-State
data Env = Env
{ envEventsChan :: TQueue Event
, envWindow :: !Window
, envZDistClosest :: !Double
, envZDistFarthest :: !Double
--, envGLContext :: !GLContext
}
--Mutable State
data State = State
{ stateWindowWidth :: !Int
, stateWindowHeight :: !Int
, stateWinClose :: !Bool
, stateClock :: !UTCTime
--- IO
, stateXAngle :: !Double
, stateYAngle :: !Double
, stateZDist :: !Double
, stateMouseDown :: !Bool
, stateDragging :: !Bool
, stateDragStartX :: !Double
, stateDragStartY :: !Double
, stateDragStartXAngle :: !Double
, stateDragStartYAngle :: !Double
, statePositionX :: !Double
, statePositionY :: !Double
, stateCursorPosX :: !Double
, stateCursorPosY :: !Double
, stateArrowsPressed :: !ArrowKeyState
, stateFrustum :: !(M44 CFloat)
--- pointer to bindings for locations inside the compiled shader
--- mutable because shaders may be changed in the future.
, shdrVertexIndex :: !GL.AttribLocation
, shdrColorIndex :: !GL.AttribLocation
, shdrNormalIndex :: !GL.AttribLocation
, shdrProjMatIndex :: !GL.UniformLocation
, shdrViewMatIndex :: !GL.UniformLocation
, shdrModelMatIndex :: !GL.UniformLocation
, shdrNormalMatIndex :: !GL.UniformLocation
--- the map
, stateMap :: !GL.BufferObject
, mapVert :: !GL.NumArrayIndices
}
type Pioneers = RWST Env () State IO
--------------------------------------------------------------------------------
main :: IO ()
main = do
SDL.withInit [InitVideo, InitAudio] $ do --also: InitNoParachute -> faster, without parachute!
SDL.withWindow "Pioneers" (Position 1500 100) (Size 1024 768) [WindowOpengl -- we want openGL
SDL.withWindow "Pioneers" (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
--,WindowInputGrabbed-- never let go of input (KB/Mouse)
,WindowInputGrabbed-- never let go of input (KB/Mouse)
] $ \window -> do
withOpenGL window $ do
--TTF.withInit $ do
(Size fbWidth fbHeight) <- glGetDrawableSize window
initRendering
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, ni, vi, pri, vii, mi, nmi) <- initShader
(ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initShader
putStrLn "foo"
eventQueue <- newTQueueIO :: IO (TQueue Event)
putStrLn "foo"
now <- getCurrentTime
putStrLn "foo"
--font <- TTF.openFont "fonts/ttf-04B_03B_/04B_03B_.TTF" 10
--TTF.setFontStyle font TTFNormal
--TTF.setFontHinting font TTFHNormal
let zDistClosest = 10
zDistFarthest = zDistClosest + 20
let zDistClosest = 1
zDistFarthest = zDistClosest + 30
--TODO: Move near/far/fov to state for runtime-changability & central storage
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio
aks = ArrowKeyState {
arrowUp = False
,arrowDown = False
,arrowLeft = False
,arrowRight = False
_up = False
, _down = False
, _left = False
, _right = False
}
glMap = GLMapState
{ _shdrVertexIndex = vi
, _shdrNormalIndex = ni
, _shdrColorIndex = ci
, _shdrProjMatIndex = pri
, _shdrViewMatIndex = vii
, _shdrModelMatIndex = mi
, _shdrNormalMatIndex = nmi
, _shdrTessInnerIndex = tli
, _shdrTessOuterIndex = tlo
, _stateTessellationFactor = 4
, _stateMap = mapBuffer
, _mapVert = vert
}
env = Env
{ envEventsChan = eventQueue
, envWindow = window
, envZDistClosest = zDistClosest
, envZDistFarthest = zDistFarthest
{ _eventsChan = eventQueue
, _windowObject = window
, _zDistClosest = zDistClosest
, _zDistFarthest = zDistFarthest
--, envFont = font
}
state = State
{ stateWindowWidth = fbWidth
, stateWindowHeight = fbHeight
, stateXAngle = pi/6
, stateYAngle = pi/2
, stateZDist = 10
, statePositionX = 5
, statePositionY = 5
, stateCursorPosX = 0
, stateCursorPosY = 0
, stateMouseDown = False
, stateDragging = False
, stateDragStartX = 0
, stateDragStartY = 0
, stateDragStartXAngle = 0
, stateDragStartYAngle = 0
, shdrVertexIndex = vi
, shdrNormalIndex = ni
, shdrColorIndex = ci
, shdrProjMatIndex = pri
, shdrViewMatIndex = vii
, shdrModelMatIndex = mi
, shdrNormalMatIndex = nmi
, stateMap = mapBuffer
, mapVert = vert
, stateFrustum = frust
, stateWinClose = False
, stateClock = now
, stateArrowsPressed = aks
{ _window = WindowState
{ _width = fbWidth
, _height = fbHeight
, _shouldClose = False
}
, _camera = CameraState
{ _xAngle = pi/6
, _yAngle = pi/2
, _zDist = 10
, _frustum = frust
, _camPosition = Types.Position
{ Types._x = 5
, Types._y = 5
}
}
, _io = IOState
{ _clock = now
}
, _mouse = MouseState
{ _isDown = False
, _isDragging = False
, _dragStartX = 0
, _dragStartY = 0
, _dragStartXAngle = 0
, _dragStartYAngle = 0
, _mousePosition = Types.Position
{ Types._x = 5
, Types._y = 5
}
}
, _keyboard = KeyboardState
{ _arrowsPressed = aks
}
, _gl = GLState
{ _glMap = glMap
}
, _game = GameState
{
}
}
putStrLn "init done."
@ -181,48 +160,53 @@ main = do
draw :: Pioneers ()
draw = do
env <- ask
state <- get
let xa = stateXAngle state
ya = stateYAngle state
(GL.UniformLocation proj) = shdrProjMatIndex state
(GL.UniformLocation nmat) = shdrNormalMatIndex state
(GL.UniformLocation vmat) = shdrViewMatIndex state
vi = shdrVertexIndex state
ni = shdrNormalIndex state
ci = shdrColorIndex state
numVert = mapVert state
map' = stateMap state
frust = stateFrustum state
camX = statePositionX state
camY = statePositionY state
zDist = stateZDist state
let xa = state ^. camera.xAngle
ya = state ^. camera.yAngle
(GL.UniformLocation proj) = state ^. gl.glMap.shdrProjMatIndex
(GL.UniformLocation nmat) = state ^. gl.glMap.shdrNormalMatIndex
(GL.UniformLocation vmat) = state ^. gl.glMap.shdrViewMatIndex
(GL.UniformLocation tli) = state ^. gl.glMap.shdrTessInnerIndex
(GL.UniformLocation tlo) = state ^. gl.glMap.shdrTessOuterIndex
vi = state ^. gl.glMap.shdrVertexIndex
ni = state ^. gl.glMap.shdrNormalIndex
ci = state ^. gl.glMap.shdrColorIndex
numVert = state ^. gl.glMap.mapVert
map' = state ^. gl.glMap.stateMap
frust = state ^. camera.frustum
camX = state ^. camera.camPosition.x
camY = state ^. camera.camPosition.y
zDist' = state ^. camera.zDist
tessFac = state ^. gl.glMap.stateTessellationFactor
liftIO $ do
--(vi,GL.UniformLocation proj) <- initShader
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
checkError "foo"
--set up projection (= copy from state)
with (distribute $ frust) $ \ptr ->
with (distribute frust) $ \ptr ->
glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
checkError "foo"
--set up camera
let ! cam = getCam (camX,camY) zDist xa ya
with (distribute $ cam) $ \ptr ->
let ! cam = getCam (camX,camY) zDist' xa ya
with (distribute cam) $ \ptr ->
glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
checkError "foo"
--set up normal--Mat transpose((model*camera)^-1)
let normal = (case inv33 ((fmap (^._xyz) cam) ^. _xyz) of
let normal = (case inv33 (fmap (^. _xyz) cam ^. _xyz) of
(Just a) -> a
Nothing -> eye3) :: M33 CFloat
nmap = (collect (fmap id) normal) :: M33 CFloat --transpose...
nmap = collect id normal :: M33 CFloat --transpose...
with (distribute $ nmap) $ \ptr ->
with (distribute nmap) $ \ptr ->
glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat)))
checkError "nmat"
glUniform1f tli (fromIntegral tessFac)
glUniform1f tlo (fromIntegral tessFac)
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex
GL.vertexAttribArray ci GL.$= GL.Enabled
@ -232,7 +216,10 @@ draw = do
GL.vertexAttribArray vi GL.$= GL.Enabled
checkError "beforeDraw"
GL.drawArrays GL.Triangles 0 numVert
glPatchParameteri gl_PATCH_VERTICES 3
glPolygonMode gl_FRONT gl_LINE
glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
checkError "draw"
@ -240,12 +227,11 @@ draw = do
run :: Pioneers ()
run = do
win <- asks envWindow
env <- ask
-- draw Scene
draw
liftIO $ do
glSwapWindow win
liftIO $ glSwapWindow (env ^. windowObject)
-- getEvents & process
processEvents
@ -253,15 +239,15 @@ run = do
state <- get
-- change in camera-angle
when (stateDragging state) $ do
let sodx = stateDragStartX state
sody = stateDragStartY state
sodxa = stateDragStartXAngle state
sodya = stateDragStartYAngle state
x = stateCursorPosX state
y = stateCursorPosY state
let myrot = (x - sodx) / 2
mxrot = (y - sody) / 2
when (state ^. mouse.isDragging) $ do
let sodx = state ^. mouse.dragStartX
sody = state ^. mouse.dragStartY
sodxa = state ^. mouse.dragStartXAngle
sodya = state ^. mouse.dragStartYAngle
x' = state ^. mouse.mousePosition.x
y' = state ^. mouse.mousePosition.y
myrot = (x' - sodx) / 2
mxrot = (y' - sody) / 2
newXAngle = curb (pi/12) (0.45*pi) newXAngle'
newXAngle' = sodxa + mxrot/100
newYAngle
@ -269,25 +255,22 @@ run = do
| newYAngle' < (-pi) = newYAngle' + 2 * pi
| otherwise = newYAngle'
newYAngle' = sodya + myrot/100
put $ state
{ stateXAngle = newXAngle
, stateYAngle = newYAngle
}
modify $ ((camera.xAngle) .~ newXAngle)
. ((camera.yAngle) .~ newYAngle)
-- get cursor-keys - if pressed
--TODO: Add sin/cos from stateYAngle
(kxrot, kyrot) <- fmap ((join (***)) fromIntegral) getArrowMovement
modify $ \s ->
(kxrot, kyrot) <- fmap (join (***) fromIntegral) getArrowMovement
let
multc = cos $ stateYAngle s
mults = sin $ stateYAngle s
in
s {
statePositionX = statePositionX s - 0.2 * kxrot * multc
multc = cos $ state ^. camera.yAngle
mults = sin $ state ^. camera.yAngle
modx x' = x' - 0.2 * kxrot * multc
- 0.2 * kyrot * mults
, statePositionY = statePositionY s + 0.2 * kxrot * mults
mody y' = y' - 0.2 * kxrot * mults
- 0.2 * kyrot * multc
}
modify $ (camera.camPosition.x %~ modx)
. (camera.camPosition.y %~ mody)
{-
--modify the state with all that happened in mt time.
@ -296,47 +279,45 @@ run = do
{
}
-}
mt <- liftIO $ do
now <- getCurrentTime
diff <- return $ diffUTCTime now (stateClock state) -- get time-diffs
diff <- return $ diffUTCTime now (state ^. io.clock) -- get time-diffs
title <- return $ unwords ["Pioneers @ ",show ((round .fromRational.toRational $ 1.0/diff)::Int),"fps"]
setWindowTitle (env ^. windowObject) title
sleepAmount <- return $ floor (max 0 (0.04 - diff))*1000000 -- get time until next frame in microseconds
threadDelay sleepAmount
return now
-- set state with new clock-time
modify $ \s -> s
{
stateClock = mt
}
shouldClose <- return $ stateWinClose state
modify $ io.clock .~ mt
shouldClose <- return $ state ^. window.shouldClose
unless shouldClose run
getArrowMovement :: Pioneers (Int, Int)
getArrowMovement = do
state <- get
aks <- return $ stateArrowsPressed state
aks <- return $ state ^. (keyboard.arrowsPressed)
let
horz = left' + right'
vert = up'+down'
left' = if arrowLeft aks then -1 else 0
right' = if arrowRight aks then 1 else 0
up' = if arrowUp aks then -1 else 0
down' = if arrowDown aks then 1 else 0
left' = if aks ^. left then -1 else 0
right' = if aks ^. right then 1 else 0
up' = if aks ^. up then -1 else 0
down' = if aks ^. down then 1 else 0
return (horz,vert)
adjustWindow :: Pioneers ()
adjustWindow = do
state <- get
let fbWidth = stateWindowWidth state
fbHeight = stateWindowHeight state
let fbWidth = state ^. window.width
fbHeight = state ^. window.height
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
ratio = fromIntegral fbWidth / fromIntegral fbHeight
frust = createFrustum fov near far ratio
liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
put $ state {
stateFrustum = frust
}
modify $ camera.frustum .~ frust
processEvents :: Pioneers ()
@ -350,74 +331,78 @@ processEvents = do
processEvent :: Event -> Pioneers ()
processEvent e = do
return ()
case eventData e of
Window _ winEvent ->
case winEvent of
Closing -> modify $ \s -> s {
stateWinClose = True
}
_ -> return ()
Keyboard movement _ repeat key -> --up/down window(ignored) true/false actualKey
Closing ->
modify $ window.shouldClose .~ True
Resized {windowResizedTo=size} -> do
modify $ (window.width .~ (sizeWidth size))
. (window.height .~ (sizeHeight size))
adjustWindow
SizeChanged ->
adjustWindow
_ ->
return ()
--liftIO $ putStrLn $ unwords ["Unhandled Window-Event:",show e]
Keyboard movement _ isRepeated key -> --up/down window(ignored) true/false actualKey
-- need modifiers? use "keyModifiers key" to get them
let aks = keyboard.arrowsPressed in
case keyScancode key of
Escape -> modify $ \s -> s {
stateWinClose = True
}
SDL.Left -> modify $ \s -> s {
stateArrowsPressed = (stateArrowsPressed s) {
arrowLeft = movement == KeyDown
}
}
SDL.Right -> modify $ \s -> s {
stateArrowsPressed = (stateArrowsPressed s) {
arrowRight = movement == KeyDown
}
}
SDL.Up -> modify $ \s -> s {
stateArrowsPressed = (stateArrowsPressed s) {
arrowUp = movement == KeyDown
}
}
SDL.Down -> modify $ \s -> s {
stateArrowsPressed = (stateArrowsPressed s) {
arrowDown = movement == KeyDown
}
}
_ -> return ()
MouseMotion _ id st (Position x y) xrel yrel -> do
Escape ->
modify $ window.shouldClose .~ True
SDL.Left ->
modify $ aks.left .~ (movement == KeyDown)
SDL.Right ->
modify $ aks.right .~ (movement == KeyDown)
SDL.Up ->
modify $ aks.up .~ (movement == KeyDown)
SDL.Down ->
modify $ aks.down .~ (movement == KeyDown)
SDL.KeypadPlus ->
when (movement == KeyDown) $ do
modify $ (gl.glMap.stateTessellationFactor) %~ ((min 5) . (+1))
state <- get
when (stateMouseDown state && not (stateDragging state)) $
put $ state
{ stateDragging = True
, stateDragStartX = fromIntegral x
, stateDragStartY = fromIntegral y
, stateDragStartXAngle = stateXAngle state
, stateDragStartYAngle = stateYAngle state
}
modify $ \s -> s {
stateCursorPosX = fromIntegral x
, stateCursorPosY = fromIntegral y
}
MouseButton _ id button state (Position x y) ->
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
SDL.KeypadMinus ->
when (movement == KeyDown) $ do
modify $ (gl.glMap.stateTessellationFactor) %~ ((max 1) . (+(-1)))
state <- get
liftIO $ putStrLn $ unwords ["Tessellation at: ", show $ state ^. gl.glMap.stateTessellationFactor]
_ ->
return ()
MouseMotion _ mouseId st (SDL.Position x y) xrel yrel -> do
state <- get
when (state ^. mouse.isDown && not (state ^. mouse.isDragging)) $
modify $ (mouse.isDragging .~ True)
. (mouse.dragStartX .~ (fromIntegral x))
. (mouse.dragStartY .~ (fromIntegral y))
. (mouse.dragStartXAngle .~ (state ^. camera.xAngle))
. (mouse.dragStartYAngle .~ (state ^. camera.yAngle))
modify $ (mouse.mousePosition. Types.x .~ (fromIntegral x))
. (mouse.mousePosition. Types.y .~ (fromIntegral y))
MouseButton _ mouseId button state (SDL.Position x y) ->
case button of
LeftButton -> do
let pressed = state == Pressed
modify $ \s -> s
{ stateMouseDown = pressed
}
unless pressed $
modify $ \s -> s
{ stateDragging = False
}
_ -> return ()
MouseWheel _ id hscroll vscroll -> do
modify $ mouse.isDown .~ pressed
unless pressed $ do
st <- get
if st ^. mouse.isDragging then
modify $ mouse.isDragging .~ False
else
clickHandler (UI.Callbacks.Pixel x y)
RightButton -> do
when (state == Released) $ alternateClickHandler (UI.Callbacks.Pixel x y)
_ ->
return ()
MouseWheel _ mouseId hscroll vscroll -> do
env <- ask
modify $ \s -> s
{ stateZDist =
let zDist' = stateZDist s + realToFrac (negate $ vscroll)
in curb (envZDistClosest env) (envZDistFarthest env) zDist'
}
Quit -> modify $ \s -> s {stateWinClose = True}
state <- get
let zDist' = (state ^. camera.zDist) + realToFrac (negate vscroll) in
modify $ camera.zDist .~ (curb (env ^. zDistClosest) (env ^. zDistFarthest) zDist')
Quit -> modify $ window.shouldClose .~ True
-- there is more (joystic, touchInterface, ...), but currently ignored
_ -> return ()
liftIO $ putStrLn $ unwords ["Processing Event:",(show e)]
_ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e]

5
src/Map/Graphics.hs
View File

@ -79,6 +79,11 @@ getMapBufferObject = do
checkError "initBuffer"
return (bo,len)
prettyMap :: [GLfloat] -> [(GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat,GLfloat)]
prettyMap (a:b:c:d:x:y:z:u:v:w:ms) = (a,b,c,d,x,y,z,u,v,w):(prettyMap ms)
prettyMap _ = []
--generateTriangles :: PlayMap -> [GLfloat]
generateTriangles :: GraphicsMap -> [GLfloat]
generateTriangles map' =
let ((xl,yl),(xh,yh)) = bounds map' in

6
src/Render/Misc.hs
View File

@ -1,10 +1,8 @@
{-# LANGUAGE ForeignFunctionInterface #-}
module Render.Misc where
import Control.Monad
import qualified Data.ByteString as B (ByteString)
import Foreign.Marshal.Array (allocaArray,
pokeArray)
import Foreign.C (CFloat)
import Graphics.Rendering.OpenGL.GL.Shaders
import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.StringQueries
@ -12,7 +10,7 @@ import Graphics.Rendering.OpenGL.GLU.Errors
import Graphics.Rendering.OpenGL.Raw.Core31
import System.IO (hPutStrLn, stderr)
import Linear
import Foreign.C (CFloat)
up :: V3 CFloat
up = V3 0 1 0

37
src/Render/Render.hs
View File

@ -18,6 +18,10 @@ import Render.Misc
vertexShaderFile :: String
vertexShaderFile = "shaders/vertex.shader"
tessControlShaderFile :: String
tessControlShaderFile = "shaders/tessControl.shader"
tessEvalShaderFile :: String
tessEvalShaderFile = "shaders/tessEval.shader"
fragmentShaderFile :: String
fragmentShaderFile = "shaders/fragment.shader"
@ -42,40 +46,55 @@ initShader :: IO (
, UniformLocation -- ^ ViewMat
, UniformLocation -- ^ ModelMat
, UniformLocation -- ^ NormalMat
, UniformLocation -- ^ TessLevelInner
, UniformLocation -- ^ TessLevelOuter
)
initShader = do
! vertexSource <- B.readFile vertexShaderFile
! tessControlSource <- B.readFile tessControlShaderFile
! tessEvalSource <- B.readFile tessEvalShaderFile
! fragmentSource <- B.readFile fragmentShaderFile
vertexShader <- compileShaderSource VertexShader vertexSource
checkError "compile Vertex"
tessControlShader <- compileShaderSource TessControlShader tessControlSource
checkError "compile Vertex"
tessEvalShader <- compileShaderSource TessEvaluationShader tessEvalSource
checkError "compile Vertex"
fragmentShader <- compileShaderSource FragmentShader fragmentSource
checkError "compile Frag"
program <- createProgramUsing [vertexShader, fragmentShader]
program <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShader]
checkError "compile Program"
currentProgram $= Just program
projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
projectionMatrixIndex <- get (uniformLocation program "ProjectionMatrix")
checkError "projMat"
viewMatrixIndex <- get (uniformLocation program "fg_ViewMatrix")
viewMatrixIndex <- get (uniformLocation program "ViewMatrix")
checkError "viewMat"
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
modelMatrixIndex <- get (uniformLocation program "ModelMatrix")
checkError "modelMat"
normalMatrixIndex <- get (uniformLocation program "fg_NormalMatrix")
normalMatrixIndex <- get (uniformLocation program "NormalMatrix")
checkError "normalMat"
vertexIndex <- get (attribLocation program "fg_VertexIn")
tessLevelInner <- get (uniformLocation program "TessLevelInner")
checkError "TessLevelInner"
tessLevelOuter <- get (uniformLocation program "TessLevelOuter")
checkError "TessLevelOuter"
vertexIndex <- get (attribLocation program "Position")
vertexAttribArray vertexIndex $= Enabled
checkError "vertexInd"
normalIndex <- get (attribLocation program "fg_NormalIn")
normalIndex <- get (attribLocation program "Normal")
vertexAttribArray normalIndex $= Enabled
checkError "normalInd"
colorIndex <- get (attribLocation program "fg_Color")
colorIndex <- get (attribLocation program "Color")
vertexAttribArray colorIndex $= Enabled
checkError "colorInd"
@ -85,7 +104,7 @@ initShader = do
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex)
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
initRendering :: IO ()
initRendering = do

118
src/Types.hs Normal file
View File

@ -0,0 +1,118 @@
{-# LANGUAGE TemplateHaskell #-}
module Types where
import Control.Concurrent.STM (TQueue)
import qualified Graphics.Rendering.OpenGL.GL as GL
import Graphics.UI.SDL as SDL (Event, Window)
import Foreign.C (CFloat)
import Data.Time (UTCTime)
import Linear.Matrix (M44)
import Control.Monad.RWS.Strict (RWST)
import Control.Lens
import Data.Label
--Static Read-Only-State
data Env = Env
{ _eventsChan :: TQueue Event
, _windowObject :: !Window
, _zDistClosest :: !Double
, _zDistFarthest :: !Double
--, envGLContext :: !GLContext
--, envFont :: TTF.TTFFont
}
--Mutable State
data Position = Position
{ _x :: !Double
, _y :: !Double
}
data WindowState = WindowState
{ _width :: !Int
, _height :: !Int
, _shouldClose :: !Bool
}
data CameraState = CameraState
{ _xAngle :: !Double
, _yAngle :: !Double
, _zDist :: !Double
, _frustum :: !(M44 CFloat)
, _camPosition :: !Position --TODO: Get rid of cam-prefix
}
data IOState = IOState
{ _clock :: !UTCTime
}
data GameState = GameState
{
}
data MouseState = MouseState
{ _isDown :: !Bool
, _isDragging :: !Bool
, _dragStartX :: !Double
, _dragStartY :: !Double
, _dragStartXAngle :: !Double
, _dragStartYAngle :: !Double
, _mousePosition :: !Position --TODO: Get rid of mouse-prefix
}
data ArrowKeyState = ArrowKeyState {
_up :: !Bool
,_down :: !Bool
,_left :: !Bool
,_right :: !Bool
}
data KeyboardState = KeyboardState
{ _arrowsPressed :: !ArrowKeyState
}
data GLMapState = GLMapState
{ _shdrVertexIndex :: !GL.AttribLocation
, _shdrColorIndex :: !GL.AttribLocation
, _shdrNormalIndex :: !GL.AttribLocation
, _shdrProjMatIndex :: !GL.UniformLocation
, _shdrViewMatIndex :: !GL.UniformLocation
, _shdrModelMatIndex :: !GL.UniformLocation
, _shdrNormalMatIndex :: !GL.UniformLocation
, _shdrTessInnerIndex :: !GL.UniformLocation
, _shdrTessOuterIndex :: !GL.UniformLocation
, _stateTessellationFactor :: !Int
, _stateMap :: !GL.BufferObject
, _mapVert :: !GL.NumArrayIndices
}
data GLState = GLState
{ _glMap :: !GLMapState
}
data State = State
{ _window :: !WindowState
, _camera :: !CameraState
, _io :: !IOState
, _mouse :: !MouseState
, _keyboard :: !KeyboardState
, _gl :: !GLState
, _game :: !GameState
}
$(makeLenses ''State)
$(makeLenses ''GLState)
$(makeLenses ''GLMapState)
$(makeLenses ''KeyboardState)
$(makeLenses ''ArrowKeyState)
$(makeLenses ''MouseState)
$(makeLenses ''GameState)
$(makeLenses ''IOState)
$(makeLenses ''CameraState)
$(makeLenses ''WindowState)
$(makeLenses ''Position)
$(makeLenses ''Env)
type Pioneers = RWST Env () State IO

20
src/UI/Callbacks.hs Normal file
View File

@ -0,0 +1,20 @@
module UI.Callbacks where
import Control.Monad.Trans (liftIO)
import Types
data Pixel = Pixel Int Int
-- | Handler for UI-Inputs.
-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
clickHandler :: Pixel -> Pioneers ()
clickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"]
-- | Handler for UI-Inputs.
-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ...
alternateClickHandler :: Pixel -> Pioneers ()
alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"]
--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
--TODO: Maybe queues are better?