Add uniform buffer window coordinate matrix

shader/twoD/basic.vert

@@ -2,8 +2,7 @@
 layout (location = 0) in vec3 position;
 layout (location = 1) in vec4 color;
 
-layout (std140, binding = 0) uniform TheMat
+layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
-{ mat4 theMat; } ;
 out vec4 vColor;
 
 uniform mat4 worldMat;

src/Dodge/Render.hs

@@ -57,14 +57,6 @@ doDrawing pdata w = do
         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
@@ -72,8 +64,6 @@ doDrawing pdata w = do
             ,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
@@ -145,6 +135,15 @@ doDrawing pdata w = do
     -- reset the coordinate uniforms for pictures that are drawn wrt to window
     -- coordinates
     resetShaderUniforms (map extractProgAndUnis $ _pictureShaders pdata)
+
+    let pmata = perspectiveMatrixc 0 1 (0,0) (2,2)
+    withArray pmata $ \ptr ->
+        bufferData UniformBuffer $= 
+            (fromIntegral $ sizeOf (head pmat) * length pmat
+            ,ptr
+            ,StreamDraw
+            )
+
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     _ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
     eTicks <- SDL.ticks

src/MatrixHelper.hs

@@ -2,6 +2,7 @@ module MatrixHelper
     ( perspectiveMatrix
     , perspectiveMatrixa
     , perspectiveMatrixb
+    , perspectiveMatrixc
     , isoMatrix
     ) where
 --import Geometry
@@ -34,17 +35,12 @@ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
                 (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 = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
+        wmat = scalMat !*! rotMat !*! tranMat2 !*! lmt perMat !*! tranMat1
         vToL (V4 a b c d) = [a,b,c,d]
     in concatMap vToL $ vToL wmat
 {- | A matrix that gives a top down view with no perspective. -}
@@ -98,27 +94,15 @@ perspectiveMatrixa rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
                 (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
+        wmat = scalMat !*! rotMat !*! tranMat2 !*! lmt 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
@@ -127,31 +111,55 @@ perspectiveMatrixb
     -> Point2       -- ^ View froms
     -> [GLfloat]
 perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
-    let scalMat = Linear.Matrix.transpose $ V4 
+    let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy))
-            (V4 (2*zoom/winx) 0             0   (0::GLfloat))
+            !*! rotMatr (-rot)
-            (V4 0             (2*zoom/winy) 0   0)
+            !*! lmt (transMat (viewFromx-tranx,viewFromy-trany))
-            (V4 0             0             1 0) 
+            !*! lmt perMat 
-            (V4 0             0             0   1)
+            !*! lmt (transMat (-viewFromx,-viewFromy))
-        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
+
+perspectiveMatrixc 
+    :: Float        -- ^ Rotation
+    -> Float        -- ^ Zoom
+    -> Point2       -- ^ Translation
+    -> Point2       -- ^ Window size
+    -> [GLfloat]
+perspectiveMatrixc rot zoom (tranx,trany) (winx,winy) =
+    let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy))
+            !*! rotMatr (-rot)
+            !*! lmt (transMat (-tranx,-trany))
+        vToL (V4 a b c d) = [a,b,c,d]
+    in concatMap vToL $ vToL wmat
+
+lmt :: V4 (V4 a) -> V4 (V4 a)
+lmt = Linear.Matrix.transpose
+
+perMat :: V4 (V4 Float)
+perMat = V4 
+    (V4 1 0 0 0)
+    (V4 0 1 0 0)
+    (V4 0 0 1 1)
+    (V4 0 0 0 1)
+
+scaleMat :: Point2 -> V4 (V4 Float)
+scaleMat (x,y) = V4
+    (V4 x 0 0 0)
+    (V4 0 y 0 0)
+    (V4 0 0 1 0) 
+    (V4 0 0 0 1)
+
+rotMatr :: Float -> V4 (V4 Float)
+rotMatr a = V4
+    (V4 (cos a) (sin (-a)) 0 0)
+    (V4 (sin a) (cos a)    0 0)
+    (V4 0       0          1 0)
+    (V4 0       0          0 1)
+
+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)
+