first little optimisation

src/CommandBuffer.hs

@@ -24,6 +24,7 @@ import Types
 import Memory
 import Util
 import Data.Maybe (fromMaybe)
+import Mesh (compactDraws)
 
 frameOverlap :: Int
 frameOverlap = 2
@@ -221,22 +222,12 @@ recordCommandBuffer
 
         renderObjects <- (liftIO . STM.atomically . STM.readTMVar) =<< asks renderables
         meshMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks meshLibrary
+        materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
+
+        let draws = compactDraws meshMap materialMap renderObjects
 
         V.mapM_
-          (\(index, RenderObject meshID materialID modelMatrix) -> do
+          (\(IndirectBatch mesh material first count) -> do
-
-            materialMap <- (liftIO . STM.atomically . STM.readTMVar) =<< asks materialLibrary
-
-            let constants = MeshPushConstants
-                  { meshPushData     = V4 0 0 0 0
-                  , meshRenderMatrix = modelMatrix
-                  }
-                mesh = fromMaybe
-                  (error $ "no mesh called " <> meshID <> " present")
-                  (meshMap M.!? meshID)
-                material = fromMaybe
-                  (error $ "no material called " <> materialID <> " present")
-                  (materialMap M.!? materialID)
 
             when
               (materialTextureSet material /= Vk.NULL_HANDLE)
@@ -267,28 +258,19 @@ recordCommandBuffer
               (V.singleton $ frameObjectDescriptor frame)
               V.empty
 
-            dataPointer <- liftIO (castPtr <$> new constants)
-
-            Vk.cmdPushConstants
-              commandBuffer
-              (materialPipelineLayout material)
-              Vk.SHADER_STAGE_VERTEX_BIT
-              0
-              (fromIntegral $ sizeOf constants)
-              dataPointer
-
             Vk.cmdBindVertexBuffers
               commandBuffer
               0
               (V.fromList [ allocatedBuffer $ meshBuffer mesh ])
               (V.fromList [ 0 ])
 
-            Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
+            mapM_
-            )
+              (\index ->
-          (V.zip
+                Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0 index
-            (V.fromList [0 ..])
+                )
-            renderObjects
+              ([first .. first + count])
             )
+          draws
 
 prepareRecording
   :: V2 CInt

src/Mesh.hs

@@ -190,3 +190,37 @@ loadFromObj filepath vma uploadContext queue device = do
       in
         -- flip V coordinate of UVs to fix display
         V2 r (-s)
+
+compactDraws
+  :: M.Map String Mesh
+  -> M.Map String Material
+  -> V.Vector RenderObject
+  -> V.Vector IndirectBatch
+compactDraws meshLib materialLib objects =
+
+  V.foldl
+    (\acc (index, RenderObject mesh material _) ->
+
+      let newDraw = IndirectBatch
+            { batchMesh     = meshLib M.! mesh
+            , batchMaterial = materialLib M.! material
+            , batchFirst    = index
+            , batchCount    = 1
+            }
+          sameMesh = not (V.null acc) && (meshLib M.! mesh == batchMesh (V.last acc))
+          sameMaterial = not (V.null acc) && (materialLib M.! material == batchMaterial (V.last acc))
+
+      in
+        if sameMesh && sameMaterial
+        then
+          V.init acc `V.snoc` ((V.last acc)
+            { batchCount = batchCount (V.last acc) + 1
+            })
+        else
+          acc `V.snoc` newDraw
+      )
+    V.empty
+    (V.zip
+      (V.fromList [0..])
+      objects
+      )

src/Types.hs

@@ -54,13 +54,17 @@ data AllocatedBuffer = AllocatedBuffer
   }
   deriving (Show)
 
+instance Eq AllocatedBuffer where
+
+  (AllocatedBuffer buf1 _ _) == (AllocatedBuffer buf2 _ _) = buf1 == buf2
+
 data Vertex = Vertex
   { vertexPosition :: V3 Float
   , vertexNormal   :: V3 Float
   , vertexColor    :: V4 Float
   , vertexUV       :: V2 Float
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance Storable Vertex where
 
@@ -143,7 +147,7 @@ data Mesh = Mesh
   { meshVertices :: V.Vector Vertex
   , meshBuffer   :: AllocatedBuffer
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 data MeshPushConstants = MeshPushConstants
   { meshPushData     :: V4 Float
@@ -180,7 +184,7 @@ data Material = Material
   , materialPipeline       :: Vk.Pipeline
   , materialPipelineLayout :: Vk.PipelineLayout
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 data RenderObject = RenderObject
   { objectMesh     :: String
@@ -317,3 +321,10 @@ data UploadContext = UploadContext
   , uploadCommandBuffer :: Vk.CommandBuffer
   }
   deriving (Show)
+
+data IndirectBatch = IndirectBatch
+  { batchMesh     :: Mesh
+  , batchMaterial :: Material
+  , batchFirst    :: Word32
+  , batchCount    :: Word32
+  }