shaders now compile and link correctly

- map still invisible
- frustum defined
- shaders fixed
- attrib-link to shaders fixed
- lookat now generates a frustum-projected look-at matrix
- smaller test-map for debug

shaders/fragment.shader

@@ -1,4 +1,4 @@
-#version 140
+#version 330
 
 //color from earlier stages
 smooth in vec4 fg_SmoothColor;

shaders/vertex.shader

@@ -1,18 +1,20 @@
-#version 140
+#version 330
 
 //constant projection matrix
 uniform mat4 fg_ProjectionMatrix;
 
 //vertex-data
 in vec4 fg_Color;
-in vec4 fg_Vertex;
+in vec3 fg_VertexIn;
-in vec4 fg_Normal;
+in vec3 fg_Normal;
 
 //output-data for later stages
 smooth out vec4 fg_SmoothColor;
 
 void main()
 {
-   fg_SmoothColor = fg_Color;
+   //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;
    gl_Position = fg_ProjectionMatrix * fg_Vertex;
 }

src/Main.hs

@@ -15,7 +15,7 @@ import qualified Graphics.UI.GLFW          as GLFW
 
 import Map.Map
 import Render.Render (initShader)
-import Render.Misc (up, lookAtUniformMatrix4fv)
+import Render.Misc (up, lookAtUniformMatrix4fv, createFrustum)
 
 --------------------------------------------------------------------------------
 
@@ -23,8 +23,6 @@ import Render.Misc (up, lookAtUniformMatrix4fv)
 data Env = Env
     { envEventsChan    :: TQueue Event
     , envWindow        :: !GLFW.Window
-    , envMap           :: !GL.BufferObject
-    , mapVert          :: !GL.NumArrayIndices
     , envZDistClosest  :: !Double
     , envZDistFarthest :: !Double
     }
@@ -43,12 +41,16 @@ data State = State
     , stateDragStartY      :: !Double
     , stateDragStartXAngle :: !Double
     , stateDragStartYAngle :: !Double
+    , stateFrustum         :: [GL.GLfloat]
     -- pointer to bindings for locations inside the compiled shader
     -- mutable because shaders may be changed in the future.
     , shdrColorIndex       :: !GL.AttribLocation
     , shdrNormalIndex      :: !GL.AttribLocation
     , shdrVertexIndex      :: !GL.AttribLocation
     , shdrProjMatIndex     :: !GL.UniformLocation
+    -- the map
+    , stateMap             :: !GL.BufferObject
+    , mapVert              :: !GL.NumArrayIndices
     }
 
 type Pioneer = RWST Env () State IO
@@ -81,7 +83,7 @@ main = do
 
     eventsChan <- newTQueueIO :: IO (TQueue Event)
 
-    withWindow width height "GLFW-b-demo" $ \win -> do
+    withWindow width height "Pioneers" $ \win -> do
         GLFW.setErrorCallback               $ Just $ errorCallback           eventsChan
         GLFW.setWindowPosCallback       win $ Just $ windowPosCallback       eventsChan
         GLFW.setWindowSizeCallback      win $ Just $ windowSizeCallback      eventsChan
@@ -118,11 +120,14 @@ main = do
         let zDistClosest  = 10
             zDistFarthest = zDistClosest + 20
             zDist         = zDistClosest + ((zDistFarthest - zDistClosest) / 2)
+            fov           = 90  --field of view
+            near          = 1   --near plane
+            far           = 100 --far plane
+            ratio         = fromIntegral fbWidth / fromIntegral fbHeight
+            frust         = createFrustum fov near far ratio
             env = Env
               { envEventsChan    = eventsChan
               , envWindow        = win
-              , envMap           = mapBuffer
-              , mapVert          = vert
               , envZDistClosest  = zDistClosest
               , envZDistFarthest = zDistFarthest
               }
@@ -143,6 +148,9 @@ main = do
               , shdrNormalIndex      = ni
               , shdrVertexIndex      = vi
               , shdrProjMatIndex     = pi
+              , stateMap             = mapBuffer
+              , mapVert              = vert
+              , stateFrustum         = frust
               }
         runDemo env state
 
@@ -316,9 +324,9 @@ processEvent ev =
                   }
 
       (EventCursorPos _ x y) -> do
-          let x' = round x :: Int
+          {-let x' = round x :: Int
               y' = round y :: Int
-          printEvent "cursor pos" [show x', show y']
+          printEvent "cursor pos" [show x', show y']-}
           state <- get
           when (stateMouseDown state && not (stateDragging state)) $
             put $ state
@@ -395,10 +403,13 @@ draw = do
         ci = shdrColorIndex state
         ni = shdrNormalIndex state
         vi = shdrVertexIndex state
-        numVert = mapVert env
+        numVert = mapVert state
-        map' = envMap env 
+        map' = stateMap state
+        frust = stateFrustum state
     liftIO $ do
-        lookAtUniformMatrix4fv (0.0,0.0,0.0) (xa, ya, za) up proj 1
+        GL.clearColor GL.$= GL.Color4 0.5 0.2 1 1
+        GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+        lookAtUniformMatrix4fv (0.0,0.0,0.0) (15, 15, 30) up frust proj 1
         GL.bindBuffer GL.ArrayBuffer GL.$= Just map'
         GL.vertexAttribPointer ci GL.$= fgColorIndex
         GL.vertexAttribPointer ni GL.$= fgNormalIndex

src/Map/Map.hs

@@ -44,6 +44,9 @@ numComponents = 4  --color
                 +3 --normal
                 +3 --vertex
 
+mapStride :: Stride
+mapStride = fromIntegral (sizeOf (0.0 :: GLfloat)) * fromIntegral numComponents
+
 bufferObjectPtr :: Integral a => a -> Ptr b
 bufferObjectPtr = plusPtr (nullPtr :: Ptr GLchar) . fromIntegral
 
@@ -60,13 +63,11 @@ fgNormalIndex = (ToFloat, mapVertexArrayDescriptor 3 4) --normal after color
 fgVertexIndex :: (IntegerHandling, VertexArrayDescriptor a)
 fgVertexIndex = (ToFloat, mapVertexArrayDescriptor 3 7) --vertex after normal
 
-mapStride :: Stride
-mapStride = fromIntegral (sizeOf (0.0 :: GLfloat)) * fromIntegral numComponents
-
 getMapBufferObject :: IO (BufferObject, NumArrayIndices)
 getMapBufferObject = do
         map' <- testmap
         map' <- return $ generateTriangles map'
+        putStrLn $ P.unlines $ P.map show (prettyMap map')
         len <- return $ fromIntegral $ P.length map' `div` numComponents
         bo <- genObjectName                     -- create a new buffer
         bindBuffer ArrayBuffer $= Just bo       -- bind buffer
@@ -75,6 +76,9 @@ 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 map' =
@@ -176,11 +180,17 @@ testMapTemplate = T.transpose [
                 "~~~~~~~~~~~~~~~~~~~~"
                 ]
 
+testMapTemplate2 :: [Text]
+testMapTemplate2 = T.transpose [
+                "~~~~~~",
+                "~~~~~~"
+                ]
+
 testmap :: IO PlayMap
 testmap = do
                 g <- getStdGen
-                rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate)
+                rawMap <- return $ parseTemplate (randoms g) (T.concat testMapTemplate2)
-                return $ listArray ((0,0),(19,19)) rawMap
+                return $ listArray ((0,0),(5,1)) rawMap
 
 
 parseTemplate :: [Int] -> Text -> [MapEntry]

src/Render/Misc.hs

@@ -57,16 +57,69 @@ createProgramUsing shaders = do
    linkAndCheck program
    return program
 
+createFrustum :: Float -> Float -> Float -> Float -> [GLfloat]
+createFrustum fov n f rat =
+                let s = recip (tan $ fov*0.5 * pi / 180) in
+
+                map (fromRational . toRational) [
+                        rat*s,0,0,0,
+                        0,rat*s,0,0,
+                        0,0,-(f/(f-n)), -1,
+                        0,0,-((f*n)/(f-n)), 1
+                ]
+
 lookAtUniformMatrix4fv :: (Double, Double, Double)  --origin
                         -> (Double, Double, Double) --camera-pos
                         -> (Double, Double, Double) --up
+                        -> [GLfloat]                --frustum
                         -> GLint -> GLsizei -> IO () --rest of GL-call
-lookAtUniformMatrix4fv o c u num size = allocaArray 16 $ \projMat ->
+lookAtUniformMatrix4fv o c u frust num size = allocaArray 16 $ \projMat ->
                                                 do
-                                                        pokeArray projMat $ lookAt o c u
+                                                        pokeArray projMat $ (lookAt o c u) >< frust
                                                         glUniformMatrix4fv num size 1 projMat
 
--- generats 4x4-Projection-Matrix
+infixl 5 ><
+
+(><) :: [GLfloat] -> [GLfloat] -> [GLfloat]
+
+[   aa, ab, ac, ad,
+    ba, bb, bc, bd,
+    ca, cb, cc, cd,
+    da, db, dc, dd
+        ] >< 
+  [
+    xx, xy, xz, xw,
+    yx, yy, yz, yw,
+    zx, zy, zz, zw,
+    wx, wy, wz, ww
+        ] = [
+                --first row
+                aa*xx + ab*yx + ac*zx + ad * wx,
+                aa*xy + ab*yy + ac*zy + ad * wy,
+                aa*xz + ab*yz + ac*zz + ad * wz,
+                aa*xw + ab*yw + ac*zw + ad * ww,
+
+                --second row
+                ba*xx + bb*yx + bc*zx + bd * wx,
+                ba*xy + bb*yy + bc*zy + bd * wy,
+                ba*xz + bb*yz + bc*zz + bd * wz,
+                ba*xw + bb*yw + bc*zw + bd * ww,
+
+                --third row
+                ca*xx + cb*yx + cc*zx + cd * wx,
+                ca*xy + cb*yy + cc*zy + cd * wy,
+                ca*xz + cb*yz + cc*zz + cd * wz,
+                ca*xw + cb*yw + cc*zw + cd * ww,
+
+                --fourth row
+                da*xx + db*yx + dc*zx + dd * wx,
+                da*xy + db*yy + dc*zy + dd * wy,
+                da*xz + db*yz + dc*zz + dd * wz,
+                da*xw + db*yw + dc*zw + dd * ww
+                ]
+_ >< _ = error "non-conformat matrix-multiplication"
+
+-- generates 4x4-Projection-Matrix
 lookAt :: (Double, Double, Double) -> (Double, Double, Double) -> (Double, Double, Double) -> [GLfloat]
 lookAt origin eye up = 
         map (fromRational . toRational) [

src/Render/Render.hs

@@ -38,21 +38,28 @@ initShader = do
    ! vertexSource <- B.readFile vertexShaderFile
    ! fragmentSource <- B.readFile fragmentShaderFile
    vertexShader <- compileShaderSource VertexShader vertexSource
+   checkError "compile Vertex"
    fragmentShader <- compileShaderSource FragmentShader fragmentSource
+   checkError "compile Frag"
    program <- createProgramUsing [vertexShader, fragmentShader]
+   checkError "compile Program"
+
    currentProgram $= Just program
 
    projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")
+   checkError "projMat"
 
    colorIndex <- get (attribLocation program "fg_Color")
    vertexAttribArray colorIndex $= Enabled
-
+   checkError "colorInd"
-   vertexIndex <- get (attribLocation program "fg_Vertex")
-   vertexAttribArray vertexIndex $= Enabled
 
    normalIndex <- get (attribLocation program "fg_Normal")
    vertexAttribArray normalIndex $= Enabled
+   checkError "normalInd"
 
+   vertexIndex <- get (attribLocation program "fg_VertexIn")
+   vertexAttribArray vertexIndex $= Enabled
+   checkError "vertexInd"
 
    checkError "initShader"
    return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex)