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

it works...

Browse Source
This commit is contained in:
Stefan Dresselhaus
2014-01-04 16:55:59 +01:00
parent cde5231e6a
commit 602b20eb6c
5 changed files with 80 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
Pioneers.cabal
View File

@@ -26,5 +26,8 @@ executable Pioneers
transformers >=0.3.0 && <0.4,
mtl >=2.1.2,
stm >=2.4.2,
vector >=0.10.9 && <0.11
vector >=0.10.9 && <0.11,
distributive >=0.3.2 && <0.4,
linear >=1.3.1 && <1.4,
lens >=3.10.1 && <3.11

15
shaders/vertex.shader
View File

@@ -7,16 +7,25 @@ uniform mat4 fg_ModelMatrix;
//vertex-data
in vec4 fg_Color;
in vec3 fg_VertexIn;
//in vec3 fg_Normal;
in vec3 fg_NormalIn;
//output-data for later stages
smooth out vec4 fg_SmoothColor;
void main()
{
vec3 fg_Normal = fg_NormalIn; //vec3(0,1,0);
//transform vec3 into vec4, setting w to 1
vec4 fg_Vertex = vec4(fg_VertexIn, 1.0);
fg_SmoothColor = fg_Color;
// + 0.001* fg_Normal.xyzx;
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(vec3(5.0,5.0,1.0));
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_ModelMatrix * fg_Vertex;
}

58
src/Main.hs
View File

@@ -2,13 +2,20 @@ module Main (main) where
--------------------------------------------------------------------------------
import Control.Applicative
import Control.Concurrent.STM (TQueue, atomically, newTQueueIO, tryReadTQueue, writeTQueue)
import Control.Lens
import Control.Monad (unless, when, void)
import Control.Monad.RWS.Strict (RWST, ask, asks, evalRWST, get, liftIO, modify, put)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Text.PrettyPrint
import Data.Distributive (distribute)
import Foreign (Ptr, castPtr, nullPtr, sizeOf, with)
import Foreign.C (CFloat)
import Linear as L
import Linear ((!*!))
import qualified Graphics.Rendering.OpenGL.GL as GL
import qualified Graphics.Rendering.OpenGL.Raw as GL
@@ -17,7 +24,7 @@ import qualified Data.Vector.Storable as V
import Map.Map
import Render.Render (initShader)
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum)
import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum, checkError)
--------------------------------------------------------------------------------
@@ -48,6 +55,7 @@ data State = State
-- mutable because shaders may be changed in the future.
, shdrVertexIndex :: !GL.AttribLocation
, shdrColorIndex :: !GL.AttribLocation
, shdrNormalIndex :: !GL.AttribLocation
, shdrProjMatIndex :: !GL.UniformLocation
, shdrModelMatIndex :: !GL.UniformLocation
-- the map
@@ -107,11 +115,10 @@ main = do
--generate map vertices
(mapBuffer, vert) <- getMapBufferObject
(ci, vi, pi, mi) <- initShader
(ci, ni, vi, pi, mi) <- initShader
let zDistClosest = 10
zDistFarthest = zDistClosest + 20
zDist = zDistClosest + ((zDistFarthest - zDistClosest) / 2)
fov = 90 --field of view
near = 1 --near plane
far = 100 --far plane
@@ -137,6 +144,7 @@ main = do
, stateDragStartXAngle = 0
, stateDragStartYAngle = 0
, shdrVertexIndex = vi
, shdrNormalIndex = ni
, shdrColorIndex = ci
, shdrProjMatIndex = pi
, shdrModelMatIndex = mi
@@ -210,8 +218,7 @@ charCallback tc win c = atomically $ writeTQueue tc $ EventC
--------------------------------------------------------------------------------
runDemo :: Env -> State -> IO ()
runDemo env state = do
void $ evalRWST (adjustWindow >> run) env state
runDemo env state = void $ evalRWST (adjustWindow >> run) env state
run :: Pioneer ()
run = do
@@ -382,6 +389,7 @@ draw = do
(GL.UniformLocation proj) = shdrProjMatIndex state
(GL.UniformLocation mmat) = shdrModelMatIndex state
vi = shdrVertexIndex state
ni = shdrNormalIndex state
ci = shdrColorIndex state
numVert = mapVert state
map' = stateMap state
@@ -389,27 +397,39 @@ draw = do
liftIO $ do
--(vi,GL.UniformLocation proj) <- initShader
GL.clearColor GL.$= GL.Color4 0.5 0.1 1 1
GL.clear [GL.ColorBuffer]
GL.clear [GL.ColorBuffer, GL.DepthBuffer]
let fov = 90
s = recip (tan $ fov * 0.5 * pi / 180)
f = 1000
n = 1
let perspective = V.fromList [ s, 0, 0, 0
, 0, s, 0, 0
, 0, 0, -(f/(f - n)), -1
, 0, 0, -((f*n)/(f-n)), 0
]
V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
let model = V.fromList [
1, 0, 0, 0
, 0, 0, 1, 0
, 0, 1, 0, 0
,-5, -10, -10, 1
]
V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 1 0 ptr
let perspective = V4 (V4 s 0 0 0)
(V4 0 s 0 0)
(V4 0 0 (-(f/(f - n))) (-1))
(V4 0 0 (-((f*n)/(f-n))) 1)
!*!
V4 (V4 1 0 0 0)
(V4 0 0 1 0)
(V4 0 1 0 0)
(V4 0 0 0 1)
with (distribute $ perspective) $ \ptr ->
GL.glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
--V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
let cam = crot !*! ctrans
ctrans = (eye4 & translation .~ V3 (-5) (-10) (-10)) :: M44 CFloat
crot = (m33_to_m44 $
(fromQuaternion $
axisAngle (V3 1 0 0) (pi/4))
!*!
(fromQuaternion $
axisAngle (V3 0 1 0) (pi/16))
) :: M44 CFloat
--V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 1 0 ptr
with (distribute $ cam) $ \ptr ->
GL.glUniformMatrix4fv mmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
GL.vertexAttribPointer ci GL.$= fgColorIndex
GL.vertexAttribPointer ni GL.$= fgNormalIndex
GL.vertexAttribPointer vi GL.$= fgVertexIndex
GL.drawArrays GL.Triangles 0 numVert

25
src/Map/Map.hs
View File

@@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Map.Map
(
@@ -47,7 +47,7 @@ lineHeight :: GLfloat
lineHeight = 0.8660254
numComponents :: Int
numComponents = 7
numComponents = 10
mapStride :: Stride
mapStride = fromIntegral (sizeOf (0.0 :: GLfloat) * numComponents)
@@ -60,18 +60,18 @@ mapVertexArrayDescriptor count' offset =
VertexArrayDescriptor count' Float mapStride (bufferObjectPtr ((fromIntegral offset)*sizeOf (0 :: GLfloat)) ) --(fromIntegral numComponents * offset))
fgColorIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 3) --color first
fgColorIndex = (ToFloat, mapVertexArrayDescriptor 4 0) --color first
fgNormalIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor GLfloat)
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 0) --vertex after normal
fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
getMapBufferObject :: IO (BufferObject, NumArrayIndices)
getMapBufferObject = do
map' <- testmap
map' <- return $ P.map (*1) (generateTriangles map')
! map' <- return $ P.map (*1) (generateTriangles map')
putStrLn $ P.unlines $ P.map show (prettyMap map')
len <- return $ fromIntegral $ P.length map' `div` numComponents
putStrLn $ P.unwords ["num verts",show len]
@@ -177,9 +177,9 @@ lookupVertex map' x y =
--TODO: calculate normals correctly!
in
[
vx, vy, vz, -- 3 Vertex
cr, cg, cb, 1.0 -- RGBA Color
--nx, ny, nz, -- 3 Normal
cr, cg, cb, 1.0, -- RGBA Color
nx, ny, nz, -- 3 Normal
vx, vy, vz -- 3 Vertex
]
heightLookup :: PlayMap -> (Int,Int) -> GLfloat
@@ -233,8 +233,7 @@ testMapTemplate = T.transpose [
testMapTemplate2 :: [Text]
testMapTemplate2 = T.transpose [
"~~~~~~~~~~~~",
"~SSSSSSSSSS~"
"~~~~~~~~~~~~"
]
testmap :: IO PlayMap
@@ -243,6 +242,12 @@ testmap = do
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
return $ listArray ((0,0),(19,19)) rawMap
testmap2 :: IO PlayMap
testmap2 = do
g <- getStdGen
rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
return $ listArray ((0,0),(9,0)) rawMap
parseTemplate :: [Int] -> Text -> [MapEntry]
parseTemplate (r:rs) t =

13
src/Render/Render.hs
View File

@@ -33,7 +33,7 @@ initBuffer varray =
checkError "initBuffer"
return bufferObject
initShader :: IO (AttribLocation, AttribLocation, UniformLocation, UniformLocation)
initShader :: IO (AttribLocation, AttribLocation, AttribLocation, UniformLocation, UniformLocation)
initShader = do
! vertexSource <- B.readFile vertexShaderFile
! fragmentSource <- B.readFile fragmentShaderFile
@@ -52,20 +52,25 @@ initShader = do
modelMatrixIndex <- get (uniformLocation program "fg_ModelMatrix")
checkError "modelMat"
att <- get (activeAttribs program)
vertexIndex <- get (attribLocation program "fg_VertexIn")
vertexAttribArray vertexIndex $= Enabled
checkError "vertexInd"
normalIndex <- get (attribLocation program "fg_NormalIn")
vertexAttribArray normalIndex $= Enabled
checkError "normalInd"
colorIndex <- get (attribLocation program "fg_Color")
vertexAttribArray colorIndex $= Enabled
checkError "colorInd"
att <- get (activeAttribs program)
putStrLn $ unlines $ "Attributes: ":map show att
putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
checkError "initShader"
return (colorIndex, vertexIndex, projectionMatrixIndex, modelMatrixIndex)
return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, modelMatrixIndex)
initRendering :: IO ()
initRendering = do