From b58328c030226c31395c54b68e3b86320574475b Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Tue, 30 Jun 2026 22:25:26 +0300 Subject: [PATCH 1/4] vulkan-utils: More utils in preparation for reflected pipelines - Vulkan.Utils.PipelineLayout (new): mergeDescriptorSetLayoutBindings / mergePushConstantRanges fold each stage's bindings into one entry with the stage flags OR-ed; DescriptorBindingConflict reports irreconcilable types. - DynamicRendering / RenderPass: a PipelineConfig record (+Zero) for createPipeline / createPipelineFromShaders, replacing the long positional args. - Descriptors: combinedImageSamplerWrite alongside the samplerless imageWrite. Co-Authored-By: Claude Opus 4.8 --- examples/depth-headless/Main.hs | 10 +- examples/hlsl/Main.hs | 9 +- examples/lib/Triangle.hs | 9 +- examples/triangle-dynamic/TriangleDynamic.hs | 6 +- examples/triangle-headless-dynamic/Main.hs | 6 +- examples/triangle-headless/Main.hs | 2 +- package.yaml | 4 +- utils/changelog.md | 10 +- utils/package.yaml | 10 +- utils/src/Vulkan/Utils/Descriptors.hs | 32 +++++- utils/src/Vulkan/Utils/DynamicRendering.hs | 101 ++++++++-------- .../Vulkan/Utils/Pipeline/Specialization.hs | 7 -- utils/src/Vulkan/Utils/PipelineLayout.hs | 108 ++++++++++++++++++ utils/src/Vulkan/Utils/RenderPass.hs | 82 +++++++------ utils/vulkan-utils.cabal | 15 +-- vulkan.cabal | 8 +- 16 files changed, 279 insertions(+), 140 deletions(-) create mode 100644 utils/src/Vulkan/Utils/PipelineLayout.hs diff --git a/examples/depth-headless/Main.hs b/examples/depth-headless/Main.hs index a716187b8..fda7d827c 100644 --- a/examples/depth-headless/Main.hs +++ b/examples/depth-headless/Main.hs @@ -188,11 +188,11 @@ render allocator dev graphicsQueueFamilyIndex = do (_, pipeline) <- Dynamic.createPipelineFromShaders 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)] diff --git a/examples/hlsl/Main.hs b/examples/hlsl/Main.hs index 4e87c9c35..8fe436f8c 100644 --- a/examples/hlsl/Main.hs +++ b/examples/hlsl/Main.hs @@ -81,11 +81,10 @@ createPipeline dev renderPass colorFormat = RenderPass.createPipelineFromShaders 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) diff --git a/examples/lib/Triangle.hs b/examples/lib/Triangle.hs index c382ad0a1..7700afcd4 100644 --- a/examples/lib/Triangle.hs +++ b/examples/lib/Triangle.hs @@ -115,11 +115,10 @@ createGraphicsPipeline dev renderPass colorFormat = RenderPass.createPipelineFromShaders 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) diff --git a/examples/triangle-dynamic/TriangleDynamic.hs b/examples/triangle-dynamic/TriangleDynamic.hs index b9e88b69f..ea17492cc 100644 --- a/examples/triangle-dynamic/TriangleDynamic.hs +++ b/examples/triangle-dynamic/TriangleDynamic.hs @@ -55,11 +55,7 @@ runTriangle vc initialSC getDrawableSize shouldQuit = do (_, pipeline) <- Dynamic.createPipelineFromShaders (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) diff --git a/examples/triangle-headless-dynamic/Main.hs b/examples/triangle-headless-dynamic/Main.hs index 6952f3529..576a36be3 100644 --- a/examples/triangle-headless-dynamic/Main.hs +++ b/examples/triangle-headless-dynamic/Main.hs @@ -112,11 +112,7 @@ render allocator dev graphicsQueueFamilyIndex = do (_, pipeline) <- Dynamic.createPipelineFromShaders 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)] diff --git a/examples/triangle-headless/Main.hs b/examples/triangle-headless/Main.hs index fc58027ae..2a94d834e 100644 --- a/examples/triangle-headless/Main.hs +++ b/examples/triangle-headless/Main.hs @@ -180,7 +180,7 @@ render allocator dev graphicsQueueFamilyIndex = do -- Create the most vanilla rendering pipeline (vertKey, vertStage) <- shaderStage dev Vk.SHADER_STAGE_VERTEX_BIT () vertCode (fragKey, fragStage) <- shaderStage dev Vk.SHADER_STAGE_FRAGMENT_BIT () fragCode - (_, graphicsPipeline) <- RenderPass.createPipeline dev renderPass [imageFormat] Nothing zero (Just minimalDynamicStates) Nothing [vertStage, fragStage] + (_, graphicsPipeline) <- RenderPass.createPipeline dev renderPass zero{RenderPass.colorFormats = [imageFormat], RenderPass.dynamicStates = Just minimalDynamicStates} [vertStage, fragStage] release vertKey release fragKey diff --git a/package.yaml b/package.yaml index a9c2e2ecb..812cbd2ff 100644 --- a/package.yaml +++ b/package.yaml @@ -3,8 +3,8 @@ version: "3.27" synopsis: Bindings to the Vulkan graphics API. description: Please see [the readme](https://github.com/expipiplus1/vulkan/#readme) category: Graphics -maintainer: Ellie Hermaszewska -github: expipiplus1/vulkan +maintainer: IC Rainbow , Ellie Hermaszewska +github: haskell-game/vulkan extra-source-files: - readme.md - changelog.md diff --git a/utils/changelog.md b/utils/changelog.md index 04f5feaa8..59b7560df 100644 --- a/utils/changelog.md +++ b/utils/changelog.md @@ -1,10 +1,12 @@ # Change Log -## [0.5.11.0] - 2026-06-13 +## [0.6.0] - 2026-06-30 A large additive release: helpers for dynamic rendering, dynamic pipeline state, specialization constants, synchronization, swapchain/frame management, -and window abstraction. No existing API was removed. +and window abstraction. + +No existing API was removed, but the baseline is vulkan-3.27 and GHC-9.2. ### Pipelines and dynamic rendering - `Vulkan.Utils.DynamicRendering`: `createPipeline` and @@ -19,8 +21,7 @@ and window abstraction. No existing API was removed. states available without vendor or experimental extensions. - `Vulkan.Utils.Pipeline.Specialization`: the `Specialization` and `SpecializationConst` classes with `withSpecialization` / - `allocateSpecialization` for packing specialization constants into 32-bit - units. + `allocateSpecialization` for packing specialization constants. - `Vulkan.Utils.RenderPass`: `createRenderPass`, `createColorRenderPass`, and a generic `createPipeline` / `createPipelineFromShaders`. - `Vulkan.Utils.Framebuffer`: `createFramebuffer`. @@ -55,7 +56,6 @@ and window abstraction. No existing API was removed. ### Dependencies - Now depends on `unagi-chan` and `unliftio-core`. -- Raised the upper bound on `vulkan` to `< 3.28`. ## [0.5.10.6] - 2023-10-21 diff --git a/utils/package.yaml b/utils/package.yaml index 08d73d6f5..9e2e6c84f 100644 --- a/utils/package.yaml +++ b/utils/package.yaml @@ -1,9 +1,9 @@ name: vulkan-utils -version: "0.5.11.0" +version: "0.6.0" synopsis: Utils for the vulkan package category: Graphics -maintainer: Ellie Hermaszewska -github: expipiplus1/vulkan +maintainer: IC Rainbow , Ellie Hermaszewska +github: haskell-game/vulkan extra-source-files: - readme.md - changelog.md @@ -23,7 +23,7 @@ library: - Vulkan.Utils.ShaderQQ.HLSL dependencies: - - base <5 + - base >= 4.16 && <5 - bytestring - containers - extra @@ -39,7 +39,7 @@ library: - unliftio-core - unordered-containers - vector - - vulkan >= 3.6.14 && < 3.28 + - vulkan >= 3.27 && < 3.28 tests: doctests: diff --git a/utils/src/Vulkan/Utils/Descriptors.hs b/utils/src/Vulkan/Utils/Descriptors.hs index b11239ebc..f9c0afd78 100644 --- a/utils/src/Vulkan/Utils/Descriptors.hs +++ b/utils/src/Vulkan/Utils/Descriptors.hs @@ -2,15 +2,17 @@ {-| Single-resource descriptor writes for 'Vk.updateDescriptorSets'. 'bufferWrite' covers the whole-buffer case (a uniform or storage buffer -bound in its entirety); 'imageWrite' is its image-flavoured sibling for -samplerless bindings (a storage image in @GENERAL@ layout, a sampled -image in @SHADER_READ_ONLY_OPTIMAL@, …). Bindings needing partial buffer -ranges, descriptor arrays or samplers are out of scope — assemble those -'Vk.WriteDescriptorSet's directly. +bound in its entirety); 'imageWrite' is its samplerless image sibling (a +storage image in @GENERAL@ layout, a sampled image in +@SHADER_READ_ONLY_OPTIMAL@, …); 'combinedImageSamplerWrite' binds an image +together with a sampler. Bindings needing partial buffer ranges or +descriptor arrays are out of scope — assemble those 'Vk.WriteDescriptorSet's +directly. -} module Vulkan.Utils.Descriptors ( bufferWrite , imageWrite + , combinedImageSamplerWrite ) where import Data.Word (Word32) @@ -57,3 +59,23 @@ imageWrite set binding descriptorType layout view = , Vk.descriptorCount = 1 , Vk.imageInfo = [Vk.DescriptorImageInfo Vk.NULL_HANDLE view layout] } + +-- | A combined image+sampler descriptor write ('Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER'). +combinedImageSamplerWrite + :: Vk.DescriptorSet + -> Word32 + -- ^ Binding. + -> Vk.Sampler + -> Vk.ImageView + -> Vk.ImageLayout + -- ^ The layout the image will be in when the set is bound. + -> SomeStruct Vk.WriteDescriptorSet +combinedImageSamplerWrite set binding sampler view layout = + SomeStruct + zero + { Vk.dstSet = set + , Vk.dstBinding = binding + , Vk.descriptorType = Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER + , Vk.descriptorCount = 1 + , Vk.imageInfo = [Vk.DescriptorImageInfo sampler view layout] + } diff --git a/utils/src/Vulkan/Utils/DynamicRendering.hs b/utils/src/Vulkan/Utils/DynamicRendering.hs index d1e001d55..899d70093 100644 --- a/utils/src/Vulkan/Utils/DynamicRendering.hs +++ b/utils/src/Vulkan/Utils/DynamicRendering.hs @@ -14,7 +14,8 @@ the @dynamicRendering@ feature on the device. -} module Vulkan.Utils.DynamicRendering ( -- * Pipeline - createPipeline + PipelineConfig (..) + , createPipeline , createPipelineFromShaders -- * Device requirements @@ -40,7 +41,7 @@ import Vulkan.Utils.DynamicState (defaultDynamicStatesFor) import Vulkan.Utils.Pipeline.Internal (basePipelineCreateInfo, buildColorPipeline, withCompiledStages) import Vulkan.Utils.Pipeline.Specialization (Specialization) import qualified Vulkan.Utils.Requirements.TH as U -import Vulkan.Zero (zero) +import Vulkan.Zero (Zero (..)) {- | The device requirements for this path: the @VK_KHR_dynamic_rendering@ extension (core since Vulkan 1.3) and the @dynamicRendering@ feature it gates. @@ -54,55 +55,72 @@ dynamicRenderingRequirements = PhysicalDeviceDynamicRenderingFeatures.dynamicRendering |] -{- | Build a graphics pipeline for the dynamic-rendering path: no render pass, the -attachment formats carried in a 'PipelineRenderingCreateInfo' on the pNext chain. -The attachment shape — colour formats and optional depth — selects the pipeline -kind: - - * @[fmt] Nothing@ — a single-colour pipeline (as the classic path). - * @[fmt] (Just d)@ — colour + depth (depth driven dynamically). - * @[] (Just d)@ — depth-only (e.g. a shadow map / z-prepass). - * @[f0, f1, …] mDepth@ — multiple colour attachments (MRT / G-buffer). +{- | Attachment + fixed-function knobs for a dynamic-rendering pipeline. -Stencil is out of scope: no @stencilAttachmentFormat@ is declared, matching -'renderingInfo', which never supplies a stencil attachment (declaring one -without supplying it is invalid at draw time). Use a depth-only @depth@ format; -for stencil, build the 'PipelineRenderingCreateInfo' and 'Vk.RenderingInfo' by -hand. The formats MUST match the views passed to 'Vk.cmdUseRendering' at draw -time (see 'renderingInfo'). Intended to be used qualified, e.g. -@Dynamic.createPipeline@. +Construct with 'zero' and override what differs, e.g. +@zero { Dynamic.colorFormats = [fmt], Dynamic.depthFormat = Just d }@. -} -createPipeline - :: (MonadResource m, MonadFail m) - => Vk.Device - -> Vector Vk.Format - -- ^ Colour attachment formats (@0@..@N@). - -> Maybe Vk.Format +data PipelineConfig = PipelineConfig + { colorFormats :: [Vk.Format] + -- ^ Colour attachment formats (@0@..@N@); @[]@ for a depth-only pipeline. + , depthFormat :: Maybe Vk.Format -- ^ Optional depth attachment format. - -> Vk.PipelineVertexInputStateCreateInfo '[] - -- ^ Vertex input (bindings + attributes); @zero@ for none. - -> Maybe (Vector Vk.DynamicState) + , vertexInput :: Vk.PipelineVertexInputStateCreateInfo '[] + -- ^ Vertex input (bindings + attributes); 'zero' for none. + , dynamicStates :: Maybe (Vector Vk.DynamicState) {- ^ Dynamic states; 'Nothing' defaults layout-aware to 'Vulkan.Utils.DynamicState.depthOnlyDynamicStates' (no colour) or 'allDynamicStates'. Drive with 'Vulkan.Utils.DynamicState.applyDynamicStates'. -} - -> Maybe Vk.PipelineLayout + , layout :: Maybe Vk.PipelineLayout {- ^ Pipeline layout for descriptor sets \/ push constants; 'Nothing' uses a transient empty layout (shaders take no resources). A supplied layout stays owned by the caller, who must keep it alive for the pipeline's lifetime. -} + } + +instance Zero PipelineConfig where + zero = + PipelineConfig + { colorFormats = [] + , depthFormat = Nothing + , vertexInput = zero + , dynamicStates = Nothing + , layout = Nothing + } + +{- | Build a graphics pipeline for the dynamic-rendering path: no render pass, the +attachment formats carried in a 'PipelineRenderingCreateInfo' on the pNext chain. +The attachment shape — 'colorFormats' and 'depthFormat' — selects the pipeline kind: + + * @[fmt]@ + 'Nothing' — a single-colour pipeline (as the classic path). + * @[fmt]@ + @Just d@ — colour + depth (depth driven dynamically). + * @[]@ + @Just d@ — depth-only (e.g. a shadow map / z-prepass). + * @[f0, f1, …]@ — multiple colour attachments (MRT / G-buffer). + +Stencil is out of scope: no @stencilAttachmentFormat@ is declared, matching +'renderingInfo', which never supplies a stencil attachment (declaring one +without supplying it is invalid at draw time). For stencil, build the +'PipelineRenderingCreateInfo' and 'Vk.RenderingInfo' by hand. The formats MUST +match the views passed to 'Vk.cmdUseRendering' at draw time (see 'renderingInfo'). +Intended to be used qualified, e.g. @Dynamic.createPipeline@. +-} +createPipeline + :: (MonadResource m, MonadFail m) + => Vk.Device + -> PipelineConfig -> Vector (SomeStruct Vk.PipelineShaderStageCreateInfo) -> m (ReleaseKey, Vk.Pipeline) -createPipeline dev colorFormats depthFormat vertexInput dynamicStates pipelineLayout stages = - buildColorPipeline dev pipelineLayout $ \layout -> +createPipeline dev PipelineConfig{..} stages = + buildColorPipeline dev layout $ \resolvedLayout -> SomeStruct $ basePipelineCreateInfo - layout + resolvedLayout Nothing - (V.length colorFormats) + (length colorFormats) (isJust depthFormat) vertexInput - (fromMaybe (defaultDynamicStatesFor (not (V.null colorFormats))) dynamicStates) + (fromMaybe (defaultDynamicStatesFor (not (null colorFormats))) dynamicStates) stages ::& renderingCreateInfo :& () @@ -110,7 +128,7 @@ createPipeline dev colorFormats depthFormat vertexInput dynamicStates pipelineLa renderingCreateInfo :: PipelineRenderingCreateInfo renderingCreateInfo = zero - { colorAttachmentFormats = colorFormats + { colorAttachmentFormats = V.fromList colorFormats , depthAttachmentFormat = fromMaybe Vk.FORMAT_UNDEFINED depthFormat } @@ -120,23 +138,14 @@ module, build the pipeline, then release the now-redundant module handles. createPipelineFromShaders :: (MonadResource m, MonadUnliftIO m, MonadFail m, Specialization spec) => Vk.Device - -> [Vk.Format] - -- ^ Colour attachment formats. - -> Maybe Vk.Format - -- ^ Optional depth attachment format. - -> Vk.PipelineVertexInputStateCreateInfo '[] - -- ^ Vertex input (bindings + attributes); @zero@ for none. - -> Maybe (Vector Vk.DynamicState) - -- ^ Dynamic states (see 'createPipeline'). - -> Maybe Vk.PipelineLayout - -- ^ Pipeline layout (see 'createPipeline'); 'Nothing' for an empty one. + -> PipelineConfig -> spec -- ^ Specialization shared by every stage (see "Vulkan.Utils.Pipeline.Specialization"); @()@ for none. -> [(Vk.ShaderStageFlagBits, ByteString)] -> m (ReleaseKey, Vk.Pipeline) -createPipelineFromShaders dev colorFormats depthFormat vertexInput dynamicStates pipelineLayout spec shaders = +createPipelineFromShaders dev config spec shaders = withCompiledStages dev spec shaders $ - createPipeline dev (V.fromList colorFormats) depthFormat vertexInput dynamicStates pipelineLayout + createPipeline dev config {- | A 'Vk.RenderingInfo' targeting a single color attachment that is cleared on load and stored on completion. The attachment is expected to already be in diff --git a/utils/src/Vulkan/Utils/Pipeline/Specialization.hs b/utils/src/Vulkan/Utils/Pipeline/Specialization.hs index 6a48c9a21..11719d503 100644 --- a/utils/src/Vulkan/Utils/Pipeline/Specialization.hs +++ b/utils/src/Vulkan/Utils/Pipeline/Specialization.hs @@ -1,13 +1,6 @@ {-| Specialization constants, normalized to stacks of 32-bit units. -32 bits is both the minimal and the maximal size of a Vulkan specialization -constant (they may only be scalar @int@/@uint@/@float@/@bool@; @double@ is the -lone exception and is not supported here), so every constant maps to exactly one -'Word32' slot. That makes the layout trivial: the @n@th value packs into -@constantID = n@ at @offset = n * 4@ with @size = 4@. Shaders therefore declare -their constants with matching @constant_id@s counting from zero, in the same -order as the Haskell tuple/list passed here. @ data MySpec = MySpec { width :: Word32, height :: Word32, scale :: Float } diff --git a/utils/src/Vulkan/Utils/PipelineLayout.hs b/utils/src/Vulkan/Utils/PipelineLayout.hs new file mode 100644 index 000000000..9d7f183ee --- /dev/null +++ b/utils/src/Vulkan/Utils/PipelineLayout.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE NoFieldSelectors #-} + +{-| Assemble a pipeline's descriptor-set-layout bindings and push-constant ranges +from the per-stage contributions of several shaders. + +A binding (or push-constant range) declared by more than one stage must become a +single entry whose 'Vk.stageFlags' is the OR of the contributing stages — that is +what a pipeline layout shared between, say, a vertex and a fragment shader needs. +'mergeDescriptorSetLayoutBindings' and 'mergePushConstantRanges' do that merge on +plain Vulkan values, independent of where the per-stage bindings came from (hand +written, or reflected — see @vulkan-utils-spirv@). +-} +module Vulkan.Utils.PipelineLayout + ( mergeDescriptorSetLayoutBindings + , mergePushConstantRanges + , DescriptorBindingConflict (..) + ) where + +import Control.Monad (foldM) +import Data.Bits ((.|.)) +import Data.Foldable (toList) +import Data.List (foldl') +import qualified Data.Map.Strict as Map +import Data.Word (Word32) +import qualified Vulkan.Core10 as Vk +import Vulkan.Zero (zero) + +{- | Two stages declared the same binding number with different descriptor types, +which cannot be reconciled into one binding. +-} +data DescriptorBindingConflict = DescriptorBindingConflict + { binding :: Word32 + -- ^ The binding number the stages disagree on. + , types :: (Vk.DescriptorType, Vk.DescriptorType) + -- ^ The two differing descriptor types. + } + deriving (Eq, Show) + +{- | Merge the descriptor-set-layout bindings contributed by several stages for a +single descriptor set. Bindings sharing a binding number are combined: their +'Vk.stageFlags' are OR-ed and their 'Vk.descriptorCount's maxed. A +'Vk.descriptorType' disagreement is a 'Left'. The result is ascending by +binding number. + +Each input binding should carry the one stage that declares it (its +'Vk.stageFlags' set to that stage); the merge turns the per-stage bindings +into one multi-stage binding per binding number. +-} +mergeDescriptorSetLayoutBindings + :: (Foldable f) + => f Vk.DescriptorSetLayoutBinding + -> Either DescriptorBindingConflict [Vk.DescriptorSetLayoutBinding] +mergeDescriptorSetLayoutBindings bindings = + fmap (fmap snd . Map.toAscList) (foldM step Map.empty (toList bindings)) + where + step acc b = case Map.lookup (bindingNumber b) acc of + Nothing -> Right (Map.insert (bindingNumber b) b acc) + Just b0 -> (\b' -> Map.insert (bindingNumber b) b' acc) <$> combine b0 b + + combine b0 b1 + | t0 /= t1 = Left (DescriptorBindingConflict (bindingNumber b0) (t0, t1)) + | otherwise = + Right + ( b0 + { Vk.stageFlags = bindingStages b0 .|. bindingStages b1 + , Vk.descriptorCount = max (bindingCount b0) (bindingCount b1) + } + ) + where + t0 = bindingType b0 + t1 = bindingType b1 + +{- | Merge the push-constant ranges contributed by several stages: ranges sharing +the same @(offset, size)@ have their 'Vk.stageFlags' OR-ed. The result is +ascending by offset. +-} +mergePushConstantRanges + :: (Foldable f) => f Vk.PushConstantRange -> [Vk.PushConstantRange] +mergePushConstantRanges ranges = + [ zero{Vk.stageFlags = stage, Vk.offset = off, Vk.size = sz} + | ((off, sz), stage) <- Map.toAscList byRange + ] + where + byRange = foldl' add Map.empty (toList ranges) + add m r = Map.insertWith (.|.) (rangeOffset r, rangeSize r) (rangeStages r) m + +-- Field accessors (the constructor disambiguates DuplicateRecordFields). + +bindingNumber :: Vk.DescriptorSetLayoutBinding -> Word32 +bindingNumber Vk.DescriptorSetLayoutBinding{Vk.binding = b} = b + +bindingType :: Vk.DescriptorSetLayoutBinding -> Vk.DescriptorType +bindingType Vk.DescriptorSetLayoutBinding{Vk.descriptorType = t} = t + +bindingStages :: Vk.DescriptorSetLayoutBinding -> Vk.ShaderStageFlags +bindingStages Vk.DescriptorSetLayoutBinding{Vk.stageFlags = s} = s + +bindingCount :: Vk.DescriptorSetLayoutBinding -> Word32 +bindingCount Vk.DescriptorSetLayoutBinding{Vk.descriptorCount = c} = c + +rangeOffset :: Vk.PushConstantRange -> Word32 +rangeOffset Vk.PushConstantRange{Vk.offset = o} = o + +rangeSize :: Vk.PushConstantRange -> Word32 +rangeSize Vk.PushConstantRange{Vk.size = s} = s + +rangeStages :: Vk.PushConstantRange -> Vk.ShaderStageFlags +rangeStages Vk.PushConstantRange{Vk.stageFlags = s} = s diff --git a/utils/src/Vulkan/Utils/RenderPass.hs b/utils/src/Vulkan/Utils/RenderPass.hs index a4bc03663..69863e395 100644 --- a/utils/src/Vulkan/Utils/RenderPass.hs +++ b/utils/src/Vulkan/Utils/RenderPass.hs @@ -14,6 +14,7 @@ module Vulkan.Utils.RenderPass , createColorRenderPass -- * Pipeline + , PipelineConfig (..) , createPipeline , createPipelineFromShaders ) where @@ -30,7 +31,7 @@ import qualified Vulkan.Core10 as Vk import Vulkan.Utils.DynamicState (defaultDynamicStatesFor) import Vulkan.Utils.Pipeline.Internal (basePipelineCreateInfo, buildColorPipeline, withCompiledStages) import Vulkan.Utils.Pipeline.Specialization (Specialization) -import Vulkan.Zero (zero) +import Vulkan.Zero (Zero (..)) {- | A render pass with @colors@ colour attachments (each @(format, finalLayout)@) and an optional depth attachment, all cleared on load and stored on completion, in @@ -166,42 +167,62 @@ createColorRenderPass createColorRenderPass dev imageFormat finalLayout = createRenderPass dev [(imageFormat, finalLayout)] Nothing +{- | Attachment + fixed-function knobs for a render-pass pipeline. + +Construct with 'zero' and override what differs, e.g. +@zero { RenderPass.colorFormats = [fmt], RenderPass.depthFormat = Just d }@. The +attachment shape — 'colorFormats' count and whether 'depthFormat' is present — MUST +match the render pass; the formats themselves live in the render pass, so only the +count and depth presence are read here. +-} +data PipelineConfig = PipelineConfig + { colorFormats :: [Vk.Format] + -- ^ Colour attachment formats; only the count is read (must match the render pass). + , depthFormat :: Maybe Vk.Format + -- ^ Optional depth attachment; only its presence is read (must match the render pass). + , vertexInput :: Vk.PipelineVertexInputStateCreateInfo '[] + -- ^ Vertex input (bindings + attributes); 'zero' for none. + , dynamicStates :: Maybe (Vector Vk.DynamicState) + -- ^ Dynamic states; 'Nothing' defaults layout-aware (see "Vulkan.Utils.DynamicState"). + , layout :: Maybe Vk.PipelineLayout + {- ^ Pipeline layout for descriptor sets \/ push constants; 'Nothing' uses a + transient empty layout (shaders take no resources). A supplied layout stays + owned by the caller, who must keep it alive for the pipeline's lifetime. + -} + } + +instance Zero PipelineConfig where + zero = + PipelineConfig + { colorFormats = [] + , depthFormat = Nothing + , vertexInput = zero + , dynamicStates = Nothing + , layout = Nothing + } + {- | A vanilla vertex+fragment pipeline targeting @renderPass@ (subpass 0). The -attachment shape — @colorFormats@ count and whether @depthFormat@ is present — MUST -match @renderPass@; the formats themselves live in the render pass, so only the -count and depth presence are read here (taking the same vectors keeps one -description shared with 'createRenderPass'). The dynamic-state set is layout-aware -when 'Nothing' (see "Vulkan.Utils.DynamicState"); whatever is dynamic MUST be set -before drawing. Intended to be used qualified, e.g. @RenderPass.createPipeline@. +'PipelineConfig' attachment shape MUST match @renderPass@. Whatever dynamic state +is selected MUST be set before drawing. Intended to be used qualified, e.g. +@RenderPass.createPipeline@. -} createPipeline :: (MonadResource m, MonadFail m) => Vk.Device -> Vk.RenderPass - -> Vector Vk.Format - -- ^ Colour attachment formats (count must match the render pass). - -> Maybe Vk.Format - -- ^ Optional depth attachment (presence must match the render pass). - -> Vk.PipelineVertexInputStateCreateInfo '[] - -- ^ Vertex input (bindings + attributes); @zero@ for none. - -> Maybe (Vector Vk.DynamicState) - -> Maybe Vk.PipelineLayout - {- ^ Pipeline layout for descriptor sets \/ push constants; 'Nothing' uses a - transient empty layout (shaders take no resources). A supplied layout stays - owned by the caller, who must keep it alive for the pipeline's lifetime. - -} + -> PipelineConfig -> Vector (SomeStruct Vk.PipelineShaderStageCreateInfo) -> m (ReleaseKey, Vk.Pipeline) -createPipeline dev renderPass colorFormats depthFormat vertexInput dynamicStates pipelineLayout stages = - buildColorPipeline dev pipelineLayout $ \layout -> +createPipeline dev renderPass PipelineConfig{..} stages = + buildColorPipeline dev layout $ \resolvedLayout -> SomeStruct ( basePipelineCreateInfo - layout + resolvedLayout (Just renderPass) - (V.length colorFormats) + (length colorFormats) (isJust depthFormat) vertexInput - (fromMaybe (defaultDynamicStatesFor (not (V.null colorFormats))) dynamicStates) + (fromMaybe (defaultDynamicStatesFor (not (null colorFormats))) dynamicStates) stages ) @@ -215,15 +236,10 @@ createPipelineFromShaders :: (MonadResource m, MonadUnliftIO m, MonadFail m, Specialization spec) => Vk.Device -> Vk.RenderPass - -> Vector Vk.Format - -> Maybe Vk.Format - -> Vk.PipelineVertexInputStateCreateInfo '[] - -> Maybe (Vector Vk.DynamicState) - -> Maybe Vk.PipelineLayout - -- ^ Pipeline layout (see 'createPipeline'); 'Nothing' for an empty one. + -> PipelineConfig -> spec + -- ^ Specialization shared by every stage; @()@ for none. -> [(Vk.ShaderStageFlagBits, ByteString)] -> m (ReleaseKey, Vk.Pipeline) -createPipelineFromShaders dev renderPass colorFormats depthFormat vertexInput dynamicStates pipelineLayout spec shaders = - withCompiledStages dev spec shaders $ \stages -> - createPipeline dev renderPass colorFormats depthFormat vertexInput dynamicStates pipelineLayout stages +createPipelineFromShaders dev renderPass config spec shaders = + withCompiledStages dev spec shaders (createPipeline dev renderPass config) diff --git a/utils/vulkan-utils.cabal b/utils/vulkan-utils.cabal index cb7839216..19e762668 100644 --- a/utils/vulkan-utils.cabal +++ b/utils/vulkan-utils.cabal @@ -5,12 +5,12 @@ cabal-version: 1.24 -- see: https://github.com/sol/hpack name: vulkan-utils -version: 0.5.11.0 +version: 0.6.0 synopsis: Utils for the vulkan package category: Graphics -homepage: https://github.com/expipiplus1/vulkan#readme -bug-reports: https://github.com/expipiplus1/vulkan/issues -maintainer: Ellie Hermaszewska +homepage: https://github.com/haskell-game/vulkan#readme +bug-reports: https://github.com/haskell-game/vulkan/issues +maintainer: IC Rainbow , Ellie Hermaszewska license: BSD3 license-file: LICENSE build-type: Custom @@ -22,7 +22,7 @@ extra-source-files: source-repository head type: git - location: https://github.com/expipiplus1/vulkan + location: https://github.com/haskell-game/vulkan custom-setup setup-depends: @@ -46,6 +46,7 @@ library Vulkan.Utils.Misc Vulkan.Utils.Pipeline.Internal Vulkan.Utils.Pipeline.Specialization + Vulkan.Utils.PipelineLayout Vulkan.Utils.QueueAssignment Vulkan.Utils.Queues Vulkan.Utils.RefCounted @@ -114,7 +115,7 @@ library c-sources: cbits/DebugCallback.c build-depends: - base <5 + base >=4.16 && <5 , bytestring , containers , extra @@ -130,7 +131,7 @@ library , unliftio-core , unordered-containers , vector - , vulkan >=3.6.14 && <3.28 + , vulkan ==3.27.* default-language: Haskell2010 test-suite doctests diff --git a/vulkan.cabal b/vulkan.cabal index df0161366..21709b09f 100644 --- a/vulkan.cabal +++ b/vulkan.cabal @@ -9,9 +9,9 @@ version: 3.27 synopsis: Bindings to the Vulkan graphics API. description: Please see [the readme](https://github.com/expipiplus1/vulkan/#readme) category: Graphics -homepage: https://github.com/expipiplus1/vulkan#readme -bug-reports: https://github.com/expipiplus1/vulkan/issues -maintainer: Ellie Hermaszewska +homepage: https://github.com/haskell-game/vulkan#readme +bug-reports: https://github.com/haskell-game/vulkan/issues +maintainer: IC Rainbow , Ellie Hermaszewska license: BSD-3-Clause license-file: LICENSE build-type: Simple @@ -22,7 +22,7 @@ extra-source-files: source-repository head type: git - location: https://github.com/expipiplus1/vulkan + location: https://github.com/haskell-game/vulkan flag darwin-lib-dirs description: Add default LunarG MoltenVK SDK paths to extra-lib-dirs when building on MacOS. Requires Cabal >=3.10.3. From da44f98a6d1efe1ff2e4cae506278ccf590c0ccd Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Wed, 1 Jul 2026 01:36:35 +0300 Subject: [PATCH 2/4] Function naming normalization --- examples/depth-headless/Main.hs | 2 +- examples/hlsl/Main.hs | 6 +- examples/lib/HeadlessBoot.hs | 6 +- examples/lib/Triangle.hs | 6 +- examples/lib/WindowedBoot.hs | 14 ++-- examples/resize/Main.hs | 4 +- examples/triangle-dynamic/TriangleDynamic.hs | 4 +- examples/triangle-headless-dynamic/Main.hs | 2 +- examples/triangle-headless/Main.hs | 4 +- .../src/Vulkan/Utils/Init/GLFW.hs | 25 ++++--- .../src/Vulkan/Utils/Init/GLFW/Window.hs | 4 +- .../src/Vulkan/Utils/Init/SDL2.hs | 25 ++++--- .../src/Vulkan/Utils/Init/SDL2/Window.hs | 4 +- utils/changelog.md | 33 +++++--- utils/package.yaml | 2 +- utils/src/Vulkan/Utils/DynamicRendering.hs | 22 +++--- utils/src/Vulkan/Utils/DynamicState.hs | 4 +- utils/src/Vulkan/Utils/Frame.hs | 12 +-- utils/src/Vulkan/Utils/Framebuffer.hs | 6 +- utils/src/Vulkan/Utils/Init/Headless.hs | 10 +-- utils/src/Vulkan/Utils/Initialization.hs | 75 +++++++++++++++---- utils/src/Vulkan/Utils/Queues.hs | 14 ++-- utils/src/Vulkan/Utils/RenderPass.hs | 34 ++++----- utils/src/Vulkan/Utils/Swapchain.hs | 20 ++--- utils/src/Vulkan/Utils/WindowAdapter.hs | 4 +- utils/vulkan-utils.cabal | 2 +- 26 files changed, 200 insertions(+), 144 deletions(-) diff --git a/examples/depth-headless/Main.hs b/examples/depth-headless/Main.hs index fda7d827c..7ceaad360 100644 --- a/examples/depth-headless/Main.hs +++ b/examples/depth-headless/Main.hs @@ -186,7 +186,7 @@ render allocator dev graphicsQueueFamilyIndex = do ] } (_, pipeline) <- - Dynamic.createPipelineFromShaders + Dynamic.allocatePipelineFromShaders dev zero { Dynamic.colorFormats = [imageFormat] diff --git a/examples/hlsl/Main.hs b/examples/hlsl/Main.hs index 8fe436f8c..7e637a18b 100644 --- a/examples/hlsl/Main.hs +++ b/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,7 +78,7 @@ createPipeline -> Vk.Format -> m (ReleaseKey, Vk.Pipeline) createPipeline dev renderPass colorFormat = - RenderPass.createPipelineFromShaders + RenderPass.allocatePipelineFromShaders dev renderPass zero diff --git a/examples/lib/HeadlessBoot.hs b/examples/lib/HeadlessBoot.hs index 8a6b8baa8..a8133b592 100644 --- a/examples/lib/HeadlessBoot.hs +++ b/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 diff --git a/examples/lib/Triangle.hs b/examples/lib/Triangle.hs index 7700afcd4..71a28a71d 100644 --- a/examples/lib/Triangle.hs +++ b/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,7 +112,7 @@ createGraphicsPipeline -- ^ Colour attachment format (matches the render pass). -> m (ReleaseKey, Vk.Pipeline) createGraphicsPipeline dev renderPass colorFormat = - RenderPass.createPipelineFromShaders + RenderPass.allocatePipelineFromShaders dev renderPass zero diff --git a/examples/lib/WindowedBoot.hs b/examples/lib/WindowedBoot.hs index 8b6f1391c..49954ed43 100644 --- a/examples/lib/WindowedBoot.hs +++ b/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 diff --git a/examples/resize/Main.hs b/examples/resize/Main.hs index 2f7d38b13..f1d175e19 100644 --- a/examples/resize/Main.hs +++ b/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) diff --git a/examples/triangle-dynamic/TriangleDynamic.hs b/examples/triangle-dynamic/TriangleDynamic.hs index ea17492cc..aaebcafd9 100644 --- a/examples/triangle-dynamic/TriangleDynamic.hs +++ b/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,7 +53,7 @@ runTriangle -> ResourceT IO () runTriangle vc initialSC getDrawableSize shouldQuit = do (_, pipeline) <- - Dynamic.createPipelineFromShaders + Dynamic.allocatePipelineFromShaders (vcDevice vc) zero{Dynamic.colorFormats = [KHR.format (sFormat initialSC)]} () -- no specialization constants diff --git a/examples/triangle-headless-dynamic/Main.hs b/examples/triangle-headless-dynamic/Main.hs index 576a36be3..51607afd9 100644 --- a/examples/triangle-headless-dynamic/Main.hs +++ b/examples/triangle-headless-dynamic/Main.hs @@ -110,7 +110,7 @@ render allocator dev graphicsQueueFamilyIndex = do -- One pipeline, full always-on dynamic state (Nothing). (_, pipeline) <- - Dynamic.createPipelineFromShaders + Dynamic.allocatePipelineFromShaders dev zero{Dynamic.colorFormats = [imageFormat]} () -- no specialization constants diff --git a/examples/triangle-headless/Main.hs b/examples/triangle-headless/Main.hs index 2a94d834e..2b4a5d196 100644 --- a/examples/triangle-headless/Main.hs +++ b/examples/triangle-headless/Main.hs @@ -159,7 +159,7 @@ render allocator dev graphicsQueueFamilyIndex = do (_, imageView) <- Vk.withImageView dev imageViewCreateInfo Nothing allocate (_, renderPass) <- - RenderPass.createColorRenderPass + RenderPass.allocateColorRenderPass dev imageFormat Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL @@ -180,7 +180,7 @@ render allocator dev graphicsQueueFamilyIndex = do -- Create the most vanilla rendering pipeline (vertKey, vertStage) <- shaderStage dev Vk.SHADER_STAGE_VERTEX_BIT () vertCode (fragKey, fragStage) <- shaderStage dev Vk.SHADER_STAGE_FRAGMENT_BIT () fragCode - (_, graphicsPipeline) <- RenderPass.createPipeline dev renderPass zero{RenderPass.colorFormats = [imageFormat], RenderPass.dynamicStates = Just minimalDynamicStates} [vertStage, fragStage] + (_, graphicsPipeline) <- RenderPass.allocatePipeline dev renderPass zero{RenderPass.colorFormats = [imageFormat], RenderPass.dynamicStates = Just minimalDynamicStates} [vertStage, fragStage] release vertKey release fragKey diff --git a/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW.hs b/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW.hs index f841add5e..6edeb391c 100644 --- a/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW.hs +++ b/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW.hs @@ -1,6 +1,7 @@ {-| Vulkan initialization glue for GLFW windows. Compose with -'Vulkan.Utils.Init.withVulkanInstance' (or just call 'withInstance' here) -and the rest of @vulkan-utils@ to get a ready-to-render setup. +'Vulkan.Utils.Initialization.allocateVulkanInstance' (or just call +'allocateInstance' here) and the rest of @vulkan-utils@ to get a +ready-to-render setup. -} module Vulkan.Utils.Init.GLFW ( -- * Required extensions @@ -10,10 +11,10 @@ module Vulkan.Utils.Init.GLFW -- * Surface , createSurface , destroySurface - , withSurface + , allocateSurface -- * Instance - , withInstance + , allocateInstance ) where import Control.Exception (throwIO) @@ -44,7 +45,7 @@ import Vulkan.Extensions.VK_KHR_swapchain ( pattern KHR_SWAPCHAIN_EXTENSION_NAME ) import Vulkan.Requirement (InstanceRequirement) -import Vulkan.Utils.Initialization (withVulkanInstance) +import Vulkan.Utils.Initialization (allocateVulkanInstance) {- | Vulkan instance extensions GLFW requires. The window argument is unused (GLFW's API is global) but kept for symmetry with the SDL2 module. @@ -74,22 +75,22 @@ createSurface inst w = alloca $ \surfPtr -> do destroySurface :: Instance -> SurfaceKHR -> IO () destroySurface inst s = destroySurfaceKHR inst s Nothing --- | Bracketed surface creation in 'MonadResource'. -withSurface :: (MonadResource m) => Instance -> GLFW.Window -> m SurfaceKHR -withSurface inst w = +-- | Allocate a surface in 'MonadResource', released with the resource scope. +allocateSurface :: (MonadResource m) => Instance -> GLFW.Window -> m SurfaceKHR +allocateSurface inst w = snd <$> allocate (createSurface inst w) (destroySurface inst) {- | Build a Vulkan 'Instance' wired up with GLFW's required extensions. Composes 'getRequiredInstanceExtensions' and -'Vulkan.Utils.Init.withVulkanInstance'. +'Vulkan.Utils.Initialization.allocateVulkanInstance'. -} -withInstance +allocateInstance :: (MonadResource m) => GLFW.Window -> Maybe ApplicationInfo -> [InstanceRequirement] -> [InstanceRequirement] -> m Instance -withInstance w appInfo reqs optReqs = do +allocateInstance w appInfo reqs optReqs = do exts <- getRequiredInstanceExtensions w - withVulkanInstance exts appInfo reqs optReqs + allocateVulkanInstance exts appInfo reqs optReqs diff --git a/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW/Window.hs b/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW/Window.hs index 17399d4b8..b89f41a40 100644 --- a/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW/Window.hs +++ b/utils-init/vulkan-init-glfw/src/Vulkan/Utils/Init/GLFW/Window.hs @@ -73,8 +73,8 @@ drawableSize win = do glfwAdapter :: (MonadResource m) => GLFW.Window -> WindowAdapter m glfwAdapter w = WindowAdapter - { waWithInstance = Init.withInstance w - , waWithSurface = \i -> Init.withSurface i w + { waAllocateInstance = Init.allocateInstance w + , waAllocateSurface = \i -> Init.allocateSurface i w , waDrawableSize = drawableSize w } diff --git a/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2.hs b/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2.hs index 354000c48..44f10a5ce 100644 --- a/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2.hs +++ b/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2.hs @@ -1,6 +1,7 @@ {-| Vulkan initialization glue for SDL2 windows. Compose with -'Vulkan.Utils.Init.withVulkanInstance' (or just call 'withInstance' here) -and the rest of @vulkan-utils@ to get a ready-to-render setup. +'Vulkan.Utils.Initialization.allocateVulkanInstance' (or just call +'allocateInstance' here) and the rest of @vulkan-utils@ to get a +ready-to-render setup. -} module Vulkan.Utils.Init.SDL2 ( -- * Required extensions @@ -10,10 +11,10 @@ module Vulkan.Utils.Init.SDL2 -- * Surface , createSurface , destroySurface - , withSurface + , allocateSurface -- * Instance - , withInstance + , allocateInstance ) where import Control.Monad.IO.Class (MonadIO, liftIO) @@ -38,7 +39,7 @@ import Vulkan.Extensions.VK_KHR_swapchain ( pattern KHR_SWAPCHAIN_EXTENSION_NAME ) import Vulkan.Requirement (InstanceRequirement) -import Vulkan.Utils.Initialization (withVulkanInstance) +import Vulkan.Utils.Initialization (allocateVulkanInstance) -- | Vulkan instance extensions the SDL2 window requires for presentation. getRequiredInstanceExtensions :: (MonadIO m) => SDL.Window -> m (Vector ByteString) @@ -61,22 +62,22 @@ createSurface inst w = destroySurface :: Instance -> SurfaceKHR -> IO () destroySurface inst s = destroySurfaceKHR inst s Nothing --- | Bracketed surface creation in 'MonadResource'. -withSurface :: (MonadResource m) => Instance -> SDL.Window -> m SurfaceKHR -withSurface inst w = +-- | Allocate a surface in 'MonadResource', released with the resource scope. +allocateSurface :: (MonadResource m) => Instance -> SDL.Window -> m SurfaceKHR +allocateSurface inst w = snd <$> allocate (createSurface inst w) (destroySurface inst) {- | Build a Vulkan 'Instance' wired up with the SDL window's required extensions. Composes 'getRequiredInstanceExtensions' and -'Vulkan.Utils.Init.withVulkanInstance'. +'Vulkan.Utils.Initialization.allocateVulkanInstance'. -} -withInstance +allocateInstance :: (MonadResource m) => SDL.Window -> Maybe ApplicationInfo -> [InstanceRequirement] -> [InstanceRequirement] -> m Instance -withInstance w appInfo reqs optReqs = do +allocateInstance w appInfo reqs optReqs = do exts <- getRequiredInstanceExtensions w - withVulkanInstance exts appInfo reqs optReqs + allocateVulkanInstance exts appInfo reqs optReqs diff --git a/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2/Window.hs b/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2/Window.hs index 35d9c4fc1..007680a08 100644 --- a/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2/Window.hs +++ b/utils-init/vulkan-init-sdl2/src/Vulkan/Utils/Init/SDL2/Window.hs @@ -80,8 +80,8 @@ showWindow = SDL.showWindow sdl2Adapter :: (MonadResource m) => SDL.Window -> WindowAdapter m sdl2Adapter w = WindowAdapter - { waWithInstance = Init.withInstance w - , waWithSurface = \i -> Init.withSurface i w + { waAllocateInstance = Init.allocateInstance w + , waAllocateSurface = \i -> Init.allocateSurface i w , waDrawableSize = drawableSize w } diff --git a/utils/changelog.md b/utils/changelog.md index 59b7560df..7181e05cd 100644 --- a/utils/changelog.md +++ b/utils/changelog.md @@ -1,16 +1,20 @@ # Change Log -## [0.6.0] - 2026-06-30 +## [0.5.11.0] - 2026-07-01 A large additive release: helpers for dynamic rendering, dynamic pipeline state, specialization constants, synchronization, swapchain/frame management, and window abstraction. -No existing API was removed, but the baseline is vulkan-3.27 and GHC-9.2. +Resource-managing helpers follow the `create`/`with`/`allocate` naming +convention: anything that slots a `ResourceT.allocate` into a `withXxx` is named +`allocate*`. The three pre-existing `Initialization` helpers were renamed to +match, with the old names kept as deprecated aliases (see Deprecations); no +existing API was removed. The baseline is vulkan-3.27 and GHC-9.2. ### Pipelines and dynamic rendering -- `Vulkan.Utils.DynamicRendering`: `createPipeline` and - `createPipelineFromShaders` for render-pass-less pipelines, plus +- `Vulkan.Utils.DynamicRendering`: `allocatePipeline` and + `allocatePipelineFromShaders` for render-pass-less pipelines, plus `renderingInfo`, `colorAttachmentRenderingInfo`, and `dynamicRenderingRequirements`. - `Vulkan.Utils.DynamicState`: a `DynamicState` record with @@ -22,9 +26,9 @@ No existing API was removed, but the baseline is vulkan-3.27 and GHC-9.2. - `Vulkan.Utils.Pipeline.Specialization`: the `Specialization` and `SpecializationConst` classes with `withSpecialization` / `allocateSpecialization` for packing specialization constants. -- `Vulkan.Utils.RenderPass`: `createRenderPass`, `createColorRenderPass`, and a - generic `createPipeline` / `createPipelineFromShaders`. -- `Vulkan.Utils.Framebuffer`: `createFramebuffer`. +- `Vulkan.Utils.RenderPass`: `allocateRenderPass`, `allocateColorRenderPass`, and + a generic `allocatePipeline` / `allocatePipelineFromShaders`. +- `Vulkan.Utils.Framebuffer`: `allocateFramebuffer`. - `Vulkan.Utils.Shader`: `shaderStage` and `shaderModuleStage`. ### Synchronization and descriptors @@ -39,24 +43,31 @@ No existing API was removed, but the baseline is vulkan-3.27 and GHC-9.2. ### Swapchain, frames, and windowing - `Vulkan.Utils.Swapchain`: `Swapchain` and `SwapchainConfig` with - `defaultSwapchainConfig`, `allocSwapchain`, `recreateSwapchain`, and + `defaultSwapchainConfig`, `allocateSwapchain`, `recreateSwapchain`, and `threwSwapchainError`. - `Vulkan.Utils.Frame`: a `Frame` record driving frames-in-flight — `advanceFrame`, `runFrame`, `recordCommands`, `queueSubmitFrame`, `acquireFrameImage`, `presentFrameImage`, `drainFrames`, - `withTimelineSemaphore`, and the matching requirements helpers. + `allocateTimelineSemaphore`, and the matching requirements helpers. - `Vulkan.Utils.VulkanContext`: `VulkanContext` and `RecycledResources` with `mkVulkanContext`. - `Vulkan.Utils.WindowAdapter`: a backend-agnostic `WindowAdapter` record (the `vulkan-init-sdl2` and `vulkan-init-glfw` packages provide instances). - `Vulkan.Utils.WindowLoop`: `runWindowLoop` with the `WindowLoop` record and the `noWindowState` / `noOnFrame` / `noOnExit` defaults. -- `Vulkan.Utils.Queues`: a `Queues` record and `withDevice`. -- `Vulkan.Utils.Init.Headless`: `withInstance` for headless setup. +- `Vulkan.Utils.Queues`: a `Queues` record and `allocateDevice`. +- `Vulkan.Utils.Init.Headless`: `allocateInstance` for headless setup. ### Dependencies - Now depends on `unagi-chan` and `unliftio-core`. +### Deprecations +- `Vulkan.Utils.Initialization`: `createInstanceFromRequirements`, + `createDebugInstanceFromRequirements`, and `createDeviceFromRequirements` are + renamed to `allocateInstanceFromRequirements`, + `allocateDebugInstanceFromRequirements`, and `allocateDeviceFromRequirements`. + The old names remain as deprecated aliases. + ## [0.5.10.6] - 2023-10-21 ## [0.5.10.5] - 2023-10-17 diff --git a/utils/package.yaml b/utils/package.yaml index 9e2e6c84f..f0c3d9335 100644 --- a/utils/package.yaml +++ b/utils/package.yaml @@ -1,5 +1,5 @@ name: vulkan-utils -version: "0.6.0" +version: "0.5.11.0" synopsis: Utils for the vulkan package category: Graphics maintainer: IC Rainbow , Ellie Hermaszewska diff --git a/utils/src/Vulkan/Utils/DynamicRendering.hs b/utils/src/Vulkan/Utils/DynamicRendering.hs index 899d70093..4fbce2342 100644 --- a/utils/src/Vulkan/Utils/DynamicRendering.hs +++ b/utils/src/Vulkan/Utils/DynamicRendering.hs @@ -15,8 +15,8 @@ the @dynamicRendering@ feature on the device. module Vulkan.Utils.DynamicRendering ( -- * Pipeline PipelineConfig (..) - , createPipeline - , createPipelineFromShaders + , allocatePipeline + , allocatePipelineFromShaders -- * Device requirements , dynamicRenderingRequirements @@ -103,15 +103,15 @@ Stencil is out of scope: no @stencilAttachmentFormat@ is declared, matching without supplying it is invalid at draw time). For stencil, build the 'PipelineRenderingCreateInfo' and 'Vk.RenderingInfo' by hand. The formats MUST match the views passed to 'Vk.cmdUseRendering' at draw time (see 'renderingInfo'). -Intended to be used qualified, e.g. @Dynamic.createPipeline@. +Intended to be used qualified, e.g. @Dynamic.allocatePipeline@. -} -createPipeline +allocatePipeline :: (MonadResource m, MonadFail m) => Vk.Device -> PipelineConfig -> Vector (SomeStruct Vk.PipelineShaderStageCreateInfo) -> m (ReleaseKey, Vk.Pipeline) -createPipeline dev PipelineConfig{..} stages = +allocatePipeline dev PipelineConfig{..} stages = buildColorPipeline dev layout $ \resolvedLayout -> SomeStruct $ basePipelineCreateInfo @@ -132,10 +132,10 @@ createPipeline dev PipelineConfig{..} stages = , depthAttachmentFormat = fromMaybe Vk.FORMAT_UNDEFINED depthFormat } -{- | 'createPipeline' from @(stage, SPIR-V)@ pairs: compile each into a shader +{- | 'allocatePipeline' from @(stage, SPIR-V)@ pairs: compile each into a shader module, build the pipeline, then release the now-redundant module handles. -} -createPipelineFromShaders +allocatePipelineFromShaders :: (MonadResource m, MonadUnliftIO m, MonadFail m, Specialization spec) => Vk.Device -> PipelineConfig @@ -143,9 +143,9 @@ createPipelineFromShaders -- ^ Specialization shared by every stage (see "Vulkan.Utils.Pipeline.Specialization"); @()@ for none. -> [(Vk.ShaderStageFlagBits, ByteString)] -> m (ReleaseKey, Vk.Pipeline) -createPipelineFromShaders dev config spec shaders = +allocatePipelineFromShaders dev config spec shaders = withCompiledStages dev spec shaders $ - createPipeline dev config + allocatePipeline dev config {- | A 'Vk.RenderingInfo' targeting a single color attachment that is cleared on load and stored on completion. The attachment is expected to already be in @@ -170,8 +170,8 @@ attachments are expected in @IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL@ and the dept attachment in @IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL@ (e.g. via 'Vulkan.Utils.Barrier.transitionColorAttachment' / 'Vulkan.Utils.Barrier.transitionDepthAttachment'). The attachment shape MUST -match the pipeline ('createPipeline'). No stencil attachment is supplied, -matching 'createPipeline' never declaring one. +match the pipeline ('allocatePipeline'). No stencil attachment is supplied, +matching 'allocatePipeline' never declaring one. -} renderingInfo :: Vk.Rect2D diff --git a/utils/src/Vulkan/Utils/DynamicState.hs b/utils/src/Vulkan/Utils/DynamicState.hs index 8cb152085..b5f9ee7e6 100644 --- a/utils/src/Vulkan/Utils/DynamicState.hs +++ b/utils/src/Vulkan/Utils/DynamicState.hs @@ -3,8 +3,8 @@ {-| The Vulkan-1.3-core "always-on" dynamic state: the set of pipeline state that can be made dynamic without any vendor or experimental extension, so a single pipeline object serves every combination instead of permuting into one -'Vk.Pipeline' per variation. See 'Vulkan.Utils.RenderPass.createPipeline' -and 'Vulkan.Utils.DynamicRendering.createPipeline'. +'Vk.Pipeline' per variation. See 'Vulkan.Utils.RenderPass.allocatePipeline' +and 'Vulkan.Utils.DynamicRendering.allocatePipeline'. Because these states are declared dynamic, the matching @cmdSet*@ MUST be issued before each draw (an unset dynamic state is undefined behaviour). The diff --git a/utils/src/Vulkan/Utils/Frame.hs b/utils/src/Vulkan/Utils/Frame.hs index 3761db4e3..e86ba2756 100644 --- a/utils/src/Vulkan/Utils/Frame.hs +++ b/utils/src/Vulkan/Utils/Frame.hs @@ -27,7 +27,7 @@ module Vulkan.Utils.Frame , acquireFrameImage , presentFrameImage , drainFrames - , withTimelineSemaphore + , allocateTimelineSemaphore , frameInstanceRequirements , frameDeviceRequirements ) where @@ -101,8 +101,8 @@ frameInstanceRequirements = ] {- | The device-level requirements needed by 'runFrame' / 'queueSubmitFrame' / -'withTimelineSemaphore'. Merge into your other 'DeviceRequirement's when -calling 'Vulkan.Utils.Initialization.createDeviceFromRequirements'. +'allocateTimelineSemaphore'. Merge into your other 'DeviceRequirement's when +calling 'Vulkan.Utils.Initialization.allocateDeviceFromRequirements'. -} frameDeviceRequirements :: [DeviceRequirement] frameDeviceRequirements = @@ -125,7 +125,7 @@ initialFrame vc fSwapchain = do fRecycled <- mkRecycledResources vc spare <- mkRecycledResources vc liftIO (vcRecycleBin vc spare) - (_, fHostTimeline) <- withTimelineSemaphore (vcDevice vc) 0 + (_, fHostTimeline) <- allocateTimelineSemaphore (vcDevice vc) 0 fGPUWork <- liftIO $ newIORef mempty fResources <- allocate createInternalState closeInternalState liftIO $ runInternalState (resourceTRefCount (sRelease fSwapchain)) (snd fResources) @@ -355,8 +355,8 @@ drainFrames vc f = do ---------------------------------------------------------------- -- | Allocate a timeline semaphore initialised to the given value. -withTimelineSemaphore :: (MonadResource m) => Vk.Device -> Word64 -> m (ReleaseKey, Vk.Semaphore) -withTimelineSemaphore dev initial = +allocateTimelineSemaphore :: (MonadResource m) => Vk.Device -> Word64 -> m (ReleaseKey, Vk.Semaphore) +allocateTimelineSemaphore dev initial = Vk.withSemaphore dev (zero ::& SemaphoreTypeCreateInfo SEMAPHORE_TYPE_TIMELINE initial :& ()) diff --git a/utils/src/Vulkan/Utils/Framebuffer.hs b/utils/src/Vulkan/Utils/Framebuffer.hs index a6d957bbd..bc3a123ed 100644 --- a/utils/src/Vulkan/Utils/Framebuffer.hs +++ b/utils/src/Vulkan/Utils/Framebuffer.hs @@ -4,7 +4,7 @@ a framebuffer over a single image view, and a vanilla 2D color image view. -} module Vulkan.Utils.Framebuffer - ( createFramebuffer + ( allocateFramebuffer ) where import Control.Monad.Trans.Resource (MonadResource, ReleaseKey, allocate) @@ -13,14 +13,14 @@ import qualified Vulkan.Core10 as Vk import Vulkan.Zero (zero) -- | Create a framebuffer covering the whole image with a single attachment. -createFramebuffer +allocateFramebuffer :: (MonadResource m) => Vk.Device -> Vk.RenderPass -> Vk.ImageView -> Vk.Extent2D -> m (ReleaseKey, Vk.Framebuffer) -createFramebuffer dev renderPass imageView Vk.Extent2D{width, height} = +allocateFramebuffer dev renderPass imageView Vk.Extent2D{width, height} = Vk.withFramebuffer dev framebufferCreateInfo Nothing allocate where framebufferCreateInfo :: Vk.FramebufferCreateInfo '[] diff --git a/utils/src/Vulkan/Utils/Init/Headless.hs b/utils/src/Vulkan/Utils/Init/Headless.hs index c110a53db..2b51e000b 100644 --- a/utils/src/Vulkan/Utils/Init/Headless.hs +++ b/utils/src/Vulkan/Utils/Init/Headless.hs @@ -2,21 +2,21 @@ window-system instance extensions. -} module Vulkan.Utils.Init.Headless - ( withInstance + ( allocateInstance ) where import Control.Monad.Trans.Resource (MonadResource) import Vulkan.Core10 (ApplicationInfo, Instance) import Vulkan.Requirement (InstanceRequirement) -import Vulkan.Utils.Initialization (withVulkanInstance) +import Vulkan.Utils.Initialization (allocateVulkanInstance) {- | Build a Vulkan 'Instance' for a headless application. Equivalent to -@'withVulkanInstance' 'mempty'@. +@'allocateVulkanInstance' 'mempty'@. -} -withInstance +allocateInstance :: (MonadResource m) => Maybe ApplicationInfo -> [InstanceRequirement] -> [InstanceRequirement] -> m Instance -withInstance = withVulkanInstance mempty +allocateInstance = allocateVulkanInstance mempty diff --git a/utils/src/Vulkan/Utils/Initialization.hs b/utils/src/Vulkan/Utils/Initialization.hs index 7de8baba6..b8ad48d77 100644 --- a/utils/src/Vulkan/Utils/Initialization.hs +++ b/utils/src/Vulkan/Utils/Initialization.hs @@ -3,9 +3,9 @@ module Vulkan.Utils.Initialization ( -- * Instance creation - createInstanceFromRequirements - , createDebugInstanceFromRequirements - , withVulkanInstance + allocateInstanceFromRequirements + , allocateDebugInstanceFromRequirements + , allocateVulkanInstance -- * macOS portability , portabilityRequirements @@ -13,11 +13,16 @@ module Vulkan.Utils.Initialization , devicePortabilityRequirements -- * Device creation - , createDeviceFromRequirements + , allocateDeviceFromRequirements -- * Physical device selection , pickPhysicalDevice , physicalDeviceName + + -- * Deprecated aliases + , createInstanceFromRequirements + , createDebugInstanceFromRequirements + , createDeviceFromRequirements ) where import Control.Monad.IO.Class @@ -54,14 +59,14 @@ import Vulkan.Extensions.VK_KHR_portability_subset -- Instance ---------------------------------------------------------------- -{- | Like 'createInstanceFromRequirements' except it will create a debug utils +{- | Like 'allocateInstanceFromRequirements' except it will create a debug utils messenger (from the @VK_EXT_debug_utils@ extension). If the @VK_EXT_validation_features@ extension (from the @VK_LAYER_KHRONOS_validation@ layer) is available is it will be enabled and best practices messages enabled. -} -createDebugInstanceFromRequirements +allocateDebugInstanceFromRequirements :: forall m es . (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) => [InstanceRequirement] @@ -70,7 +75,7 @@ createDebugInstanceFromRequirements -- ^ Optional -> InstanceCreateInfo es -> m Instance -createDebugInstanceFromRequirements required optional baseCreateInfo = do +allocateDebugInstanceFromRequirements required optional baseCreateInfo = do let debugMessengerCreateInfo = zero @@ -114,7 +119,7 @@ createDebugInstanceFromRequirements required optional baseCreateInfo = do } ] inst <- - createInstanceFromRequirements + allocateInstanceFromRequirements (additionalRequirements <> toList required) (additionalOptionalRequirements <> toList optional) instanceCreateInfo @@ -126,7 +131,7 @@ createDebugInstanceFromRequirements required optional baseCreateInfo = do Will throw an 'IOError in the case of unsatisfied non-optional requirements. Unsatisfied requirements will be listed on stderr. -} -createInstanceFromRequirements +allocateInstanceFromRequirements :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) => [InstanceRequirement] -- ^ Required @@ -134,7 +139,7 @@ createInstanceFromRequirements -- ^ Optional -> InstanceCreateInfo es -> m Instance -createInstanceFromRequirements required optional baseCreateInfo = do +allocateInstanceFromRequirements required optional baseCreateInfo = do (mbICI, rrs, ors) <- checkInstanceRequirements required @@ -190,9 +195,9 @@ into the required list and 'portabilityFlags' into the create flags so macOS apps work without per-call plumbing. Pass 'mempty' for the extension list when running headless; or call -'Vulkan.Utils.Init.Headless.withInstance' which does so. +'Vulkan.Utils.Init.Headless.allocateInstance' which does so. -} -withVulkanInstance +allocateVulkanInstance :: (MonadResource m) => Vector ByteString {- ^ Backend-required instance extensions (e.g. from @@ -205,8 +210,8 @@ withVulkanInstance -> [InstanceRequirement] -- ^ Caller's optional requirements -> m Instance -withVulkanInstance exts appInfo reqs optReqs = - createInstanceFromRequirements +allocateVulkanInstance exts appInfo reqs optReqs = + allocateInstanceFromRequirements (portabilityRequirements <> reqs) optReqs zero @@ -226,7 +231,7 @@ withVulkanInstance exts appInfo reqs optReqs = Will throw an 'IOError in the case of unsatisfied non-optional requirements. Unsatisfied requirements will be listed on stderr. -} -createDeviceFromRequirements +allocateDeviceFromRequirements :: forall m . (MonadResource m) => [DeviceRequirement] @@ -236,7 +241,7 @@ createDeviceFromRequirements -> PhysicalDevice -> DeviceCreateInfo '[] -> m Device -createDeviceFromRequirements required optional phys baseCreateInfo = do +allocateDeviceFromRequirements required optional phys baseCreateInfo = do (mbDCI, rrs, ors) <- checkDeviceRequirements (devicePortabilityRequirements <> required) @@ -307,3 +312,41 @@ physicalDeviceName = maximumBy_ :: (Foldable t) => (a -> a -> Ordering) -> t a -> Maybe a maximumBy_ f xs = if null xs then Nothing else Just (maximumBy f xs) + +---------------------------------------------------------------- +-- Deprecated aliases +---------------------------------------------------------------- + +{-# DEPRECATED createInstanceFromRequirements "Renamed to allocateInstanceFromRequirements" #-} + +-- | Deprecated alias for 'allocateInstanceFromRequirements'. +createInstanceFromRequirements + :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) + => [InstanceRequirement] + -> [InstanceRequirement] + -> InstanceCreateInfo es + -> m Instance +createInstanceFromRequirements = allocateInstanceFromRequirements + +{-# DEPRECATED createDebugInstanceFromRequirements "Renamed to allocateDebugInstanceFromRequirements" #-} + +-- | Deprecated alias for 'allocateDebugInstanceFromRequirements'. +createDebugInstanceFromRequirements + :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) + => [InstanceRequirement] + -> [InstanceRequirement] + -> InstanceCreateInfo es + -> m Instance +createDebugInstanceFromRequirements = allocateDebugInstanceFromRequirements + +{-# DEPRECATED createDeviceFromRequirements "Renamed to allocateDeviceFromRequirements" #-} + +-- | Deprecated alias for 'allocateDeviceFromRequirements'. +createDeviceFromRequirements + :: (MonadResource m) + => [DeviceRequirement] + -> [DeviceRequirement] + -> PhysicalDevice + -> DeviceCreateInfo '[] + -> m Device +createDeviceFromRequirements = allocateDeviceFromRequirements diff --git a/utils/src/Vulkan/Utils/Queues.hs b/utils/src/Vulkan/Utils/Queues.hs index b5a1e0589..4184d97a8 100644 --- a/utils/src/Vulkan/Utils/Queues.hs +++ b/utils/src/Vulkan/Utils/Queues.hs @@ -22,7 +22,7 @@ custom priorities, …) reach for the lower-level -} module Vulkan.Utils.Queues ( Queues (..) - , withDevice + , allocateDevice ) where import Control.Monad.IO.Class @@ -39,7 +39,7 @@ import qualified Vulkan.Core10 as Vk import qualified Vulkan.Core10.DeviceInitialization as DI import Vulkan.Extensions.VK_KHR_surface (SurfaceKHR) import Vulkan.Requirement (DeviceRequirement) -import Vulkan.Utils.Initialization (createDeviceFromRequirements, pickPhysicalDevice) +import Vulkan.Utils.Initialization (allocateDeviceFromRequirements, pickPhysicalDevice) import Vulkan.Utils.QueueAssignment (QueueFamilyIndex (..), QueueSpec (..), assignQueues, isComputeQueueFamily, isGraphicsQueueFamily, isPresentQueueFamily, isTransferOnlyQueueFamily) import Vulkan.Zero (zero) @@ -72,18 +72,18 @@ support presentation. Pass 'Nothing' for headless callers — any graphics family will do. Pass any extra device requirements (extensions, features, API version) in -the third argument; they are forwarded to 'createDeviceFromRequirements'. +the third argument; they are forwarded to 'allocateDeviceFromRequirements'. Fails (via 'MonadFail') when no physical device satisfies the family requirements. -} -withDevice +allocateDevice :: (MonadResource m, MonadFail m) => Vk.Instance -> Maybe SurfaceKHR -> [DeviceRequirement] -> m (Vk.PhysicalDevice, Vk.Device, Queues (QueueFamilyIndex, Vk.Queue)) -withDevice inst mSurface extraReqs = do +allocateDevice inst mSurface extraReqs = do mPd <- pickPhysicalDevice inst @@ -109,7 +109,7 @@ withDevice inst mSurface extraReqs = do Nothing -> shareQueues phys ((,) <$> qFams <*> prios) dev <- - createDeviceFromRequirements + allocateDeviceFromRequirements extraReqs [] phys @@ -170,7 +170,7 @@ discoverFamilies mSurf phys = do pure (Just (Queues gp cp tf, score)) _ -> pure Nothing -{- | Robust fallback for 'withDevice' when 'assignQueues' can't give every +{- | Robust fallback for 'allocateDevice' when 'assignQueues' can't give every slot its own queue. Allocates as many distinct queues per family as the hardware exposes, then aliases the surplus slots onto them round-robin, so it always succeeds. diff --git a/utils/src/Vulkan/Utils/RenderPass.hs b/utils/src/Vulkan/Utils/RenderPass.hs index 69863e395..e4f20ca6f 100644 --- a/utils/src/Vulkan/Utils/RenderPass.hs +++ b/utils/src/Vulkan/Utils/RenderPass.hs @@ -10,13 +10,13 @@ needs neither a render pass nor framebuffers. Pick one and import only it. -} module Vulkan.Utils.RenderPass ( -- * Render pass - createRenderPass - , createColorRenderPass + allocateRenderPass + , allocateColorRenderPass -- * Pipeline , PipelineConfig (..) - , createPipeline - , createPipelineFromShaders + , allocatePipeline + , allocatePipelineFromShaders ) where import Control.Monad.IO.Unlift (MonadUnliftIO) @@ -41,7 +41,7 @@ depth attachment at @N@ — the colour-then-depth order the framebuffer's dependency synchronizes colour output and, when present, the depth fragment tests. -} -createRenderPass +allocateRenderPass :: (MonadResource m) => Vk.Device -> Vector (Vk.Format, Vk.ImageLayout) @@ -49,7 +49,7 @@ createRenderPass -> Maybe Vk.Format -- ^ Optional depth attachment format. -> m (ReleaseKey, Vk.RenderPass) -createRenderPass dev colors depth = +allocateRenderPass dev colors depth = Vk.withRenderPass dev zero @@ -154,9 +154,9 @@ depthAttachmentDescription imageFormat = {- | The single-colour render pass: one attachment cleared on load and stored, ending in @finalLayout@ (e.g. @PRESENT_SRC_KHR@ for swapchains, @TRANSFER_SRC_OPTIMAL@ for offscreen images). The common special case of -'createRenderPass'. +'allocateRenderPass'. -} -createColorRenderPass +allocateColorRenderPass :: (MonadResource m) => Vk.Device -> Vk.Format @@ -164,8 +164,8 @@ createColorRenderPass -> Vk.ImageLayout -- ^ Final layout. -> m (ReleaseKey, Vk.RenderPass) -createColorRenderPass dev imageFormat finalLayout = - createRenderPass dev [(imageFormat, finalLayout)] Nothing +allocateColorRenderPass dev imageFormat finalLayout = + allocateRenderPass dev [(imageFormat, finalLayout)] Nothing {- | Attachment + fixed-function knobs for a render-pass pipeline. @@ -204,16 +204,16 @@ instance Zero PipelineConfig where {- | A vanilla vertex+fragment pipeline targeting @renderPass@ (subpass 0). The 'PipelineConfig' attachment shape MUST match @renderPass@. Whatever dynamic state is selected MUST be set before drawing. Intended to be used qualified, e.g. -@RenderPass.createPipeline@. +@RenderPass.allocatePipeline@. -} -createPipeline +allocatePipeline :: (MonadResource m, MonadFail m) => Vk.Device -> Vk.RenderPass -> PipelineConfig -> Vector (SomeStruct Vk.PipelineShaderStageCreateInfo) -> m (ReleaseKey, Vk.Pipeline) -createPipeline dev renderPass PipelineConfig{..} stages = +allocatePipeline dev renderPass PipelineConfig{..} stages = buildColorPipeline dev layout $ \resolvedLayout -> SomeStruct ( basePipelineCreateInfo @@ -226,13 +226,13 @@ createPipeline dev renderPass PipelineConfig{..} stages = stages ) -{- | 'createPipeline' from @(stage, SPIR-V)@ pairs: compile each into a shader +{- | 'allocatePipeline' from @(stage, SPIR-V)@ pairs: compile each into a shader module, build the pipeline, then release the now-redundant module handles. @spec@ is one specialization shared by every stage (see 'Vulkan.Utils.Pipeline.Specialization'); pass @()@ for none. -} -createPipelineFromShaders +allocatePipelineFromShaders :: (MonadResource m, MonadUnliftIO m, MonadFail m, Specialization spec) => Vk.Device -> Vk.RenderPass @@ -241,5 +241,5 @@ createPipelineFromShaders -- ^ Specialization shared by every stage; @()@ for none. -> [(Vk.ShaderStageFlagBits, ByteString)] -> m (ReleaseKey, Vk.Pipeline) -createPipelineFromShaders dev renderPass config spec shaders = - withCompiledStages dev spec shaders (createPipeline dev renderPass config) +allocatePipelineFromShaders dev renderPass config spec shaders = + withCompiledStages dev spec shaders (allocatePipeline dev renderPass config) diff --git a/utils/src/Vulkan/Utils/Swapchain.hs b/utils/src/Vulkan/Utils/Swapchain.hs index a8c10c301..6fd3fcd19 100644 --- a/utils/src/Vulkan/Utils/Swapchain.hs +++ b/utils/src/Vulkan/Utils/Swapchain.hs @@ -13,7 +13,7 @@ module Vulkan.Utils.Swapchain ( Swapchain (..) , SwapchainConfig (..) , defaultSwapchainConfig - , allocSwapchain + , allocateSwapchain , recreateSwapchain , threwSwapchainError ) where @@ -117,7 +117,7 @@ data Swapchain = Swapchain ---------------------------------------------------------------- -- | Allocate a new swapchain plus its image views. -allocSwapchain +allocateSwapchain :: (MonadResource m) => Vk.PhysicalDevice -> Vk.Device @@ -128,14 +128,14 @@ allocSwapchain -- ^ Fallback size when the surface lets us pick -> KHR.SurfaceKHR -> m Swapchain -allocSwapchain phys dev cfg oldSwapchain windowSize surface = do +allocateSwapchain phys dev cfg oldSwapchain windowSize surface = do (sSwapchain, sFormat, sExtent, sPresentMode, swapchainKey) <- - createSwapchain phys dev cfg oldSwapchain windowSize surface + allocateSwapchainEx phys dev cfg oldSwapchain windowSize surface (_, sImages) <- KHR.getSwapchainImagesKHR dev sSwapchain (imageViewKeys, sImageViews) <- fmap V.unzip . V.forM sImages $ \image -> - createImageView dev (SurfaceFormatKHR.format sFormat) image + allocateImageView dev (SurfaceFormatKHR.format sFormat) image -- One present-wait binary semaphore per swapchain image, indexed by the -- acquired image index (see 'sRenderFinished'). @@ -167,7 +167,7 @@ recreateSwapchain -> Swapchain -> m Swapchain recreateSwapchain phys dev newSize old = do - fresh <- allocSwapchain phys dev (sConfig old) (sSwapchain old) newSize (sSurface old) + fresh <- allocateSwapchain phys dev (sConfig old) (sSwapchain old) newSize (sSurface old) releaseRefCounted (sRelease old) pure fresh @@ -175,7 +175,7 @@ recreateSwapchain phys dev newSize old = do -- Internals ---------------------------------------------------------------- -createSwapchain +allocateSwapchainEx :: (MonadResource m) => Vk.PhysicalDevice -> Vk.Device @@ -184,7 +184,7 @@ createSwapchain -> Vk.Extent2D -> KHR.SurfaceKHR -> m (KHR.SwapchainKHR, SurfaceFormatKHR, Vk.Extent2D, KHR.PresentModeKHR, ReleaseKey) -createSwapchain phys dev cfg oldSwapchain explicitSize surf = do +allocateSwapchainEx phys dev cfg oldSwapchain explicitSize surf = do surfaceCaps <- KHR.getPhysicalDeviceSurfaceCapabilitiesKHR phys surf -- Sanity-check that the surface advertises the usages we need. @@ -250,13 +250,13 @@ createSwapchain phys dev cfg oldSwapchain explicitSize surf = do pure (swapchain, surfaceFormat, imageExtent, presentMode, key) -- | 2D color image view covering the whole image. -createImageView +allocateImageView :: (MonadResource m) => Vk.Device -> Vk.Format -> Vk.Image -> m (ReleaseKey, Vk.ImageView) -createImageView dev format image = +allocateImageView dev format image = Vk.withImageView dev imageViewCreateInfo Nothing allocate where imageViewCreateInfo = diff --git a/utils/src/Vulkan/Utils/WindowAdapter.hs b/utils/src/Vulkan/Utils/WindowAdapter.hs index ef1dca1b9..b714d5274 100644 --- a/utils/src/Vulkan/Utils/WindowAdapter.hs +++ b/utils/src/Vulkan/Utils/WindowAdapter.hs @@ -15,7 +15,7 @@ import Vulkan.Requirement (InstanceRequirement) -- | The window-library operations a boot sequence needs. data WindowAdapter m = WindowAdapter - { waWithInstance + { waAllocateInstance :: Maybe Vk.ApplicationInfo -> [InstanceRequirement] -> [InstanceRequirement] @@ -23,7 +23,7 @@ data WindowAdapter m = WindowAdapter {- ^ Create an instance satisfying the window library's requirements plus the given required and optional ones. -} - , waWithSurface :: Vk.Instance -> m SurfaceKHR + , waAllocateSurface :: Vk.Instance -> m SurfaceKHR -- ^ Create a surface for the window, destroyed with the resource scope. , waDrawableSize :: m Vk.Extent2D -- ^ The window's current drawable size, for the swapchain extent. diff --git a/utils/vulkan-utils.cabal b/utils/vulkan-utils.cabal index 19e762668..01b604f50 100644 --- a/utils/vulkan-utils.cabal +++ b/utils/vulkan-utils.cabal @@ -5,7 +5,7 @@ cabal-version: 1.24 -- see: https://github.com/sol/hpack name: vulkan-utils -version: 0.6.0 +version: 0.5.11.0 synopsis: Utils for the vulkan package category: Graphics homepage: https://github.com/haskell-game/vulkan#readme From 6247fce8d9e7c46b8fe65c8fb02f5a2dfe0f27a0 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Wed, 1 Jul 2026 11:58:15 +0300 Subject: [PATCH 3/4] Docs cleanup --- examples/compute/Main.hs | 8 -------- examples/depth-headless/Main.hs | 1 - examples/lib/HeadlessBoot.hs | 1 - examples/rays/AccelerationStructure.hs | 3 --- examples/rays/Init.hs | 1 - examples/rays/Main.hs | 2 -- examples/rays/Pipeline.hs | 1 - examples/resize/Main.hs | 2 -- examples/triangle-headless-dynamic/Main.hs | 3 --- examples/triangle-headless/Main.hs | 10 ---------- utils/src/Vulkan/Utils/Descriptors.hs | 2 -- utils/src/Vulkan/Utils/DynamicRendering.hs | 1 - utils/src/Vulkan/Utils/DynamicState.hs | 2 -- utils/src/Vulkan/Utils/Frame.hs | 1 - utils/src/Vulkan/Utils/Initialization.hs | 6 ------ utils/src/Vulkan/Utils/Misc.hs | 1 - utils/src/Vulkan/Utils/QueueAssignment.hs | 1 - utils/src/Vulkan/Utils/Requirements.hs | 2 -- .../Vulkan/Utils/ShaderQQ/Backend/Glslang/Internal.hs | 2 -- .../Vulkan/Utils/ShaderQQ/Backend/Shaderc/Internal.hs | 2 -- utils/src/Vulkan/Utils/Swapchain.hs | 1 - 21 files changed, 53 deletions(-) diff --git a/examples/compute/Main.hs b/examples/compute/Main.hs index 243f08876..df85ae6b7 100644 --- a/examples/compute/Main.hs +++ b/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 diff --git a/examples/depth-headless/Main.hs b/examples/depth-headless/Main.hs index 7ceaad360..57eef6162 100644 --- a/examples/depth-headless/Main.hs +++ b/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. diff --git a/examples/lib/HeadlessBoot.hs b/examples/lib/HeadlessBoot.hs index a8133b592..41f45ad7e 100644 --- a/examples/lib/HeadlessBoot.hs +++ b/examples/lib/HeadlessBoot.hs @@ -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 diff --git a/examples/rays/AccelerationStructure.hs b/examples/rays/AccelerationStructure.hs index 314af983e..ea7663047 100644 --- a/examples/rays/AccelerationStructure.hs +++ b/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 diff --git a/examples/rays/Init.hs b/examples/rays/Init.hs index 271ade9c1..644289bd8 100644 --- a/examples/rays/Init.hs +++ b/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 diff --git a/examples/rays/Main.hs b/examples/rays/Main.hs index 946fed1c7..69491212f 100644 --- a/examples/rays/Main.hs +++ b/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 diff --git a/examples/rays/Pipeline.hs b/examples/rays/Pipeline.hs index 9909a31b2..90a9282e8 100644 --- a/examples/rays/Pipeline.hs +++ b/examples/rays/Pipeline.hs @@ -1,4 +1,3 @@ --- {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} diff --git a/examples/resize/Main.hs b/examples/resize/Main.hs index f1d175e19..68dc70b59 100644 --- a/examples/resize/Main.hs +++ b/examples/resize/Main.hs @@ -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 diff --git a/examples/triangle-headless-dynamic/Main.hs b/examples/triangle-headless-dynamic/Main.hs index 51607afd9..63e7c180f 100644 --- a/examples/triangle-headless-dynamic/Main.hs +++ b/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,10 +101,8 @@ 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). diff --git a/examples/triangle-headless/Main.hs b/examples/triangle-headless/Main.hs index 2b4a5d196..5f417b0bf 100644 --- a/examples/triangle-headless/Main.hs +++ b/examples/triangle-headless/Main.hs @@ -133,7 +133,6 @@ render allocator dev graphicsQueueFamilyIndex = do allocate nameObject dev cpuImage "CPU side image" - -- Create an image view let imageSubresourceRange = Vk.ImageSubresourceRange @@ -164,7 +163,6 @@ render allocator dev graphicsQueueFamilyIndex = do imageFormat Vk.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL - -- Create a framebuffer let framebufferCreateInfo :: Vk.FramebufferCreateInfo '[] framebufferCreateInfo = @@ -177,14 +175,12 @@ render allocator dev graphicsQueueFamilyIndex = do } (_, framebuffer) <- Vk.withFramebuffer dev framebufferCreateInfo Nothing allocate - -- Create the most vanilla rendering pipeline (vertKey, vertStage) <- shaderStage dev Vk.SHADER_STAGE_VERTEX_BIT () vertCode (fragKey, fragStage) <- shaderStage dev Vk.SHADER_STAGE_FRAGMENT_BIT () fragCode (_, graphicsPipeline) <- RenderPass.allocatePipeline dev renderPass zero{RenderPass.colorFormats = [imageFormat], RenderPass.dynamicStates = Just minimalDynamicStates} [vertStage, fragStage] release vertKey release fragKey - -- Create a command buffer let commandPoolCreateInfo = zero { CommandPoolCreateInfo.queueFamilyIndex = graphicsQueueFamilyIndex @@ -198,11 +194,6 @@ render allocator dev graphicsQueueFamilyIndex = do } (_, [commandBuffer]) <- Vk.withCommandBuffers dev commandBufferAllocateInfo allocate - -- Fill command buffer - -- - -- - Execute the renderpass - -- - Transition the images to be able to perform the copy - -- - Copy the image to CPU mapped memory Vk.useCommandBuffer commandBuffer zero{CommandBufferBeginInfo.flags = Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT} do let renderPassBeginInfo = zero @@ -272,7 +263,6 @@ render allocator dev graphicsQueueFamilyIndex = do } ] - -- Copy the image Vk.cmdCopyImage commandBuffer image diff --git a/utils/src/Vulkan/Utils/Descriptors.hs b/utils/src/Vulkan/Utils/Descriptors.hs index f9c0afd78..d8d2251ed 100644 --- a/utils/src/Vulkan/Utils/Descriptors.hs +++ b/utils/src/Vulkan/Utils/Descriptors.hs @@ -20,7 +20,6 @@ import Vulkan.CStruct.Extends (SomeStruct (..)) import qualified Vulkan.Core10 as Vk import Vulkan.Zero (zero) --- | A whole-buffer descriptor write. bufferWrite :: Vk.DescriptorSet -> Word32 @@ -39,7 +38,6 @@ bufferWrite set binding descriptorType buffer = , Vk.bufferInfo = [Vk.DescriptorBufferInfo buffer 0 Vk.WHOLE_SIZE] } --- | A samplerless image descriptor write. imageWrite :: Vk.DescriptorSet -> Word32 diff --git a/utils/src/Vulkan/Utils/DynamicRendering.hs b/utils/src/Vulkan/Utils/DynamicRendering.hs index 4fbce2342..9e7af8232 100644 --- a/utils/src/Vulkan/Utils/DynamicRendering.hs +++ b/utils/src/Vulkan/Utils/DynamicRendering.hs @@ -64,7 +64,6 @@ data PipelineConfig = PipelineConfig { colorFormats :: [Vk.Format] -- ^ Colour attachment formats (@0@..@N@); @[]@ for a depth-only pipeline. , depthFormat :: Maybe Vk.Format - -- ^ Optional depth attachment format. , vertexInput :: Vk.PipelineVertexInputStateCreateInfo '[] -- ^ Vertex input (bindings + attributes); 'zero' for none. , dynamicStates :: Maybe (Vector Vk.DynamicState) diff --git a/utils/src/Vulkan/Utils/DynamicState.hs b/utils/src/Vulkan/Utils/DynamicState.hs index b5f9ee7e6..58bcdf88d 100644 --- a/utils/src/Vulkan/Utils/DynamicState.hs +++ b/utils/src/Vulkan/Utils/DynamicState.hs @@ -159,7 +159,6 @@ dynamicStateFor ext = -- The state set (single source of truth) ---------------------------------------------------------------- --- | Pre-rasterization dynamic states. preRasterizationStates :: Vector Vk.DynamicState preRasterizationStates = [ Vk.DYNAMIC_STATE_VIEWPORT_WITH_COUNT @@ -189,7 +188,6 @@ fragmentTestStates = , Vk.DYNAMIC_STATE_STENCIL_REFERENCE ] --- | Fragment-output dynamic states. fragmentOutputStates :: Vector Vk.DynamicState fragmentOutputStates = [Vk.DYNAMIC_STATE_BLEND_CONSTANTS] diff --git a/utils/src/Vulkan/Utils/Frame.hs b/utils/src/Vulkan/Utils/Frame.hs index e86ba2756..724276204 100644 --- a/utils/src/Vulkan/Utils/Frame.hs +++ b/utils/src/Vulkan/Utils/Frame.hs @@ -58,7 +58,6 @@ import Vulkan.Utils.Swapchain (Swapchain (..), sRelease) import Vulkan.Utils.VulkanContext (RecycledResources (..), VulkanContext (..)) import Vulkan.Zero (zero) --- | Per-frame state. data Frame = Frame { fIndex :: Word64 -- ^ Monotonic, used as the timeline-semaphore signal value for this frame. diff --git a/utils/src/Vulkan/Utils/Initialization.hs b/utils/src/Vulkan/Utils/Initialization.hs index b8ad48d77..cf0f83b3b 100644 --- a/utils/src/Vulkan/Utils/Initialization.hs +++ b/utils/src/Vulkan/Utils/Initialization.hs @@ -318,8 +318,6 @@ maximumBy_ f xs = if null xs then Nothing else Just (maximumBy f xs) ---------------------------------------------------------------- {-# DEPRECATED createInstanceFromRequirements "Renamed to allocateInstanceFromRequirements" #-} - --- | Deprecated alias for 'allocateInstanceFromRequirements'. createInstanceFromRequirements :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) => [InstanceRequirement] @@ -329,8 +327,6 @@ createInstanceFromRequirements createInstanceFromRequirements = allocateInstanceFromRequirements {-# DEPRECATED createDebugInstanceFromRequirements "Renamed to allocateDebugInstanceFromRequirements" #-} - --- | Deprecated alias for 'allocateDebugInstanceFromRequirements'. createDebugInstanceFromRequirements :: (MonadResource m, Extendss InstanceCreateInfo es, PokeChain es) => [InstanceRequirement] @@ -340,8 +336,6 @@ createDebugInstanceFromRequirements createDebugInstanceFromRequirements = allocateDebugInstanceFromRequirements {-# DEPRECATED createDeviceFromRequirements "Renamed to allocateDeviceFromRequirements" #-} - --- | Deprecated alias for 'allocateDeviceFromRequirements'. createDeviceFromRequirements :: (MonadResource m) => [DeviceRequirement] diff --git a/utils/src/Vulkan/Utils/Misc.hs b/utils/src/Vulkan/Utils/Misc.hs index 4097d00ac..10c6c0959 100644 --- a/utils/src/Vulkan/Utils/Misc.hs +++ b/utils/src/Vulkan/Utils/Misc.hs @@ -99,7 +99,6 @@ showBits a = then "zeroBits" else intercalate " .|. " $ fmap show (setBits a) --- | The list of bits which are set setBits :: (FiniteBits a) => a -> [a] setBits a = [ b diff --git a/utils/src/Vulkan/Utils/QueueAssignment.hs b/utils/src/Vulkan/Utils/QueueAssignment.hs index cd363befb..e064170b0 100644 --- a/utils/src/Vulkan/Utils/QueueAssignment.hs +++ b/utils/src/Vulkan/Utils/QueueAssignment.hs @@ -190,7 +190,6 @@ assignQueues phys specs = runMaybeT $ do , not (null ps) ] - -- Get extractQueues :: Device -> n (f (QueueFamilyIndex, Queue)) extractQueues dev = for specsWithQueueIndex $ diff --git a/utils/src/Vulkan/Utils/Requirements.hs b/utils/src/Vulkan/Utils/Requirements.hs index f98b2a6c4..ceab13636 100644 --- a/utils/src/Vulkan/Utils/Requirements.hs +++ b/utils/src/Vulkan/Utils/Requirements.hs @@ -338,9 +338,7 @@ checkDeviceRequest ) -- ^ Lookup an extension -> DeviceRequirement - -- ^ The requirement to test -> RequirementResult - -- ^ The result checkDeviceRequest mbFeats mbProps lookupExtension = \case RequireDeviceVersion minVersion | Just props <- mbProps diff --git a/utils/src/Vulkan/Utils/ShaderQQ/Backend/Glslang/Internal.hs b/utils/src/Vulkan/Utils/ShaderQQ/Backend/Glslang/Internal.hs index c1877d252..3b1b406fb 100644 --- a/utils/src/Vulkan/Utils/ShaderQQ/Backend/Glslang/Internal.hs +++ b/utils/src/Vulkan/Utils/ShaderQQ/Backend/Glslang/Internal.hs @@ -27,7 +27,6 @@ compileShaderQ :: Maybe String -- ^ Argument to pass to `--target-env` -> ShaderType - -- ^ Argument to specify between glsl/hlsl shader -> String -- ^ stage -> Maybe String @@ -50,7 +49,6 @@ compileShader -> Maybe String -- ^ Argument to pass to `--target-env` -> ShaderType - -- ^ Argument to specify between glsl/hlsl shader -> String -- ^ stage -> Maybe String diff --git a/utils/src/Vulkan/Utils/ShaderQQ/Backend/Shaderc/Internal.hs b/utils/src/Vulkan/Utils/ShaderQQ/Backend/Shaderc/Internal.hs index 1880bd6ba..da9ba0d35 100644 --- a/utils/src/Vulkan/Utils/ShaderQQ/Backend/Shaderc/Internal.hs +++ b/utils/src/Vulkan/Utils/ShaderQQ/Backend/Shaderc/Internal.hs @@ -27,7 +27,6 @@ compileShaderQ :: Maybe String -- ^ Argument to pass to `--target-spv` -> ShaderType - -- ^ Argument to specify between glsl/hlsl shader -> String -- ^ stage -> Maybe String @@ -50,7 +49,6 @@ compileShader -> Maybe String -- ^ Argument to pass to `--target-spv` -> ShaderType - -- ^ Argument to specify between glsl/hlsl shader -> String -- ^ stage -> Maybe String diff --git a/utils/src/Vulkan/Utils/Swapchain.hs b/utils/src/Vulkan/Utils/Swapchain.hs index 6fd3fcd19..9f32c8918 100644 --- a/utils/src/Vulkan/Utils/Swapchain.hs +++ b/utils/src/Vulkan/Utils/Swapchain.hs @@ -73,7 +73,6 @@ data SwapchainConfig = SwapchainConfig } deriving (Generic) --- | Sensible defaults: color-attachment swapchain, FIFO_RELAXED preferred. defaultSwapchainConfig :: SwapchainConfig defaultSwapchainConfig = SwapchainConfig From ddfee41da639bac3907d60bc26151b1f79ef9539 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Wed, 1 Jul 2026 16:55:25 +0300 Subject: [PATCH 4/4] Accessors cleanup --- utils/package.yaml | 1 + utils/src/Vulkan/Utils/PipelineLayout.hs | 48 ++++++------------------ utils/vulkan-utils.cabal | 2 + 3 files changed, 15 insertions(+), 36 deletions(-) diff --git a/utils/package.yaml b/utils/package.yaml index f0c3d9335..4264aa4f4 100644 --- a/utils/package.yaml +++ b/utils/package.yaml @@ -80,6 +80,7 @@ default-extensions: - MagicHash - NamedFieldPuns - NoMonomorphismRestriction +- OverloadedRecordDot - OverloadedStrings - PartialTypeSignatures - PatternSynonyms diff --git a/utils/src/Vulkan/Utils/PipelineLayout.hs b/utils/src/Vulkan/Utils/PipelineLayout.hs index 9d7f183ee..35aedd3d9 100644 --- a/utils/src/Vulkan/Utils/PipelineLayout.hs +++ b/utils/src/Vulkan/Utils/PipelineLayout.hs @@ -18,8 +18,7 @@ module Vulkan.Utils.PipelineLayout import Control.Monad (foldM) import Data.Bits ((.|.)) -import Data.Foldable (toList) -import Data.List (foldl') +import Data.Foldable (foldl') import qualified Data.Map.Strict as Map import Data.Word (Word32) import qualified Vulkan.Core10 as Vk @@ -51,24 +50,24 @@ mergeDescriptorSetLayoutBindings => f Vk.DescriptorSetLayoutBinding -> Either DescriptorBindingConflict [Vk.DescriptorSetLayoutBinding] mergeDescriptorSetLayoutBindings bindings = - fmap (fmap snd . Map.toAscList) (foldM step Map.empty (toList bindings)) + fmap (fmap snd . Map.toAscList) (foldM step Map.empty bindings) where - step acc b = case Map.lookup (bindingNumber b) acc of - Nothing -> Right (Map.insert (bindingNumber b) b acc) - Just b0 -> (\b' -> Map.insert (bindingNumber b) b' acc) <$> combine b0 b + step acc b = case Map.lookup b.binding acc of + Nothing -> Right (Map.insert b.binding b acc) + Just b0 -> (\b' -> Map.insert b.binding b' acc) <$> combine b0 b combine b0 b1 - | t0 /= t1 = Left (DescriptorBindingConflict (bindingNumber b0) (t0, t1)) + | t0 /= t1 = Left (DescriptorBindingConflict b0.binding (t0, t1)) | otherwise = Right ( b0 - { Vk.stageFlags = bindingStages b0 .|. bindingStages b1 - , Vk.descriptorCount = max (bindingCount b0) (bindingCount b1) + { Vk.stageFlags = b0.stageFlags .|. b1.stageFlags + , Vk.descriptorCount = max b0.descriptorCount b1.descriptorCount } ) where - t0 = bindingType b0 - t1 = bindingType b1 + t0 = b0.descriptorType + t1 = b1.descriptorType {- | Merge the push-constant ranges contributed by several stages: ranges sharing the same @(offset, size)@ have their 'Vk.stageFlags' OR-ed. The result is @@ -81,28 +80,5 @@ mergePushConstantRanges ranges = | ((off, sz), stage) <- Map.toAscList byRange ] where - byRange = foldl' add Map.empty (toList ranges) - add m r = Map.insertWith (.|.) (rangeOffset r, rangeSize r) (rangeStages r) m - --- Field accessors (the constructor disambiguates DuplicateRecordFields). - -bindingNumber :: Vk.DescriptorSetLayoutBinding -> Word32 -bindingNumber Vk.DescriptorSetLayoutBinding{Vk.binding = b} = b - -bindingType :: Vk.DescriptorSetLayoutBinding -> Vk.DescriptorType -bindingType Vk.DescriptorSetLayoutBinding{Vk.descriptorType = t} = t - -bindingStages :: Vk.DescriptorSetLayoutBinding -> Vk.ShaderStageFlags -bindingStages Vk.DescriptorSetLayoutBinding{Vk.stageFlags = s} = s - -bindingCount :: Vk.DescriptorSetLayoutBinding -> Word32 -bindingCount Vk.DescriptorSetLayoutBinding{Vk.descriptorCount = c} = c - -rangeOffset :: Vk.PushConstantRange -> Word32 -rangeOffset Vk.PushConstantRange{Vk.offset = o} = o - -rangeSize :: Vk.PushConstantRange -> Word32 -rangeSize Vk.PushConstantRange{Vk.size = s} = s - -rangeStages :: Vk.PushConstantRange -> Vk.ShaderStageFlags -rangeStages Vk.PushConstantRange{Vk.stageFlags = s} = s + byRange = foldl' add Map.empty ranges + add m r = Map.insertWith (.|.) (r.offset, r.size) r.stageFlags m diff --git a/utils/vulkan-utils.cabal b/utils/vulkan-utils.cabal index 01b604f50..9a88a9947 100644 --- a/utils/vulkan-utils.cabal +++ b/utils/vulkan-utils.cabal @@ -94,6 +94,7 @@ library MagicHash NamedFieldPuns NoMonomorphismRestriction + OverloadedRecordDot OverloadedStrings PartialTypeSignatures PatternSynonyms @@ -160,6 +161,7 @@ test-suite doctests MagicHash NamedFieldPuns NoMonomorphismRestriction + OverloadedRecordDot OverloadedStrings PartialTypeSignatures PatternSynonyms