finished episode 31

README.md

@@ -37,3 +37,13 @@ background colour. Press `Left Shift` and the number key to decrease it.
 Use keys `1` and `2` to switch between the textured quads, move them forward on
 the x and y axis by pressing `X` and `Y` respectively or backward using
 `Left Shift` and the appropriate key.
+
+## `F3` - Textured quads batched statically
+
+Move the quads forward on
+the x and y axis by pressing `X` and `Y` respectively or backward using
+`Left Shift` and the appropriate key.
+
+## `F4` - Textured quads batched dynamically
+
+No interaction.

renderer-tutorial.cabal

@@ -32,9 +32,11 @@ executable renderer-tutorial
                      , JuicyPixels-extra
                      , StateVar
                      , lens
+                     , clock
   other-modules:       BindableClass
                      , BufferClass
                      , VertexBuffer
+                     , VertexBufferDynamic
                      , VertexArray
                      , IndexBuffer
                      , Shader
@@ -45,5 +47,6 @@ executable renderer-tutorial
                      , Scenes.ClearColor
                      , Scenes.Texture2D
                      , Scenes.Texture2DBatched
+                     , Scenes.Texture2DBatchedDynamic
   hs-source-dirs:      src
   default-language:    Haskell2010

shell.nix

@@ -4,7 +4,7 @@ let
 
   inherit (nixpkgs) pkgs;
 
-  f = { mkDerivation, base, bytestring, JuicyPixels
+  f = { mkDerivation, base, bytestring, clock, JuicyPixels
       , JuicyPixels-extra, lens, linear, monad-loops, OpenGL, OpenGLRaw
       , random, sdl2, StateVar, stdenv, vector
       }:
@@ -15,7 +15,7 @@ let
         isLibrary = false;
         isExecutable = true;
         executableHaskellDepends = [
-          base bytestring JuicyPixels JuicyPixels-extra lens linear
+          base bytestring clock JuicyPixels JuicyPixels-extra lens linear
           monad-loops OpenGL OpenGLRaw random sdl2 StateVar vector
         ];
         license = stdenv.lib.licenses.gpl3;

src/Main.hs

@@ -31,6 +31,8 @@ import qualified Data.List as L
 
 import System.Random (randomRIO)
 
+import System.Clock
+
 import Linear
 
 -- internal imports
@@ -45,6 +47,7 @@ import Scenes.SceneClass
 import Scenes.ClearColor
 import Scenes.Texture2D
 import Scenes.Texture2DBatched
+import Scenes.Texture2DBatchedDynamic
 
 main :: IO ()
 main = do
@@ -94,6 +97,9 @@ main = do
   -- initial poll for events
   evs <- newMVar =<< SDL.pollEvents
 
+  -- time container for dt
+  time <- newMVar =<< getTime Monotonic
+
   -- Loop running until window closes
   whileM_ (notElem (SDL.WindowClosedEvent (SDL.WindowClosedEventData window))
     <$> map SDL.eventPayload <$> readMVar evs) $ do
@@ -113,10 +119,15 @@ main = do
       hasSelect <- not <$> isEmptyMVar curScene
       if hasSelect
       then do
+        now <- getTime Monotonic
+        before <- readMVar time
+        let dt = fromIntegral
+              (toNanoSecs $ diffTimeSpec before now) / (10 ^ (9 :: Int))
         (Scene sceneObject) <- readMVar curScene
         onEvents sceneObject currentEvents
-        update sceneObject 0
+        update sceneObject dt
         render sceneObject
+        void $ swapMVar time now
       else do
         GL.clearColor $= GL.Color4 0 0 0 1
         GL.clear [GL.ColorBuffer]
@@ -176,6 +187,10 @@ sceneSwitch curScene evs = mapM_ (switch . SDL.eventPayload) evs
                 isEmpty <- isEmptyMVar curScene
                 when isEmpty $ do
                   putMVar curScene =<< fmap Scene (initScene @Texture2DBatched)
+              SDL.KeycodeF4 -> do
+                isEmpty <- isEmptyMVar curScene
+                when isEmpty $ do
+                  putMVar curScene =<< fmap Scene (initScene @Texture2DBatchedDynamic)
               _             ->
                 return ()
     switch _ = return ()

src/Scenes/Texture2DBatchedDynamic.hs

@@ -0,0 +1,180 @@
+module Scenes.Texture2DBatchedDynamic 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
+import Foreign.C.Types
+
+import Foreign.Marshal.Array (withArray)
+
+-- internal imports
+
+import BindableClass
+import BufferClass
+import VertexArray
+import VertexBufferDynamic
+import IndexBuffer
+import Shader
+import Renderer
+import Texture
+
+import Scenes.SceneClass
+
+data Texture2DBatchedDynamic = Texture2DBatchedDynamic
+  { texModels     :: MVar (M44 GL.GLfloat)
+  , texView       :: MVar (M44 GL.GLfloat)
+  , texProj       :: MVar (M44 GL.GLfloat)
+  , texVertArrObj :: GL.VertexArrayObject
+  , texVertArray  :: VertexArray
+  , texVertBuf    :: VertexBufferDynamic
+  , texIdxBufObj  :: IndexBuffer GL.GLuint
+  , texShaderProg :: Shader
+  }
+
+instance SceneClass Texture2DBatchedDynamic 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 0 0 0)
+
+    vao <- GL.genObjectName
+    va <- newVertexArray
+
+    GL.bindVertexArrayObject $= Just vao
+
+        -- create draw order indices
+    let 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 <- newVertexBufferDynamic
+
+    -- 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]
+    setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
+
+    unbind va
+    unbind vbo
+    unbind ibo
+    unbind sp
+
+    -- store the mtrices for later adjustments
+    proj <- newMVar mproj
+    view <- newMVar mview
+    model <- newMVar mmodel
+
+    return $ Texture2DBatchedDynamic model view proj vao va vbo ibo sp
+
+  update (Texture2DBatchedDynamic _ _ _ vao _ vbo _ _) dt = do
+    let vertices = verticesToFloatList $ createQuad (V2 (dt * 500) 500) 0
+          ++ createQuad (V2 500 (dt * 500)) 1
+    GL.bindVertexArrayObject $= Just vao
+    bind vbo
+    withArray vertices $ \ptr ->
+      GL.bufferSubData
+        (target vbo)     -- ^ The target buffer
+        GL.WriteToBuffer -- ^ transfer direction
+        (CPtrdiff 0)     -- ^ Offset of the written data in the buffer
+        (CPtrdiff (fromIntegral $ length vertices * sizeOf (undefined :: GL.GLfloat)))
+          -- ^ The size of the written data
+        ptr              -- ^ Pointer to data
+
+
+
+  onEvents _ _ =
+    return ()
+
+  render (Texture2DBatchedDynamic model view proj vao va _ ibo sp) = do
+    -- retrieve matrices from MVars
+    GL.clearColor $= GL.Color4 0 0 0 1
+    clear
+
+    -- the actual drawing happens here
+    draw va ibo sp
+
+createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
+createQuad pos@(V2 x y) index =
+  [ newVertex (V3 (x - 67) (y - 100) 0) (V4 0 0 0 1) (V2 0 0) (fromIntegral index)
+  , newVertex (V3 (x + 67) (y - 100) 0) (V4 0 0 0 1) (V2 1 0) (fromIntegral index)
+  , newVertex (V3 (x + 67) (y + 100) 0) (V4 0 0 0 1) (V2 1 1) (fromIntegral index)
+  , newVertex (V3 (x - 67) (y + 100) 0) (V4 0 0 0 1) (V2 0 1) (fromIntegral index)
+  ]
+
+verticesToFloatList :: [Vertex] -> [GL.GLfloat]
+verticesToFloatList [] = []
+verticesToFloatList ((Vertex (V3 x y z) (V4 r g b a) (V2 u v) idx _):verts) =
+  [x, y, z, r, g, b, a, u, v, idx] ++ verticesToFloatList verts

src/VertexArray.hs

@@ -42,8 +42,9 @@ newVertexArray = VertexArray
   <$> GL.genObjectName
 
 addBuffer
-  :: VertexArray
+  :: (Buffer buf)
-  -> VertexBuffer a
+  => VertexArray
+  -> buf
   -> VertexBufferLayout
   -> IO ()
 addBuffer va vb layout = do

src/VertexBufferDynamic.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE TypeFamilies #-}
+module VertexBufferDynamic where
+
+import qualified Graphics.Rendering.OpenGL as GL
+
+import SDL (($=), get)
+
+import Linear
+
+import Foreign
+import Foreign.C.Types
+
+-- internal imports
+
+import BindableClass
+import BufferClass
+
+-- layout of the VertexBuffer data object
+data VertexBufferDynamic = VertexBufferDynamic
+  { vBufId   :: GL.BufferObject -- buffer id
+  , vBufSize :: GL.GLsizeiptr   -- size of data
+  -- , vBufData :: Ptr a           -- pointer to data
+  }
+
+data Vertex = Vertex
+  { vertPosition :: V3 GL.GLfloat
+  , vertColor    :: V4 GL.GLfloat
+  , vertTexCoord :: V2 GL.GLfloat
+  , vertTexID    :: GL.GLfloat
+  , vertSize     :: GL.GLsizei
+  }
+
+-- | Smart constructor for a new Vertex
+newVertex
+ :: V3 GL.GLfloat
+ -> V4 GL.GLfloat
+ -> V2 GL.GLfloat
+ -> GL.GLfloat
+ -> Vertex
+newVertex pos color texcoord index =
+  Vertex
+    pos
+    color
+    texcoord
+    index
+    (fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat)))
+
+-- instanciate typeclass from BufferClass and fill in missing implementations
+instance Buffer VertexBufferDynamic where
+
+  type ObjName VertexBufferDynamic = GL.BufferObject
+
+  target _ = GL.ArrayBuffer
+
+  glId = vBufId
+
+  initialize buf = do
+    -- bind the buffer using the default iplementation of the typeclass
+    bind buf
+    -- fill in the data
+    GL.bufferData (target buf) $=
+      ( vBufSize buf
+      , nullPtr
+      , GL.DynamicDraw
+      )
+    -- release the buffer using the default implementation of the typeclass
+    unbind buf
+
+
+instance Bindable VertexBufferDynamic where
+
+  -- bind the buffer
+  bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
+
+  -- unbind the buffer
+  unbind buf = GL.bindBuffer (target buf) $= Nothing
+
+newVertexBufferDynamic
+  :: IO VertexBufferDynamic  -- newly built VertexBuffer data object
+newVertexBufferDynamic = do
+  let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0
+  -- create the buffer object in applicative style
+  buf <- VertexBufferDynamic
+    -- generate the ID
+    <$> GL.genObjectName
+    -- compute buffer size
+    <*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex))
+    -- make pointer out of list
+    -- <*> newArray list
+  -- fill the data in to the buffer
+  initialize buf
+  -- return the data object
+  return buf