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:
Stefan Dresselhaus
2014-03-05 15:02:30 +01:00
parent d3e450c7b0 5a70a22da6
commit e6c6442c85
17 changed files with 987 additions and 298 deletions
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 executable Pioneers
hs-source-dirs: src 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: other-modules:
Map.Types, Map.Types,
Map.Graphics, Map.Graphics,
@@ -14,7 +14,9 @@ executable Pioneers
Map.StaticMaps, Map.StaticMaps,
Render.Misc, Render.Misc,
Render.Render, Render.Render,
Render.RenderObject Render.RenderObject,
UI.Callbacks,
Types
main-is: Main.hs main-is: Main.hs
build-depends: build-depends:
base >=4.6, base >=4.6,
@@ -32,5 +34,6 @@ executable Pioneers
linear >=1.3.1 && <1.4, linear >=1.3.1 && <1.4,
lens >=3.10.1 && <3.11, lens >=3.10.1 && <3.11,
SDL2 >= 0.1.0, 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 #hack until saucy has 2.0.1 instead of 2.0.0
sudo apt-get install dialog if [ "$1" != "ni" ]
then
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 sudo apt-get install dialog
install=${?} 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 ]] if [[ $install -eq 0 ]]
then then
@@ -14,20 +18,45 @@ then
if [ ! -f "libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] if [ ! -f "libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-2.0-0_2.0.1+dfsg1-1ubuntu1_amd64.deb 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 fi
if [ ! -f "libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] if [ ! -f "libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dev_2.0.1+dfsg1-1ubuntu1_amd64.deb 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 fi
if [ ! -f "libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb" ] if [ ! -f "libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb" ]
then then
wget http://de.archive.ubuntu.com/ubuntu/pool/universe/libs/libsdl2/libsdl2-dbg_2.0.1+dfsg1-1ubuntu1_amd64.deb 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 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 fi
## hack end ## hack end
echo "cloning repositories" echo "cloning repositories"
@@ -40,7 +69,19 @@ else
cd .. cd ..
fi 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" echo "trying to build"
cabal install haddock
for d in `find . -maxdepth 1 -type d` for d in `find . -maxdepth 1 -type d`
do do
if [ "$d" == "." ] if [ "$d" == "." ]
@@ -53,7 +94,7 @@ do
cabal configure cabal configure
cabal build cabal build
cabal haddock --hyperlink-source cabal haddock --hyperlink-source
cabal install cabal install --force-reinstalls
cd .. cd ..
fi fi
done 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 //#include "3rdParty/noise.glsl"
smooth in vec4 fg_SmoothColor;
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) void main(void)
{ {
//copy-shader //heliospheric lighting
fg_FragColor = fg_SmoothColor; 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 #version 400
//constant projection matrix
uniform mat4 fg_ProjectionMatrix;
uniform mat4 fg_ViewMatrix;
uniform mat3 fg_NormalMatrix;
//vertex-data //vertex-data
in vec4 fg_Color; in vec4 Color;
in vec3 fg_VertexIn; in vec3 Position;
in vec3 fg_NormalIn; in vec3 Normal;
//output-data for later stages //output-data for later stages
smooth out vec4 fg_SmoothColor; out vec4 vColor;
out vec3 vPosition;
out vec3 vNormal;
void main() void main()
{ {
vec3 fg_Normal = fg_NormalMatrix * fg_NormalIn; //vec3(0,1,0); vPosition = Position;
//transform vec3 into vec4, setting w to 1 vNormal = Normal;
vec4 fg_Vertex = vec4(fg_VertexIn, 1.0); vColor = Color;
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;
} }

441
src/Main.hs
View File

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

5
src/Map/Graphics.hs
View File

@@ -79,6 +79,11 @@ getMapBufferObject = do
checkError "initBuffer" checkError "initBuffer"
return (bo,len) 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 :: GraphicsMap -> [GLfloat]
generateTriangles map' = generateTriangles map' =
let ((xl,yl),(xh,yh)) = bounds map' in 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 module Render.Misc where
import Control.Monad import Control.Monad
import qualified Data.ByteString as B (ByteString) 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.Shaders
import Graphics.Rendering.OpenGL.GL.StateVar import Graphics.Rendering.OpenGL.GL.StateVar
import Graphics.Rendering.OpenGL.GL.StringQueries import Graphics.Rendering.OpenGL.GL.StringQueries
@@ -12,7 +10,7 @@ import Graphics.Rendering.OpenGL.GLU.Errors
import Graphics.Rendering.OpenGL.Raw.Core31 import Graphics.Rendering.OpenGL.Raw.Core31
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import Linear import Linear
import Foreign.C (CFloat)
up :: V3 CFloat up :: V3 CFloat
up = V3 0 1 0 up = V3 0 1 0

37
src/Render/Render.hs
View File

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