From 602b20eb6c26e7f730600f7a9628db8ef744dd19 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 4 Jan 2014 16:55:59 +0100 Subject: [PATCH] it works... --- Pioneers.cabal | 5 +++- shaders/vertex.shader | 15 ++++++++--- src/Main.hs | 60 ++++++++++++++++++++++++++++--------------- src/Map/Map.hs | 25 ++++++++++-------- src/Render/Render.hs | 13 +++++++--- 5 files changed, 80 insertions(+), 38 deletions(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index af29ed0..ae5865d 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -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 diff --git a/shaders/vertex.shader b/shaders/vertex.shader index 8be5177..1e2ee66 100644 --- a/shaders/vertex.shader +++ b/shaders/vertex.shader @@ -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; } \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 3909462..aa071d7 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Map/Map.hs b/src/Map/Map.hs index fd22925..78595ab 100644 --- a/src/Map/Map.hs +++ b/src/Map/Map.hs @@ -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 = diff --git a/src/Render/Render.hs b/src/Render/Render.hs index 467d4fc..e3a7e8d 100644 --- a/src/Render/Render.hs +++ b/src/Render/Render.hs @@ -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