finished episode 19. episode 18 was theory only

renderer-tutorial.cabal

@@ -30,6 +30,7 @@ executable renderer-tutorial
                      , random
                      , JuicyPixels
                      , JuicyPixels-extra
+                     , StateVar
   other-modules:       BindableClass
                      , BufferClass
                      , VertexBuffer

res/shaders/vert.shader

@@ -5,8 +5,10 @@ layout(location = 1) in vec2 texCoord;
 
 out vec2 v_texCoord;
 
+uniform mat4 u_mvp;
+
 void main()
 {
-  gl_Position = vec4(position, 1);
+  gl_Position = u_mvp * vec4(position, 1);
   v_texCoord = texCoord;
 }

shell.nix

@@ -6,7 +6,7 @@ let
 
   f = { mkDerivation, base, bytestring, JuicyPixels
       , JuicyPixels-extra, linear, monad-loops, OpenGL, OpenGLRaw, random
-      , sdl2, stdenv, vector
+      , sdl2, StateVar, stdenv, vector
       }:
       mkDerivation {
         pname = "renderer-tutorial";
@@ -16,7 +16,7 @@ let
         isExecutable = true;
         executableHaskellDepends = [
           base bytestring JuicyPixels JuicyPixels-extra linear monad-loops
-          OpenGL OpenGLRaw random sdl2 vector
+          OpenGL OpenGLRaw random sdl2 StateVar vector
         ];
         license = stdenv.lib.licenses.gpl3;
       };

src/Main.hs

@@ -29,6 +29,8 @@ import qualified Data.List as L
 
 import System.Random (randomRIO)
 
+import Linear
+
 -- internal imports
 
 import BindableClass
@@ -85,10 +87,10 @@ main = do
       -- with added in texture coordinates
   let vertexPositions =
         -- 3D positions    | texture coordinates
-        [ (-0.5), (-0.5), 0, 0, 0 -- 0
+        [ (-0.5), (-0.75), 0, 0, 0 -- 0
-        , 0.5   , (-0.5), 0, 1, 0 -- 1
+        , 0.5   , (-0.75), 0, 1, 0 -- 1
-        , 0.5   , 0.5   , 0, 1, 1 -- 2
+        , 0.5   , 0.75   , 0, 1, 1 -- 2
-        , (-0.5), 0.5   , 0, 0, 1 -- 3
+        , (-0.5), 0.75   , 0, 0, 1 -- 3
         ] :: [GL.GLfloat]
 
       -- create draw order indices
@@ -110,6 +112,10 @@ main = do
 
   addBuffer vao vbo layout
 
+  -- -- MATRICES
+
+  let proj = ortho (-2) 2 (-1.5) 1.5 (-1) 1 :: M44 GL.GLfloat
+
   -- -- TEXTURE
   
   -- generate and bind texture
@@ -127,11 +133,13 @@ main = do
     ]
     [ "u_color"
     , "u_texture"
+    , "u_mvp"
     ]
 
   -- -- tell the shader where to find the texture
   bind sp
   setUniform sp "u_texture" (texSlot tex)
+  setUniform sp "u_mvp" proj
 
   -- -- UNIFORMS
 

src/Shader.hs

@@ -1,13 +1,26 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 module Shader where
 
 import SDL (($=), get)
 
 import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.GL as GLRaw
 
 import Data.List as L
 
+import Data.StateVar
+
 import qualified Data.ByteString as B
 
+import Data.Maybe (fromJust)
+
+import Linear
+
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr
+
 -- internal imports
 
 import BindableClass
@@ -35,7 +48,33 @@ data ShaderUniform = ShaderUniform
   , shaderUniformLocation :: GL.UniformLocation
   }
 
--- cerate new data object of type Shader
+-- orphan instance to make linear's M44 uniforms
+instance GL.Uniform (M44 GL.GLfloat) where
+  uniform loc@(GL.UniformLocation ul) = makeStateVar getter setter
+    where
+      getter = error "cannot implement: get uniform M44 GLfloat"
+        -- GL.withNewMatrix GL.RowMajor $ getUniformWith GLRaw.glGetUniformfv loc
+      setter (V4
+        (V4 a b c d)
+        (V4 e f g h)
+        (V4 i j k l)
+        (V4 m n o p)) = do
+          mat <- GL.newMatrix GL.RowMajor [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] :: IO (GL.GLmatrix GL.GLfloat)
+          GL.withMatrix mat $ GLRaw.glUniformMatrix4fv ul 1 . isRowMajor
+  uniformv (GL.UniformLocation ul) count buf = error "can not implement uniformv for M44 GLfloat"
+    -- GLRaw.glUniformMatrix4fv ul count 0 (castPtr buf `asTypeOf` elemType buf)
+    -- where
+    --   elemType = undefined :: GL.MatrixComponent c => Ptr (GL.GLmatrix c) -> Ptr c
+
+-- getUniformWith :: (GL.GLuint -> GL.GLint -> Ptr a -> IO ()) -> GL.UniformLocation -> Ptr a -> IO ()
+-- getUniformWith getter (GL.UniformLocation ul) buf = do
+--   program <- fmap (GL.programID . fromJust) $ get GL.currentProgram
+--   getter program ul buf
+
+isRowMajor :: GL.MatrixOrder -> GL.GLboolean
+isRowMajor p = if (GL.RowMajor == p) then 1 else 0
+
+-- create new data object of type Shader
 newShader :: [ShaderSource] -> [String] -> IO Shader
 newShader shaderSrc uniforms = do
   -- create program Object