it works...

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
 

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;
+   vec4 light = vec4(1.0,1.0,1.0,1.0);
-                    // + 0.001* fg_Normal.xyzx;
+   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;
 }

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
+runDemo env state = void $ evalRWST (adjustWindow >> run) 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
+        let perspective = V4 (V4 s 0        0           0)
-                                      , 0, s, 0, 0
+                             (V4 0 s        0           0)
-                                      , 0, 0, -(f/(f - n)), -1
+                             (V4 0 0 (-(f/(f - n)))  (-1))
-                                      , 0, 0, -((f*n)/(f-n)), 0
+                             (V4 0 0 (-((f*n)/(f-n)))   1)
-                                      ]
+                         !*!
-        V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
+                          V4 (V4 1 0 0 0)
-        let model = V.fromList [
+                             (V4 0 0 1 0)
-                                        1,  0, 0, 0
+                             (V4 0 1 0 0)
-                                      , 0,  0, 1, 0
+                             (V4 0 0 0 1)
-                                      , 0,  1, 0, 0
+        with (distribute $ perspective) $ \ptr ->
-                                      ,-5, -10, -10, 1
+              GL.glUniformMatrix4fv proj 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
-                                      ]
+        --V.unsafeWith perspective $ \ptr -> GL.glUniformMatrix4fv proj 1 0 ptr
-        V.unsafeWith model $ \ptr -> GL.glUniformMatrix4fv mmat 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

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
-                        cr, cg, cb, 1.0        -- RGBA Color
+                        nx, ny, nz,             -- 3 Normal
-                        --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 = 

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