More utils

examples/compute/Main.hs

@@ -29,10 +29,6 @@ import Vulkan.Utils.ShaderQQ.GLSL.Glslang (comp)
 import Vulkan.Zero (zero)
 import qualified VulkanMemoryAllocator as VMA
 
-----------------------------------------------------------------
--- The program
-----------------------------------------------------------------
-
 main :: IO ()
 main = runResourceT $ do
   HeadlessVk{..} <-
@@ -77,7 +73,6 @@ render allocator dev computeQueueFamilyIndex = do
         }
       allocate
 
-  -- Create a descriptor set and layout for this buffer
   (descriptorSet, descriptorSetLayout) <- do
     (_, descriptorPool) <-
       Vk.withDescriptorPool
@@ -128,7 +123,6 @@ render allocator dev computeQueueFamilyIndex = do
     ]
     []
 
-  -- Create our shader and compute pipeline
   (_, shader) <- shaderStage dev Vk.SHADER_STAGE_COMPUTE_BIT () compCode
   (_, pipelineLayout) <-
     Vk.withPipelineLayout
@@ -152,7 +146,6 @@ render allocator dev computeQueueFamilyIndex = do
       Nothing
       allocate
 
-  -- Create a command buffer
   let commandPoolCreateInfo =
         zero
           { CommandPoolCreateInfo.queueFamilyIndex = computeQueueFamilyIndex
@@ -166,7 +159,6 @@ render allocator dev computeQueueFamilyIndex = do
           }
   (_, [cb]) <- Vk.withCommandBuffers dev commandBufferAllocateInfo allocate
 
-  -- Fill command buffer
   Vk.useCommandBuffer cb zero{CommandBufferBeginInfo.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT} do
     Vk.cmdBindPipeline
       cb

examples/depth-headless/Main.hs

@@ -155,7 +155,6 @@ render allocator dev graphicsQueueFamilyIndex = do
   (_, (image, imageView)) <- createColorTarget allocator dev imageFormat extent
   (_, (depthImage, depthView)) <- createDepthTarget allocator dev depthFormat extent
 
-  -- CPU readback image + its reader.
   (cpuImage, readback) <- makeReadbackImage allocator dev imageFormat extent
 
   -- Vertex buffer: host-visible, mapped, filled with the 6 vertices.
@@ -186,13 +185,13 @@ render allocator dev graphicsQueueFamilyIndex = do
               ]
           }
   (_, pipeline) <-
-    Dynamic.createPipelineFromShaders
+    Dynamic.allocatePipelineFromShaders
       dev
-      [imageFormat]
-      (Just depthFormat)
-      vertexInput
-      Nothing -- full always-on dynamic state
-      Nothing -- empty pipeline layout (no descriptor sets / push constants)
+      zero
+        { Dynamic.colorFormats = [imageFormat]
+        , Dynamic.depthFormat = Just depthFormat
+        , Dynamic.vertexInput = vertexInput
+        }
       () -- no specialization constants
       [(Vk.SHADER_STAGE_VERTEX_BIT, vertCode), (Vk.SHADER_STAGE_FRAGMENT_BIT, fragCode)]
 

examples/hlsl/Main.hs

@@ -41,7 +41,7 @@ main = runResourceT $ do
       (sdl2Adapter win)
   let dev = vcDevice vc
   let colorFormat = SurfaceFormatKHR.format (sFormat initialSC)
-  (_, renderPass) <- RenderPass.createColorRenderPass dev colorFormat Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
+  (_, renderPass) <- RenderPass.allocateColorRenderPass dev colorFormat Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
   (_, pipeline) <- createPipeline dev renderPass colorFormat
 
   SDL.showWindow win
@@ -55,7 +55,7 @@ main = runResourceT $ do
     WindowLoop
       { wlMkState = \sc -> do
           framebuffers <-
-            traverse (\iv -> Framebuffer.createFramebuffer dev renderPass iv (sExtent sc)) (sImageViews sc)
+            traverse (\iv -> Framebuffer.allocateFramebuffer dev renderPass iv (sExtent sc)) (sImageViews sc)
           groupKey <- register (traverse_ (release . fst) framebuffers)
           pure (fmap snd framebuffers, groupKey)
       , wlRender = \fbs f ->
@@ -78,14 +78,13 @@ createPipeline
   -> Vk.Format
   -> m (ReleaseKey, Vk.Pipeline)
 createPipeline dev renderPass colorFormat =
-  RenderPass.createPipelineFromShaders
+  RenderPass.allocatePipelineFromShaders
     dev
     renderPass
-    [colorFormat]
-    Nothing
-    zero -- no vertex input
-    (Just minimalDynamicStates)
-    Nothing -- empty pipeline layout (no descriptor sets / push constants)
+    zero
+      { RenderPass.colorFormats = [colorFormat]
+      , RenderPass.dynamicStates = Just minimalDynamicStates
+      }
     ()
     [ (Vk.SHADER_STAGE_VERTEX_BIT, vertCode)
     , (Vk.SHADER_STAGE_FRAGMENT_BIT, fragCode)

examples/lib/HeadlessBoot.hs

@@ -31,7 +31,7 @@ import Vulkan.Requirement (DeviceRequirement, InstanceRequirement (..))
 import qualified Vulkan.Utils.Init.Headless as Init
 import Vulkan.Utils.Initialization (physicalDeviceName)
 import Vulkan.Utils.QueueAssignment (QueueFamilyIndex)
-import Vulkan.Utils.Queues (Queues, withDevice)
+import Vulkan.Utils.Queues (Queues, allocateDevice)
 import Vulkan.Zero (zero)
 import qualified VulkanMemoryAllocator as VMA
 import VulkanMemoryAllocator.Utils (allocatorCreateInfo)
@@ -64,7 +64,7 @@ withHeadlessVk
   -> m HeadlessVk
 withHeadlessVk HeadlessConfig{..} = do
   inst <-
-    Init.withInstance
+    Init.allocateInstance
       ( Just
           zero
             { Vk.applicationName = Just (Text.encodeUtf8 hcAppName)
@@ -76,7 +76,7 @@ withHeadlessVk HeadlessConfig{..} = do
       )
       [RequireInstanceLayer "VK_LAYER_KHRONOS_validation" minBound]
   _ <- withDebugUtilsMessengerEXT inst debugMessengerCreateInfo Nothing allocate
-  (phys, dev, qs) <- withDevice inst Nothing hcDeviceReqs
+  (phys, dev, qs) <- allocateDevice inst Nothing hcDeviceReqs
   (_, vma) <-
     VMA.withAllocator (allocatorCreateInfo zero API_VERSION_1_3 inst phys dev) allocate
   sayErr . ("Using device: " <>) =<< physicalDeviceName phys
@@ -98,7 +98,6 @@ submitAndWait
   -> Vk.Queue
   -> Vk.CommandBuffer
   -> String
-  -- ^ Message to throw if the wait times out.
   -> m ()
 submitAndWait dev queue commandBuffer timeoutMessage = do
   (_, fence) <- Vk.withFence dev zero Nothing allocate

examples/lib/Triangle.hs

@@ -45,7 +45,7 @@ runTriangle vc initialSC getDrawableSize shouldQuit = do
   let dev = vcDevice vc
   let colorFormat = KHR.format (sFormat initialSC)
   (_, renderPass) <-
-    RenderPass.createColorRenderPass
+    RenderPass.allocateColorRenderPass
       dev
       colorFormat
       Vk.IMAGE_LAYOUT_PRESENT_SRC_KHR
@@ -59,7 +59,7 @@ runTriangle vc initialSC getDrawableSize shouldQuit = do
     WindowLoop
       { wlMkState = \sc -> do
           framebuffers <-
-            traverse (\iv -> Framebuffer.createFramebuffer dev renderPass iv (sExtent sc)) (sImageViews sc)
+            traverse (\iv -> Framebuffer.allocateFramebuffer dev renderPass iv (sExtent sc)) (sImageViews sc)
           groupKey <- register (traverse_ (release . fst) framebuffers)
           pure (fmap snd framebuffers, groupKey)
       , wlRender = drawTriangle vc renderPass pipeline
@@ -112,14 +112,13 @@ createGraphicsPipeline
   -- ^ Colour attachment format (matches the render pass).
   -> m (ReleaseKey, Vk.Pipeline)
 createGraphicsPipeline dev renderPass colorFormat =
-  RenderPass.createPipelineFromShaders
+  RenderPass.allocatePipelineFromShaders
     dev
     renderPass
-    [colorFormat]
-    Nothing -- no depth attachment
-    zero -- no vertex input
-    (Just minimalDynamicStates) -- just viewport+scissor; set below with cmdSetViewport/Scissor
-    Nothing -- empty pipeline layout (no descriptor sets / push constants)
+    zero
+      { RenderPass.colorFormats = [colorFormat]
+      , RenderPass.dynamicStates = Just minimalDynamicStates -- just viewport+scissor; set below with cmdSetViewport/Scissor
+      }
     () -- no specialization constants
     [ (Vk.SHADER_STAGE_VERTEX_BIT, vertCode)
     , (Vk.SHADER_STAGE_FRAGMENT_BIT, fragCode)

examples/lib/WindowedBoot.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 {-| Shared boot prelude for the windowed examples. Drives the standard
-@withInstance \/ withSurface \/ withDevice \/ withAllocator \/ allocSwapchain@
+@allocateInstance \/ allocateSurface \/ allocateDevice \/ withAllocator \/ allocateSwapchain@
 sequence so each main can open with a single call instead of a 20-line
 copy-paste.
 
@@ -29,8 +29,8 @@ import Vulkan.Extensions.VK_EXT_debug_utils
 import Vulkan.Requirement (DeviceRequirement, InstanceRequirement (..))
 import Vulkan.Utils.Debug (debugCallbackPtr)
 import Vulkan.Utils.Frame (frameDeviceRequirements, frameInstanceRequirements)
-import Vulkan.Utils.Queues (withDevice)
-import Vulkan.Utils.Swapchain (Swapchain, SwapchainConfig, allocSwapchain)
+import Vulkan.Utils.Queues (allocateDevice)
+import Vulkan.Utils.Swapchain (Swapchain, SwapchainConfig, allocateSwapchain)
 import Vulkan.Utils.VulkanContext (VulkanContext, mkVulkanContext)
 import Vulkan.Utils.WindowAdapter (WindowAdapter (..))
 import Vulkan.Zero (zero)
@@ -63,7 +63,7 @@ withWindowedVk
   -> m (VulkanContext, VMA.Allocator, Swapchain)
 withWindowedVk WindowedConfig{..} WindowAdapter{..} = do
   inst <-
-    waWithInstance
+    waAllocateInstance
       ( Just
           zero
             { Vk.applicationName = Just (Text.encodeUtf8 wcAppName)
@@ -76,9 +76,9 @@ withWindowedVk WindowedConfig{..} WindowAdapter{..} = do
       )
       [RequireInstanceLayer "VK_LAYER_KHRONOS_validation" minBound]
   _ <- withDebugUtilsMessengerEXT inst debugMessengerCreateInfo Nothing allocate
-  surf <- waWithSurface inst
+  surf <- waAllocateSurface inst
   (phys, dev, qs) <-
-    withDevice inst (Just surf) (frameDeviceRequirements ++ wcDeviceReqs)
+    allocateDevice inst (Just surf) (frameDeviceRequirements ++ wcDeviceReqs)
   (_, vma) <-
     VMA.withAllocator
       (allocatorCreateInfo wcVmaFlags API_VERSION_1_3 inst phys dev)
@@ -89,7 +89,7 @@ withWindowedVk WindowedConfig{..} WindowAdapter{..} = do
 
   initialSize <- waDrawableSize
   initialSC <-
-    allocSwapchain phys dev wcSwapchainConfig Vk.NULL_HANDLE initialSize surf
+    allocateSwapchain phys dev wcSwapchainConfig Vk.NULL_HANDLE initialSize surf
   pure (vc, vma, initialSC)
 
 {- | Standard validation/perf debug messenger create info, shared with

examples/rays/AccelerationStructure.hs

@@ -40,9 +40,6 @@ createTLAS
   -> m (ReleaseKey, RT.AccelerationStructureKHR)
 createTLAS vc vma sceneBuffers = do
   let dev = vcDevice vc
-  --
-  -- Create the bottom level acceleration structure.
-  --
   (_blasReleaseKey, blas) <- createBLAS vc vma sceneBuffers
   blasAddress <-
     RT.getAccelerationStructureDeviceAddressKHR

examples/rays/Init.hs

@@ -53,7 +53,6 @@ deviceRequirements =
   |]
     ++ frameDeviceRequirements
 
--- | Information for ray tracing (queried from device properties).
 data RTInfo = RTInfo
   { rtiShaderGroupHandleSize :: Word32
   , rtiShaderGroupBaseAlignment :: Word32

examples/rays/Main.hs

@@ -42,11 +42,9 @@ main = runResourceT $ do
     phys = vcPhysicalDevice vc
     dev = vcDevice vc
 
-  -- Scene + acceleration structure
   sceneBuffers <- makeSceneBuffers vma
   (_, tlas) <- createTLAS vc vma sceneBuffers
 
-  -- RT pipeline + descriptor sets
   rtInfo <- getDeviceRTProps phys
   (_, descSetLayout) <- Pipeline.createRTDescriptorSetLayout dev
   (_, pipelineLayout) <- Pipeline.createRTPipelineLayout dev descSetLayout

examples/rays/Pipeline.hs

@@ -1,4 +1,3 @@
--- {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}

examples/resize/Main.hs

@@ -30,7 +30,7 @@ import qualified Vulkan.Core10 as Vk
 import Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (TimelineSemaphoreSubmitInfo (..))
 import Vulkan.Exception
 import Vulkan.Utils.Barrier (imageBarrier)
-import Vulkan.Utils.Frame (Frame (..), acquireFrameImage, presentFrameImage, queueSubmitFrame, recordCommands, withTimelineSemaphore)
+import Vulkan.Utils.Frame (Frame (..), acquireFrameImage, allocateTimelineSemaphore, presentFrameImage, queueSubmitFrame, recordCommands)
 import Vulkan.Utils.Init.SDL2.Window (createWindow, drawableSize, sdl2Adapter, shouldQuit, withSDL)
 import Vulkan.Utils.QueueAssignment (QueueFamilyIndex (..))
 import Vulkan.Utils.Queues (Queues (..))
@@ -67,7 +67,7 @@ main = prettyError . runResourceT $ do
     if fst (qGraphics (vcQueues vc)) == fst (qCompute (vcQueues vc))
       then pure SharedQueue
       else do
-        (_, readyTimeline) <- withTimelineSemaphore dev 0
+        (_, readyTimeline) <- allocateTimelineSemaphore dev 0
         lastBlitDone <- liftIO (newIORef 0)
         pure (AsyncCompute readyTimeline lastBlitDone)
 
@@ -139,9 +139,7 @@ data Bindings = Bindings
   the frame acquires.
   -}
   , bOffscreenView :: Vk.ImageView
-  -- ^ View of 'bOffscreenImage', bound into 'bJuliaDescriptorSet'.
   , bJuliaDescriptorSet :: Vk.DescriptorSet
-  -- ^ Storage-image descriptor pointing at 'bOffscreenView'.
   }
 
 createBindings

examples/triangle-dynamic/TriangleDynamic.hs

@@ -11,7 +11,7 @@ view. Everything comes from the single "Vulkan.Utils.DynamicRendering" path
 module.
 
 The graphics pipeline is built with
-'Vulkan.Utils.DynamicRendering.createPipelineFromShaders', which omits the render
+'Vulkan.Utils.DynamicRendering.allocatePipelineFromShaders', which omits the render
 pass and instead carries a 'Vk.PipelineRenderingCreateInfo' in its pNext chain.
 
 It also passes 'Nothing' for the dynamic-state set, so the pipeline declares the
@@ -53,13 +53,9 @@ runTriangle
   -> ResourceT IO ()
 runTriangle vc initialSC getDrawableSize shouldQuit = do
   (_, pipeline) <-
-    Dynamic.createPipelineFromShaders
+    Dynamic.allocatePipelineFromShaders
       (vcDevice vc)
-      [KHR.format (sFormat initialSC)]
-      Nothing -- no depth attachment
-      zero -- no vertex input
-      Nothing -- full always-on dynamic state; driven by 'applyDynamicStates' below
-      Nothing -- empty pipeline layout (no descriptor sets / push constants)
+      zero{Dynamic.colorFormats = [KHR.format (sFormat initialSC)]}
       () -- no specialization constants
       [ (Vk.SHADER_STAGE_VERTEX_BIT, Triangle.vertCode)
       , (Vk.SHADER_STAGE_FRAGMENT_BIT, Triangle.fragCode)

examples/triangle-headless-dynamic/Main.hs

@@ -61,7 +61,6 @@ main = runResourceT $ do
   results <- render hvAllocator hvDevice graphicsQueueFamilyIndex
   Vk.deviceWaitIdle hvDevice
 
-  -- Save each variant and report its centre pixel.
   centres <- forM results $ \(name, image) -> do
     savePng ("headless-dynamic-" <> name <> ".png") image
     let
@@ -102,21 +101,15 @@ render allocator dev graphicsQueueFamilyIndex = do
     imageFormat = Vk.FORMAT_R8G8B8A8_UNORM
     extent = Vk.Extent2D width height
 
-  -- GPU render target (color attachment + transfer source) with its view.
   (_, (image, imageView)) <- createColorTarget allocator dev imageFormat extent
 
-  -- CPU readback image + its reader.
   (cpuImage, readback) <- makeReadbackImage allocator dev imageFormat extent
 
   -- One pipeline, full always-on dynamic state (Nothing).
   (_, pipeline) <-
-    Dynamic.createPipelineFromShaders
+    Dynamic.allocatePipelineFromShaders
       dev
-      [imageFormat]
-      Nothing -- no depth attachment
-      zero -- no vertex input
-      Nothing -- full always-on dynamic state
-      Nothing -- empty pipeline layout (no descriptor sets / push constants)
+      zero{Dynamic.colorFormats = [imageFormat]}
       () -- no specialization constants
       [(Vk.SHADER_STAGE_VERTEX_BIT, vertCode), (Vk.SHADER_STAGE_FRAGMENT_BIT, fragCode)]