finished episode 30. Episodes in between were either theory or trivial.

renderer-tutorial.cabal

@@ -44,5 +44,6 @@ executable renderer-tutorial
                      , Scenes.SceneClass
                      , Scenes.ClearColor
                      , Scenes.Texture2D
+                     , Scenes.Texture2DBatched
   hs-source-dirs:      src
   default-language:    Haskell2010

res/shaders/fragbatch.shader

@@ -0,0 +1,16 @@
+#version 330 core
+
+layout(location = 0) out vec4 color;
+
+in vec4 v_color;
+in vec2 v_texCoord;
+in float v_texIndex;
+
+uniform sampler2D u_textures[2];
+
+void main()
+{
+  //vec4 texColor = texture(u_texture, v_texCoord);
+  int index = int(v_texIndex);
+  color = texture(u_textures[index], v_texCoord);
+}

res/shaders/vertbatch.shader

@@ -0,0 +1,20 @@
+#version 330 core
+
+layout(location = 0) in vec3 a_position;
+layout(location = 1) in vec4 a_color;
+layout(location = 2) in vec2 a_texCoord;
+layout(location = 3) in float a_texIndex;
+
+out vec4 v_color;
+out vec2 v_texCoord;
+out float v_texIndex;
+
+uniform mat4 u_mvp;
+
+void main()
+{
+  gl_Position = u_mvp * vec4(a_position, 1);
+  v_texCoord = a_texCoord;
+  v_color = a_color;
+  v_texIndex = a_texIndex;
+}

src/Main.hs

@@ -44,6 +44,7 @@ import EventHandler
 import Scenes.SceneClass
 import Scenes.ClearColor
 import Scenes.Texture2D
+import Scenes.Texture2DBatched
 
 main :: IO ()
 main = do
@@ -171,6 +172,10 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
                 isEmpty <- isEmptyMVar curScene
                 when isEmpty $ do
                   putMVar curScene =<< fmap Scene (initScene @Texture2D)
+              SDL.KeycodeF3 -> do
+                isEmpty <- isEmptyMVar curScene
+                when isEmpty $ do
+                  putMVar curScene =<< fmap Scene (initScene @Texture2DBatched)
               _             ->
                 return ()
     switch _ = return ()

src/Scenes/Texture2D.hs

@@ -14,6 +14,8 @@ import Linear
 
 import qualified Control.Lens as Lens
 
+import Foreign.Storable (sizeOf)
+
 -- internal imports
 
 import BindableClass
@@ -79,10 +81,21 @@ instance SceneClass Texture2D where
     
     -- enable and specify data layout of the in-memory vertices
     layout <- newVertexBufferLayout
+      (fromIntegral $ 5 * sizeOf (undefined :: GL.GLfloat))
     -- push vertex positions
-    pushElements layout GL.Float 3
+    pushElements
+      layout
+      0
+      GL.Float
+      3
+      (0 * (sizeOf (undefined :: GL.GLfloat)))
     -- pusht texture coordinates
-    pushElements layout GL.Float 2
+    pushElements
+      layout
+      1
+      GL.Float
+      2
+      (3 * (sizeOf (undefined :: GL.GLfloat)))
 
     addBuffer va vbo layout
 

src/Scenes/Texture2DBatched.hs

@@ -0,0 +1,224 @@
+module Scenes.Texture2DBatched where
+
+import SDL (($=), get)
+import qualified SDL
+import qualified SDL.Internal.Numbered as SDL
+
+import qualified Graphics.Rendering.OpenGL as GL
+
+import qualified Graphics.GL.Functions as GLRaw
+
+import Control.Monad
+
+import Control.Concurrent.MVar
+
+import Linear
+
+import qualified Control.Lens as Lens
+
+import Foreign.Storable (sizeOf)
+
+-- internal imports
+
+import BindableClass
+import BufferClass
+import VertexArray
+import VertexBuffer
+import IndexBuffer
+import Shader
+import Renderer
+import Texture
+
+import Scenes.SceneClass
+
+data Texture2DBatched = Texture2DBatched
+  { texModels     :: MVar (M44 GL.GLfloat)
+  , texView       :: MVar (M44 GL.GLfloat)
+  , texProj       :: MVar (M44 GL.GLfloat)
+  , texVertArrObj :: GL.VertexArrayObject
+  , texVertArray  :: VertexArray
+  , texIdxBUfObj  :: IndexBuffer GL.GLuint
+  , texShaderProg :: Shader
+  }
+
+instance SceneClass Texture2DBatched where
+
+  initScene = do
+    -- -- MATRICES
+
+    let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
+        mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
+        mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0)
+
+    vao <- GL.genObjectName
+    va <- newVertexArray
+
+    GL.bindVertexArrayObject $= Just vao
+
+        -- define vertices (positions of the rectangle corners) as List of Floats
+        -- with added in texture coordinates
+    let vertexPositions =
+          -- 3D positions | VertexColor     | tex coords | tex indx
+          [ -67, -100, 0,   0.9, 0.8, 0, 1,   0, 0,        0
+          ,  67, -100, 0,   0.9, 0.8, 0, 1,   1, 0,        0
+          ,  67,  100, 0,   0.9, 0.8, 0, 1,   1, 1,        0
+          , -67,  100, 0,   0.9, 0.8, 0, 1,   0, 1,        0
+
+          , 133, -100, 0,   0, 0.5, 0.9, 1,   0, 0,        1
+          , 267, -100, 0,   0, 0.5, 0.9, 1,   1, 0,        1
+          , 267,  100, 0,   0, 0.5, 0.9, 1,   1, 1,        1
+          , 133,  100, 0,   0, 0.5, 0.9, 1,   0, 1,        1
+          ] :: [GL.GLfloat]
+
+        -- create draw order indices
+        indices = [0, 1, 2, 2, 3, 0, 4, 5, 6, 6, 7, 4] :: [GL.GLuint]
+
+    ibo <- newIndexBuffer indices
+
+    GL.blend $= GL.Enabled
+    GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
+
+    -- construct new VertexBuffer and fill it with data
+    vbo <- newVertexBuffer vertexPositions
+
+    -- rebind the vertex buffer
+    bind vbo
+    
+    -- enable and specify data layout of the in-memory vertices
+    layout <- newVertexBufferLayout
+      (fromIntegral $ 10 * sizeOf (undefined :: GL.GLfloat))
+    -- push vertex positions
+    pushElements
+      layout
+      0
+      GL.Float
+      3
+      (0 * (sizeOf (undefined :: GL.GLfloat)))
+    -- push vertex colors
+    pushElements
+      layout
+      1
+      GL.Float
+      4
+      (3 * (sizeOf (undefined :: GL.GLfloat)))
+    -- pusht texture coordinates
+    pushElements
+      layout
+      2
+      GL.Float
+      2
+      (7 * (sizeOf (undefined :: GL.GLfloat)))
+    -- pusht texture index
+    pushElements
+      layout
+      3
+      GL.Float
+      1
+      (9 * (sizeOf (undefined :: GL.GLfloat)))
+
+    addBuffer va vbo layout
+
+    -- -- TEXTURE
+    
+    -- generate and bind texture
+    tex1 <- newTexture "res/textures/lynx.jpg" 0
+    tex2 <- newTexture "res/textures/brainbulb_on.flat.png" 1
+    bind tex1
+    bind tex2
+
+    -- -- tell the shader where to find the texture
+    sp <- newShader
+      [ ShaderSource GL.VertexShader "./res/shaders/vertbatch.shader"
+      , ShaderSource GL.FragmentShader "./res/shaders/fragbatch.shader"
+      ]
+    bind sp
+    -- setUniform sp "u_texture" (texSlot tex)
+
+    -- unbind everything again
+    setUniformList sp "u_textures" [0 :: GL.GLint, 1]
+
+    unbind va
+    unbind vbo
+    unbind ibo
+    unbind sp
+
+    -- store the mtrices for later adjustments
+    proj <- newMVar mproj
+    view <- newMVar mview
+    model <- newMVar mmodel
+
+    return $ Texture2DBatched model view proj vao va ibo sp
+
+  update _ _ = return ()
+
+  onEvents (Texture2DBatched model view proj vao va ibo sp) evs = do
+    -- modify the mvars based on keystrokes
+    moveObj proj view model evs
+
+  render (Texture2DBatched model view proj vao va ibo sp) = do
+    -- retrieve matrices from MVars
+    mproj <- readMVar proj
+    mview <- readMVar view
+
+    GL.clearColor $= GL.Color4 0 0 0 1
+    clear
+    mmodel <- readMVar model
+    bind sp
+    setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
+
+    -- the actual drawing happens here
+    draw va ibo sp
+
+moveObj
+  :: MVar (M44 GL.GLfloat)
+  -> MVar (M44 GL.GLfloat)
+  -> MVar (M44 GL.GLfloat)
+  -> [SDL.Event]
+  -> IO ()
+moveObj proj view model evs =
+  modifyMVar_ proj (\mproj -> do
+    modifyMVar_ view (\mview -> do
+      modifyMVar_ model (\mmodel -> do
+        let plusModel = foldl (\acc ev -> case SDL.eventPayload ev of
+              (SDL.KeyboardEvent
+                ( SDL.KeyboardEventData
+                  _
+                  SDL.Pressed
+                  _
+                  (SDL.Keysym _ code mod)
+                ))
+                ->
+                  let trans =
+                        mkTransformationMat
+                          (identity :: M33 GL.GLfloat)
+                          ( ( if SDL.keyModifierLeftShift mod
+                              then (-1)
+                              else 1
+                              )
+                            *
+                            ( case code of
+                              SDL.KeycodeX ->
+                                V3 1 0 0
+                              SDL.KeycodeY ->
+                                V3 0 1 0
+                              _ ->
+                                V3 0 0 0
+                              )
+                            )
+                        !-!
+                          (identity :: M44 GL.GLfloat)
+                  in acc !+! trans
+              _ -> acc
+              )
+              zero
+              evs
+        let retval = mmodel !+! plusModel
+        when (not $ plusModel == zero) $
+          print ("Current Position of object: " <>
+            show (Lens.view translation $ retval))
+        return retval
+        )
+      return mview
+      )
+    return mproj
+    )

src/Shader.hs

@@ -21,6 +21,8 @@ import Control.Concurrent.MVar
 import Linear
 
 import Foreign.Marshal.Utils (with)
+import Foreign.Marshal.Array (withArray)
+import Foreign.Storable
 import Foreign.Ptr
 
 -- internal imports
@@ -116,6 +118,37 @@ newShader shaderSrc = do
   Shader program shaderSrc <$> newMVar []
 
 -- pass uniform values into Shader program
+setUniformList :: (Storable a, GL.Uniform a) => Shader -> String -> [a] -> IO ()
+setUniformList (Shader shaderProgram _ shaderUniforms) uniname data_ = do
+  -- check if uniform location is already cached
+  locs <- readMVar shaderUniforms
+
+  -- retrieve uniform location
+  let unilocs = filter
+        (\(ShaderUniform name _) -> name == uniname)
+        locs
+
+  case unilocs of
+    [] -> do
+      print ("Unknown uniform: " <> uniname)
+      print "Retrieving uniform location from shader program"
+      loc@(GL.UniformLocation locNum) <- get $ GL.uniformLocation shaderProgram uniname
+      if locNum < 0
+      then
+        print ("Uniform does not exist in shader program: " <> uniname)
+      else do
+        -- set the data
+        withArray data_ $ \ptr ->
+          GL.uniformv loc (fromIntegral $ length data_) ptr
+        --GL.uniform loc $= data_
+        -- add uniform to cache
+        modifyMVar_ shaderUniforms
+          (\list -> return $ ShaderUniform uniname loc : list)
+    [ShaderUniform _ loc] ->
+        -- set the data
+        withArray data_ $ \ptr ->
+          GL.uniformv loc (fromIntegral $ length data_) ptr
+
 setUniform :: (GL.Uniform a) => Shader -> String -> a -> IO ()
 setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
   -- check if uniform location is already cached
@@ -136,6 +169,8 @@ setUniform (Shader shaderProgram _ shaderUniforms) uniname data_ = do
         print ("Uniform does not exist in shader program: " <> uniname)
       else do
         -- set the data
+        --withArray data_ $ \ptr ->
+        --  GL.uniformv loc (length data_) ptr
         GL.uniform loc $= data_
         -- add uniform to cache
         modifyMVar_ shaderUniforms

src/Texture.hs

@@ -23,10 +23,10 @@ import BindableClass
 data Texture = Texture
   { texId         :: GL.TextureObject
   , texSlot       :: GL.TextureUnit
-  , texPath       :: FilePath
+  -- , texPath       :: FilePath
-  , texDimensions :: V2 GL.GLsizei
+  -- , texDimensions :: V2 GL.GLsizei
-  , texBPP        :: Int
+  -- , texBPP        :: Int
-  , texData       :: Ptr ()
+  -- , texData       :: Ptr ()
   }
 
 instance Bindable Texture where
@@ -51,10 +51,10 @@ newTexture fp slot = do
     tex <- Texture
       <$> GL.genObjectName
       <*> (pure $ GL.TextureUnit slot)
-      <*> (pure fp)
+      -- <*> (pure fp)
-      <*> (pure $ fmap fromIntegral $ V2 (imageWidth img) (imageHeight img))
+    let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img)
-      <*> (pure $ componentCount (VS.head $ imageData img))
+      -- <*> (pure $ componentCount (VS.head $ imageData img))
-      <*> (pure $ castPtr ptr)
+        data_ = castPtr ptr
 
     -- bind texture
     bind tex
@@ -65,7 +65,7 @@ newTexture fp slot = do
     GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
 
     -- put data into GPU memory
-    loadTexture tex
+    loadTexture tex dimensions data_
 
     -- unbind texture
     unbind tex
@@ -76,9 +76,9 @@ newTexture fp slot = do
     -- pass texture object out
     return tex
 
-loadTexture :: Texture -> IO ()
+loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
-loadTexture tex =
+loadTexture tex dimensions data_ =
-  let (V2 w h) = texDimensions tex
+  let (V2 w h) = dimensions
   in  GL.texImage2D
     GL.Texture2D
     GL.NoProxy
@@ -86,4 +86,4 @@ loadTexture tex =
     GL.RGBA'
     (GL.TextureSize2D w h)
     0
-    (GL.PixelData GL.RGBA GL.UnsignedByte (texData tex))
+    (GL.PixelData GL.RGBA GL.UnsignedByte data_)

src/VertexArray.hs

@@ -52,51 +52,64 @@ addBuffer va vb layout = do
   bind vb
   -- enable and fill out the vertex attrib pointer(s)
   list <- readMVar (vblElements layout)
-  let indexed = zip [0 ..] list
+  let dataElementSize e = case e of
-      dataElementSize e = case e of
         GL.Float -> sizeOf (undefined :: GL.GLfloat)
         x        -> error ("No size computation implemented fof: " <> show x)
   mapM_
-    (\(index, elem) -> do
+    (\(VertexBufferLayoutElement index type_ count offset handling) -> do
-      let offset = fromIntegral $
+      GL.vertexAttribArray (GL.AttribLocation index) $=
-            foldl
-              (\acc (index, elem) -> acc + vbleCount elem)
-              0
-              (filter ((< index) . fst) indexed) :: Int
-      GL.vertexAttribArray (GL.AttribLocation $ fromIntegral index) $=
         GL.Enabled
-      GL.vertexAttribPointer (GL.AttribLocation $ fromIntegral index) $=
+      GL.vertexAttribPointer (GL.AttribLocation index) $=
-        ( vbleHandling elem
+        ( handling
         , GL.VertexArrayDescriptor
           -- number of components to our attribute
-          (vbleCount elem)
+          count
           -- datatype of elements
-          (vbleType elem)
+          type_
-          -- ???
+          -- Stride (How big is one Vertex in bytes)
-          (sum (map vbleCount list) * fromIntegral (dataElementSize (vbleType elem)))
+          (vblStride layout)
-          -- offset from beginnning of vertex
+          -- offset from beginnning of vertex in bytes
-          (plusPtr nullPtr (offset * dataElementSize (vbleType elem)))
+          (plusPtr nullPtr offset)
         )
       )
-    indexed
+    list
   unbind va
   unbind vb
 
-newtype VertexBufferLayout = VertexBufferLayout
+data VertexBufferLayout = VertexBufferLayout
   { vblElements :: MVar [VertexBufferLayoutElement]
+  , vblStride   :: GL.GLsizei
   }
 
 data VertexBufferLayoutElement = VertexBufferLayoutElement
-  { vbleType     :: GL.DataType
+  { vbleIndex    :: GL.GLuint
+  , vbleType     :: GL.DataType
   , vbleCount    :: GL.GLint
+  , vbleOffset   :: Int
   , vbleHandling :: GL.IntegerHandling
   }
 
-newVertexBufferLayout :: IO VertexBufferLayout
+newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout
-newVertexBufferLayout = VertexBufferLayout
+newVertexBufferLayout stride = VertexBufferLayout
   <$> newMVar []
+  <*> pure stride
 
-pushElements :: VertexBufferLayout -> GL.DataType -> GL.GLint -> IO ()
+pushElements
-pushElements vbl type_ count = do
+  :: VertexBufferLayout
+  -> GL.GLuint
+  -> GL.DataType
+  -> GL.GLint
+  -> Int
+  -> IO ()
+pushElements vbl index type_ count offset = do
   modifyMVar_ (vblElements vbl) $ \list ->
-    return (list ++ [VertexBufferLayoutElement type_ count GL.ToNormalizedFloat])
+    return
+      (list ++
+        [VertexBufferLayoutElement
+          index
+          type_
+          count
+          offset
+          GL.ToNormalizedFloat
+        ]
+        )