more twiddling

flake.lock

@@ -5,11 +5,11 @@
         "systems": "systems"
       },
       "locked": {
-        "lastModified": 1681202837,
-        "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
+        "lastModified": 1692799911,
+        "narHash": "sha256-3eihraek4qL744EvQXsK1Ha6C3CR7nnT8X2qWap4RNk=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "cfacdce06f30d2b68473a46042957675eebb3401",
+        "rev": "f9e7cf818399d17d347f847525c5a5a8032e4e44",
         "type": "github"
       },
       "original": {
@@ -20,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1684120848,
-        "narHash": "sha256-gIwJ5ac1FwZEkCRwjY+gLwgD4G1Bw3Xtr2jr2XihMPo=",
+        "lastModified": 1692885195,
+        "narHash": "sha256-zo/6ItD2ITIOsYmpQZ3sOcuDPhIh71flCj6TkF10nKM=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "0cb867999eec4085e1c9ca61c09b72261fa63bb4",
+        "rev": "27c6502cb974e6ad610baaeeba162acd3536ec45",
         "type": "github"
       },
       "original": {

flake.nix

@@ -11,23 +11,30 @@
       let
         pkgs = nixpkgs.legacyPackages.${system};
 
-        haskellPackages = pkgs.haskellPackages;
+        nixos-lib = import (nixpkgs + "/nixos/lib") {};
+
+        haskellPackages = pkgs.haskellPackages.override (old: {
+          overrides = final: prev: {
+            wavefront = jailbreakUnbreak prev.wavefront;
+            vulkan-tutorial = vulkan-tutorial;
+          };
+        });
+
+        vulkan-tutorial = # (ref:haskell-package-def)
+          haskellPackages.callCabal2nix packageName self {
+            # Dependency overrides go here
+            #wavefront = jailbreakUnbreak haskellPackages.wavefront;
+        };
 
         jailbreakUnbreak = pkg:
-          pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
+          pkgs.haskell.lib.doJailbreak (pkgs.haskell.lib.markUnbroken pkg);
 
         packageName = "vulkan-tutorial";
       in rec {
-        packages.${packageName} = # (ref:haskell-package-def)
-          haskellPackages.callCabal2nix packageName self rec {
-            # Dependency overrides go here
-            wavefront = jailbreakUnbreak haskellPackages.wavefront;
-          };
+        packages.default = haskellPackages.vulkan-tutorial;
 
-        defaultPackage = self.packages.${system}.${packageName};
-
-        devShell = haskellPackages.shellFor {
-          packages = p: [ defaultPackage ];
+        devShells.default = haskellPackages.shellFor {
+          packages = p: [ p.vulkan-tutorial ];
           withHoogle = true;
           buildInputs = (with haskellPackages; [
             haskell-language-server
@@ -42,21 +49,6 @@
           VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
           SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
         };
-        #devShell = pkgs.mkShell {
-        #  buildInputs = with haskellPackages; [
-        #    haskell-language-server
-        #    ghcid
-        #    cabal-install
-        #  ];
-        #  nativeBuildInputs = with pkgs; [
-        #    pkg-config
-        #    SDL2
-        #    vulkan-validation-layers
-        #    vulkan-headers
-        #    vulkan-loader
-        #  ];
-        #  inputsFrom = builtins.attrValues self.packages.${system};
-        #};
-      });
+    });
 }
 

src/CommandBuffer.hs

@@ -23,7 +23,7 @@ import qualified VulkanMemoryAllocator as VMA
 import Types
 import Memory
 import Util
-import Data.Maybe (fromMaybe)
+import Mesh (compactDraws)
 
 frameOverlap :: Int
 frameOverlap = 2
@@ -60,7 +60,7 @@ createFrames
     (\_ -> do
 
       commandPool <- snd <$>
-        (Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate)
+        Vk.withCommandPool logicalDevice poolCreateInfo Nothing allocate
 
       let commandBufferAllocationInfo = Vk.zero
             { Vk.commandPool        = commandPool
@@ -100,6 +100,15 @@ createFrames
         Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT
         VMA.MEMORY_USAGE_CPU_TO_GPU
 
+      indirectBuffer <- createAllocatedBuffer
+        allocator
+        (maxObjects * sizeOf (undefined :: Vk.DrawIndirectCommand))
+        (Vk.BUFFER_USAGE_TRANSFER_DST_BIT .|.
+          Vk.BUFFER_USAGE_STORAGE_BUFFER_BIT .|.
+          Vk.BUFFER_USAGE_INDIRECT_BUFFER_BIT
+          )
+        VMA.MEMORY_USAGE_CPU_TO_GPU
+
       let allocationInfo = Vk.zero
             { Vk.descriptorPool = descriptorPool
             , Vk.setLayouts     = V.singleton setLayout
@@ -161,6 +170,7 @@ createFrames
         , frameCameraBuffer      = cameraBuffer
         , frameSceneBuffer       = sceneBuffer
         , frameObjectBuffer      = objectBuffer
+        , frameIndirectBuffer    = indirectBuffer
         , frameGlobalDescriptor  = V.head globalDescriptor
         , frameObjectDescriptor  = V.head objectDescriptor
         }
@@ -221,22 +231,26 @@ 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
+
+        let drawCommands = V.map
+              (\(i, RenderObject mesh matrix material) ->
+                Vk.DrawIndirectCommand
+                  { vertexCount   = fromIntegral (V.length $ meshVertices $ meshMap M.! mesh)
+                  , firstVertex   = 0
+                  , instanceCount = 1
+                  , firstInstance = i
+                  }
+                )
+              (V.zip
+                (V.fromList [0..])
+                renderObjects
+                )
 
         V.mapM_
-          (\(index, RenderObject meshID materialID modelMatrix) -> 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)
+          (\(IndirectBatch mesh material first count) -> do
 
             when
               (materialTextureSet material /= Vk.NULL_HANDLE)
@@ -267,28 +281,68 @@ 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
-            )
-          (V.zip
-            (V.fromList [0 ..])
-            renderObjects
+            let indirectOffset = fromIntegral $
+                  first * fromIntegral ( sizeOf (undefined :: Vk.DrawIndirectCommand))
+                drawStride = fromIntegral $ sizeOf (undefined :: Vk.DrawIndirectCommand)
+
+            Vk.cmdDrawIndirect
+              commandBuffer
+              (allocatedBuffer $ frameIndirectBuffer frame)
+              indirectOffset
+              count
+              drawStride
             )
+          draws
+
+        -- V.mapM_
+        --   (\(IndirectBatch mesh material first count) -> do
+
+        --     when
+        --       (materialTextureSet material /= Vk.NULL_HANDLE)
+        --       (Vk.cmdBindDescriptorSets
+        --         commandBuffer
+        --         Vk.PIPELINE_BIND_POINT_GRAPHICS
+        --         (materialPipelineLayout material)
+        --         2
+        --         (V.singleton $ materialTextureSet material)
+        --         V.empty
+        --         )
+
+        --     Vk.cmdBindPipeline commandBuffer Vk.PIPELINE_BIND_POINT_GRAPHICS (materialPipeline material)
+
+        --     Vk.cmdBindDescriptorSets
+        --       commandBuffer
+        --       Vk.PIPELINE_BIND_POINT_GRAPHICS
+        --       (materialPipelineLayout material)
+        --       0
+        --       (V.singleton $ frameGlobalDescriptor frame)
+        --       V.empty
+
+        --     Vk.cmdBindDescriptorSets
+        --       commandBuffer
+        --       Vk.PIPELINE_BIND_POINT_GRAPHICS
+        --       (materialPipelineLayout material)
+        --       1
+        --       (V.singleton $ frameObjectDescriptor frame)
+        --       V.empty
+
+        --     Vk.cmdBindVertexBuffers
+        --       commandBuffer
+        --       0
+        --       (V.fromList [ allocatedBuffer $ meshBuffer mesh ])
+        --       (V.fromList [ 0 ])
+
+        --     mapM_
+        --       (Vk.cmdDraw commandBuffer (fromIntegral $ V.length $ meshVertices mesh) 1 0)
+        --       [first .. (count - 1)]
+        --     )
+        --   draws
 
 prepareRecording
   :: V2 CInt

src/Devices.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Devices where
 
 import Control.Monad
@@ -38,7 +39,7 @@ pickPhysicalDevice vkInstance = do
     physDevices
 
   let discretePhysDevices = V.filter
-        (\(_, devProps, devFeatures) ->
+        (\(_, _, devFeatures) ->
           -- Vk.deviceType devProps == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
           Vk.geometryShader devFeatures
           )
@@ -104,6 +105,9 @@ createLogicalDevice physDevice surface = do
       deviceCreateInfo = Vk.zero
         { Vk.queueCreateInfos      = V.singleton (Vk.SomeStruct queueCreateInfo)
         , Vk.enabledExtensionNames = extensionNames
+        , Vk.enabledFeatures       = Just (Vk.zero
+          { Vk.multiDrawIndirect = True
+          } :: Vk.PhysicalDeviceFeatures)
         }
       shaderDrawParametersFeatures = Vk.zero
         { Vk.shaderDrawParameters  = True
@@ -140,9 +144,9 @@ createSwapchain surface surfaceFormats windowDimension logicalDevice allocator =
     if
       V.any
         (\a ->
-          (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) a ==
+          a.format ==
             Vk.FORMAT_B8G8R8A8_SRGB
-          && (Vk.colorSpace :: Vk.SurfaceFormatKHR -> Vk.ColorSpaceKHR) a ==
+          && a.colorSpace ==
             Vk.COLOR_SPACE_SRGB_NONLINEAR_KHR)
         surfaceFormats
     then
@@ -219,7 +223,7 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do
       let createInfo = Vk.zero
             { Vk.image            = tmpImage
             , Vk.viewType         = Vk.IMAGE_VIEW_TYPE_2D
-            , Vk.format           = (Vk.format :: Vk.SurfaceFormatKHR -> Vk.Format) surfaceFormat
+            , Vk.format           = surfaceFormat.format
             , Vk.components       = Vk.ComponentMapping
               { Vk.r = Vk.COMPONENT_SWIZZLE_IDENTITY
               , Vk.g = Vk.COMPONENT_SWIZZLE_IDENTITY

src/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Main where
 
 import qualified Control.Concurrent.STM as STM
@@ -11,7 +12,6 @@ import Control.Monad.Trans.Resource
 import Data.Bits
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
-import Data.Word
 import qualified SDL hiding (V2)
 import System.Mem
 import qualified Vulkan as Vk
@@ -103,7 +103,7 @@ allocateMemory logicalDevice buffer = do
   memoryRequirements <- Vk.getBufferMemoryRequirements logicalDevice buffer
 
   let memoryAllocateInfo = Vk.zero
-        { Vk.allocationSize  = (Vk.size :: Vk.MemoryRequirements -> Word64) memoryRequirements
+        { Vk.allocationSize  = memoryRequirements.size
         , Vk.memoryTypeIndex = error ("createBuffer: TODO: populate memoryTypeIndex!" :: String)
         }
 

src/Memory.hs

@@ -1,6 +1,6 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 module Memory where
 
 import Control.Monad.IO.Class
@@ -27,9 +27,9 @@ initAllocator
   -> m VMA.Allocator
 initAllocator physicalDevice device instance' = do
   let instanceProcAddr = castFunPtr $
-        Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
+        Vk.pVkGetInstanceProcAddr (instance'.instanceCmds)
       deviceProcAddr = castFunPtr $
-        Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
+        Vk.pVkGetDeviceProcAddr (device.deviceCmds)
   let allocatorInfo = Vk.zero
         { VMA.physicalDevice  = Vk.physicalDeviceHandle physicalDevice
         , VMA.device          = Vk.deviceHandle device

src/Mesh.hs

@@ -189,3 +189,37 @@ loadFromObj filepath vma uploadContext queue device = do
               (fromMaybe (error "no UV coordinates present") (faceTexCoordIndex index) - 1)
       in
         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
@@ -223,6 +227,7 @@ data FrameData = FrameData
   , frameCameraBuffer      :: AllocatedBuffer
   , frameSceneBuffer       :: AllocatedBuffer
   , frameObjectBuffer      :: AllocatedBuffer
+  , frameIndirectBuffer    :: AllocatedBuffer
   , frameGlobalDescriptor  :: Vk.DescriptorSet
   , frameObjectDescriptor  :: Vk.DescriptorSet
   }
@@ -317,3 +322,10 @@ data UploadContext = UploadContext
   , uploadCommandBuffer :: Vk.CommandBuffer
   }
   deriving (Show)
+
+data IndirectBatch = IndirectBatch
+  { batchMesh     :: Mesh
+  , batchMaterial :: Material
+  , batchFirst    :: Word32
+  , batchCount    :: Word32
+  }

test.nix

@@ -0,0 +1,46 @@
+{pkgs, vulkan-tutorial, ...}:
+pkgs.nixosTest ({
+  name = "test";
+  nodes = {
+    machine = { config, pkgs, ...}: {
+      environment = {
+        systemPackages = with pkgs; [
+          vulkan-tutorial
+          git
+          shaderc
+          vulkan-loader
+          vulkan-validation-layers
+        ];
+        sessionVariables = {
+          VK_LAYER_PATH="${pkgs.vulkan-validation-layers}/share/vulkan/explicit_layer.d";
+          SDL_VULKAN_LIBRARY="${pkgs.vulkan-loader}/lib/libvulkan.so";
+        };
+      };
+      hardware.opengl = {
+        enable = true;
+        driSupport = true;
+        driSupport32Bit = true;
+      };
+      services.xserver = {
+        enable = true;
+        displayManager.sddm.enable = true;
+        desktopManager.cinnamon.enable = true;
+      };
+      users.users.test = {
+        password = "test";
+        extraGroups = [
+          "wheel"
+        ];
+        isNormalUser = true;
+      };
+    };
+  };
+
+  skipLint = true;
+
+  testScript = ''
+    start_all()
+
+    machine.shell_interact()
+  '';
+})

vulkan-tutorial.cabal

@@ -41,7 +41,7 @@ executable vulkan-tutorial
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base >=4.14.3.0
+    build-depends:    base
                     , sdl2
                     , vulkan
                     , vulkan-utils