First pass at using UBO

shader/twoD/basic.vert

@@ -1,12 +1,15 @@
 #version 430 core
 layout (location = 0) in vec3 position;
 layout (location = 1) in vec4 color;
+
+layout (std140, binding = 0) uniform TheMat
+{ mat4 theMat; } ;
 out vec4 vColor;
 
 uniform mat4 worldMat;
 
 void main()
 {
-  gl_Position = worldMat * vec4(position,1);
+  gl_Position = theMat * vec4(position,1);
   vColor = color;
 }

src/Data/Preload/Render.hs

@@ -24,6 +24,7 @@ data RenderData = RenderData
     , _fboRenderbufferObject    :: RenderbufferObject
     , _fbo2                     :: (FramebufferObject, TextureObject, RenderbufferObject)
     , _fbo3                     :: (FramebufferObject, TextureObject, RenderbufferObject)
+    , _matUBO :: BufferObject
     }
 makeLenses ''RenderData
 

src/Dodge/Render.hs

@@ -21,9 +21,9 @@ import Picture.Tree
 import Shader
 import Shader.Data
 import Shader.Poke
---import MatrixHelper
+import MatrixHelper
 
-import Foreign (Word32)
+import Foreign
 --import Control.Applicative
 --import Control.Monad.State
 import Control.Lens
@@ -55,6 +55,25 @@ doDrawing pdata w = do
         viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
         pic = worldPictures w
         wallPoints = map fst wallPointsCol
+
+    let pmat = perspectiveMatrixb rot camzoom trans wins viewFroms
+    pmata <- (newMatrix RowMajor $ perspectiveMatrix rot camzoom trans wins viewFroms) :: IO (GLmatrix GLfloat)
+
+--    withMatrix pmata $ \_ ptr ->
+--        bufferData UniformBuffer $= 
+--            (fromIntegral $ sizeOf (head pmat) * length pmat
+--            ,ptr
+--            ,StreamDraw
+--            )
+    withArray pmat $ \ptr ->
+        bufferData UniformBuffer $= 
+            (fromIntegral $ sizeOf (head pmat) * length pmat
+            ,ptr
+            ,StreamDraw
+            )
+
+--    bufferData UniformBuffer $= 
+
     -- set the coordinate uniforms ready for drawing elements using world coordinates
     --setIsoMatrixUniforms pdata rot camzoom trans wins
     setPerpMatrixUniforms pdata rot camzoom trans wins viewFroms

src/MatrixHelper.hs

@@ -1,5 +1,7 @@
 module MatrixHelper
     ( perspectiveMatrix
+    , perspectiveMatrixa
+    , perspectiveMatrixb
     , isoMatrix
     ) where
 --import Geometry
@@ -72,3 +74,84 @@ isoMatrix rot czoom (tranx,trany) (winx,winy) _ =
         wmat = scalMat !*! rotMat !*! tranMat
         vToL (V4 a b c d) = [a,b,c,d]
     in concatMap vToL $ vToL wmat
+
+perspectiveMatrixa
+    :: Float        -- ^ Rotation
+    -> Float        -- ^ Zoom
+    -> Point2       -- ^ Translation
+    -> Point2       -- ^ Window size
+    -> Point2       -- ^ View froms
+    -> [Float]
+perspectiveMatrixa rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
+    let scalMat = V4 
+            (V4 (2*zoom/winx) 0             0   (0))
+            (V4 0             (2*zoom/winy) 0   0)
+            (V4 0             0             1 0) 
+            (V4 0             0             0   1)
+        rotMat = 
+            V4 (V4 (cos rot) (sin (-rot)) 0 0)
+                (V4 (sin rot) (cos rot)    0 0)
+                (V4 0             0        1 0)
+                (V4 0             0        0 1)
+        tranMat2 = 
+            V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
+        perMat = 
+             V4 (V4 1 0 0 0)
+                (V4 0 1 0 0)
+                (V4 0 0 1 1)
+                (V4 0 0 0 1)
+        tranMat1 = 
+             V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (-viewFromx) (-viewFromy) 0 1)
+        wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
+        vToL (V4 a b c d) = [a,b,c,d]
+    in concatMap vToL $ vToL wmat
+
+transMat :: Point2 -> V4 (V4 Float)
+transMat (x,y) = V4 
+    (V4 1 0 0 0)
+    (V4 0 1 0 0)
+    (V4 0 0 1 0)
+    (V4 x y 0 1)
+
+perspectiveMatrixb 
+    :: Float        -- ^ Rotation
+    -> Float        -- ^ Zoom
+    -> Point2       -- ^ Translation
+    -> Point2       -- ^ Window size
+    -> Point2       -- ^ View froms
+    -> [GLfloat]
+perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
+    let scalMat = Linear.Matrix.transpose $ V4 
+            (V4 (2*zoom/winx) 0             0   (0::GLfloat))
+            (V4 0             (2*zoom/winy) 0   0)
+            (V4 0             0             1 0) 
+            (V4 0             0             0   1)
+        rotMat = Linear.Matrix.transpose $
+            V4 (V4 (cos rot) (sin (-rot)) 0 0)
+                (V4 (sin rot) (cos rot)    0 0)
+                (V4 0             0        1 0)
+                (V4 0             0        0 1)
+        tranMat2 = Linear.Matrix.transpose $
+            V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
+        perMat = Linear.Matrix.transpose $
+             V4 (V4 1 0 0 0)
+                (V4 0 1 0 0)
+                (V4 0 0 1 1)
+                (V4 0 0 0 1)
+        tranMat1 = Linear.Matrix.transpose $
+             V4 (V4 1        0        0 0)
+                (V4 0        1        0 0)
+                (V4 0        0        1 0)
+                (V4 (-viewFromx) (-viewFromy) 0 1)
+        wmat = Linear.Matrix.transpose $ scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
+        vToL (V4 a b c d) = [a,b,c,d]
+    in concatMap vToL $ vToL wmat

src/Picture/Render.hs

@@ -38,10 +38,6 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
     -- reseting this uniform appears to be necessary
     uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
-    -- the following uniform, however, was probably already set by
-    -- createLightMap
---    uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata))
---            $= pmat
 --    cullFace $= Just Front
     drawShader (_lightingOccludeShader pdata) nWalls
     colorMask $= Color4 Enabled Enabled Enabled Enabled
@@ -76,10 +72,6 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
--- set uniforms for shader that draws lights
---    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
---    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
---            $= pmat
 -- clear buffer to full alpha and furthest depth
     clearColor $= Color4 0 0 0 1
     clearDepth $= 1
@@ -90,7 +82,6 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
     uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
---    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
     cullFace $= Just Back
     drawShader (_lightingOccludeShader pdata) nWalls
 

src/Preload/Render.hs

@@ -18,6 +18,11 @@ import Foreign
 
 preloadRender :: IO RenderData
 preloadRender = do
+    theUBO <- genObjectName
+    bindBuffer UniformBuffer $= Just theUBO
+    bufferData UniformBuffer $= (64, nullPtr, StaticDraw)
+    bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
+
 -- lighting shaders
     lightingFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points 
                     pokeLightingFloorStrat
@@ -84,6 +89,7 @@ preloadRender = do
         , _fboRenderbufferObject    = fboRBO
         , _fbo2                     = framebuf2
         , _fbo3                     = framebuf3
+        , _matUBO = theUBO
         }
 
 cornerList :: [[Float]]