Merge pull request #6 from walseb/storage-buffers

Added initial storage buffer support

Author: alt-romes

ghengin-core/ghengin-core-indep/Ghengin/Core/Shader/Data.hs

@@ -33,9 +33,9 @@ class Block ty => ShaderData ty where
 
   -- | The primitive FIR shader type whose memory representation matches the result
   -- of serializing this datatype using 'Poke'. This is the promise that if
-  -- your shader expects @FirType ty@ in a uniform location, writing @ty@ into the
-  -- buffer will be sound, and the shader will find @ty@'s laid out in memory
-  -- according to @FirType ty@'s expected memory layout.
+  -- your shader expects @FirType ty@ in a uniform/storage location, writing @ty@
+  -- into the buffer will be sound, and the shader will find @ty@'s laid out 
+  -- in memory according to @FirType ty@'s expected memory layout.
   --
   -- === _Example_
   --

ghengin-core/ghengin-core-indep/Ghengin/Core/Type/Compatible.hs

@@ -172,7 +172,7 @@ type family DSetBinding (set :: Nat) (binding :: Nat) (info :: PipelineInfo) ::
 type family DSetBinding' (set :: Nat) (binding :: Nat) (info :: PipelineInfo) :: Type where
   DSetBinding' set binding info =
     FromMaybe (DSetBinding set binding info)
-              (TypeError (Text "Uniform [Descriptor Set #" :<>: ShowType set :<>: Text ", Binding #" :<>: ShowType binding :<>: Text "] not found in " :<>: ShowType info))
+              (TypeError (Text "Descriptor [Descriptor Set #" :<>: ShowType set :<>: Text ", Binding #" :<>: ShowType binding :<>: Text "] not found in " :<>: ShowType info))
 
 type family FindDSetInput (set :: Nat) (binding :: Nat) (inputs :: [TLInterfaceVariable]) :: Maybe Type where
   FindDSetInput set binding '[] = 'Nothing

ghengin-core/ghengin-core.cabal

@@ -180,7 +180,7 @@ library backend-independent-bits
                       -- TODO: NOT DEPEND ON VULKAN IN CORE INDEP
                       vulkan,
                       linear-base,
-                      reference-counting,
+                      reference-counting >= 0.2.0.0,
 
                       template-haskell,
                       containers,
@@ -237,7 +237,7 @@ library vulkan
                       vulkan,
                       GLFW-b,
                       linear-base,
-                      reference-counting,
+                      reference-counting >= 0.2.0.0,
                       -- ghengin-core MISTAKE!(#23322, could we depend on ghengin-core for non-indefinite modules only?)
                       ghengin-core:backend-independent-bits,
                       gl-block,

ghengin-core/ghengin-core/Ghengin/Core/Material.hs

@@ -13,6 +13,8 @@ import Ghengin.Core.Render.Pipeline ( RenderPipeline(..) )
 import Ghengin.Core.Renderer.Kernel
 import Ghengin.Core.Renderer.DescriptorSet
 
+import qualified Data.IntMap.Strict as IM
+
 import qualified Data.Linear.Alias as Alias
 
 {-
@@ -100,7 +102,7 @@ instance HasProperties Material where
 material :: ∀ α π β. CompatibleMaterial α π
          => PropertyBindings α ⊸ RenderPipeline π β ⊸ Renderer (Material α, RenderPipeline π β)
 material props0 (RenderProperty pr rps) = material props0 rps >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
-material props0 (RenderPipeline gpip rpass (rdset, rres, dpool0) shaders uq) = Linear.do
+material props0 (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) = Linear.do
 
   -- Make the unique identifier for this material
   Ur uniq <- liftSystemIOU newUnique
@@ -112,7 +114,7 @@ material props0 (RenderPipeline gpip rpass (rdset, rres, dpool0) shaders uq) = L
 
   -- Make the resource map for this material
   -- Will also count texture references
-  (resources0, props1) <- makeResources props0
+  (resources0, props1) <- makeResources (fromMaybe (error "DescriptorSetMap doesn't contain material descriptors.") (IM.lookup 1 bmap)) props0
 
   -- Create the descriptor set with the written descriptors based on the
   -- created resource map
@@ -125,7 +127,7 @@ material props0 (RenderPipeline gpip rpass (rdset, rres, dpool0) shaders uq) = L
   -- updated information.
   pure
     ( mkMat (Done (dset2, resources2, Ur uniq)) props1
-    , RenderPipeline gpip rpass (rdset, rres, dpool3) shaders uq
+    , RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool3) shaders uq
     )
   where
     mkMat :: ∀ b. Material '[] ⊸ PropertyBindings b ⊸ Material b

ghengin-core/ghengin-core/Ghengin/Core/Mesh.hs

@@ -36,6 +36,8 @@ import Ghengin.Core.Renderer.DescriptorSet
 import Ghengin.Core.Log
 import Ghengin.Core.Type.Utils (Some(..))
 
+import qualified Data.IntMap.Strict as IM
+
 import qualified Data.Linear.Alias as Alias
 
 {-
@@ -128,14 +130,14 @@ createMesh :: (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex
             -- ^ Vertices
            -> Renderer (Mesh ts props, RenderPipeline π bs)
 createMesh (RenderProperty pr rps) props0 vs = createMesh rps props0 vs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
-createMesh (RenderPipeline gpip rpass (rdset, rres, dpool0) shaders uq) props0 (SV.fromList -> vs) = enterD "createMesh" Linear.do
+createMesh (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 (SV.fromList -> vs) = enterD "createMesh" Linear.do
   Ur uniq      <- liftSystemIOU newUnique
   vertexBuffer <- createVertexBuffer vs
 
-  (dset0, rmap0, dpool1, props1) <- allocateDescriptorsForMeshes dpool0 props0
+  (dset0, rmap0, dpool1, props1) <- allocateDescriptorsForMeshes bmap dpool0 props0
 
   pure ( mkMesh (SimpleMesh vertexBuffer (dset0, rmap0) uniq) props1
-       , RenderPipeline gpip rpass (rdset, rres, dpool1) shaders uq
+       , RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool1) shaders uq
        )
 
 -- | Like 'createMesh', but create the mesh using a vertex buffer created from
@@ -149,23 +151,23 @@ createMeshWithIxs :: HasCallStack => (CompatibleMesh props π, CompatibleVertex
                   -- ^ Indices
                   -> Renderer (Mesh ts props, RenderPipeline π bs)
 createMeshWithIxs (RenderProperty pr rps) props0 vs ixs = createMeshWithIxs rps props0 vs ixs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
-createMeshWithIxs (RenderPipeline gpip rpass (rdset, rres, dpool0) shaders uq) props0 (SV.fromList -> vertices) (SV.fromList -> ixs) = enterD "createMeshWithIxs" Linear.do
+createMeshWithIxs (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 (SV.fromList -> vertices) (SV.fromList -> ixs) = enterD "createMeshWithIxs" Linear.do
   Ur uniq      <- liftSystemIOU newUnique
   vertexBuffer <- createVertexBuffer vertices
   indexBuffer  <- createIndex32Buffer ixs
 
-  (dset0, rmap0, dpool1, props1) <- allocateDescriptorsForMeshes dpool0 props0
+  (dset0, rmap0, dpool1, props1) <- allocateDescriptorsForMeshes bmap dpool0 props0
 
   pure ( mkMesh (IndexedMesh vertexBuffer indexBuffer (dset0, rmap0) uniq) props1
-       , RenderPipeline gpip rpass (rdset, rres, dpool1) shaders uq
+       , RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool1) shaders uq
        )
 
 mkMesh :: ∀ t b. Mesh t '[] ⊸ PropertyBindings b ⊸ Mesh t b
 mkMesh x GHNil = x
 mkMesh x (p :## pl) = MeshProperty p (mkMesh x pl)
 
-allocateDescriptorsForMeshes :: Alias DescriptorPool ⊸ PropertyBindings props ⊸ Renderer (Alias DescriptorSet, Alias ResourceMap, Alias DescriptorPool, PropertyBindings props)
-allocateDescriptorsForMeshes dpool0 props0 = Linear.do
+allocateDescriptorsForMeshes :: DescriptorSetMap -> Alias DescriptorPool ⊸ PropertyBindings props ⊸ Renderer (Alias DescriptorSet, Alias ResourceMap, Alias DescriptorPool, PropertyBindings props)
+allocateDescriptorsForMeshes bmap dpool0 props0 = Linear.do
   -- Mostly just the same as in 'material' in Ghengin.Core.Material
 
   logT "Allocating descriptor set"
@@ -175,7 +177,7 @@ allocateDescriptorsForMeshes dpool0 props0 = Linear.do
 
   logT "Allocating resource map"
   -- Make the resource map for this material
-  (resources0, props1) <- makeResources props0
+  (resources0, props1) <- makeResources (fromMaybe (error "DescriptorSetMap doesn't contain mesh descriptors.") (IM.lookup 2 bmap)) props0
 
   logT "Updating descriptor with resources"
   -- Create the descriptor set with the written descriptors based on the created resource map

ghengin-core/ghengin-core/Ghengin/Core/Render.hs

@@ -28,9 +28,10 @@ import qualified Data.Linear.Alias as Alias
 
 -- I don't know where exactly to put this, so put it here for now
 getDescriptorResource :: ResourceMap ⊸ Int -> Renderer (DescriptorResource, ResourceMap)
-getDescriptorResource resourcemap i = enterD "getUniformBuffer" $
+getDescriptorResource resourcemap i = enterD "getDescriptorResource" $
   IM.lookupM i resourcemap >>= \case
     (Just x, rmap1) -> pure (x, rmap1)
     (Nothing, rmap1) -> Linear.do
       Alias.forget rmap1
-      error $ "Expecting a uniform descriptor resource at binding " <> show i <> " but found nothing!"
+      error $ "Expecting a descriptor resource at binding " <> show i <> " but found nothing!"
+

ghengin-core/ghengin-core/Ghengin/Core/Render/Pipeline.hs

@@ -40,6 +40,8 @@ import qualified FIR.Pipeline
 
 import qualified Data.Linear.Alias as Alias
 
+import qualified Data.IntMap.Strict as IM
+
 import Ghengin.Core.Render.Property
 import Ghengin.Core.Shader.Pipeline ( ShaderPipeline )
 import Data.Unique
@@ -58,7 +60,7 @@ data RenderPipeline info tys where
 
   RenderPipeline :: RendererPipeline Graphics -- ^ The graphics pipeline underlying this render pipeline. Can a graphics pipeline be shared amongst Render Pipelines such that this field needs to be ref counted?
                  ⊸  Alias RenderPass -- ^ A reference counted reference to a render pass, since we might share render passes amongst pipelines
-                 ⊸  (Alias DescriptorSet, Alias ResourceMap, Alias DescriptorPool) -- A descriptor set per frame; currently we are screwing up drawing multiple frames. Descriptor Set for the render properties.
+                 ⊸  (Alias DescriptorSet, Alias ResourceMap, Ur DescriptorSetMap, Alias DescriptorPool) -- A descriptor set per frame; currently we are screwing up drawing multiple frames. Descriptor Set for the render properties.
                  ⊸  ShaderPipeline info
                  -> Unique
                  -> RenderPipeline info '[] 
@@ -77,9 +79,9 @@ data SomePipeline = ∀ α β. SomePipeline (RenderPipeline α β)
 -- Shader pipeline and buffers are only be created once and reused across
 -- render packets that use the same one (Note that render packets store
 -- references to these things).
--- TODO: Currently we assume all our descriptor sets are Uniform buffers and
--- our buffers too but eventually Uniform will be just a constructor of a more
--- general Buffer and we should select the correct type of buffer individually.
+-- TODO: Currently we assume all our descriptor sets are Uniform or Storage buffers
+-- and our buffers too but eventually Uniform & Storage will be just a constructor of
+-- a more general Buffer and we should select the correct type of buffer individually.
 makeRenderPipeline :: forall τ info tops descs strides
                     . ( PipelineConstraints info tops descs strides
                       , CompatiblePipeline τ info
@@ -105,7 +107,7 @@ makeRenderPipelineWith gps renderPass shaderPipeline props0 = Linear.do
   -- Create the descriptor sets and graphics pipeline based on the shader
   -- pipeline
   --
-  -- (1) Create the uniform buffers and the mapped memory
+  -- (1) Create the uniform/storage buffers and the mapped memory
   -- (2) Create the descriptor sets from the descriptor set layout
   -- (3) Update the descriptor sets with the buffers information
   --
@@ -122,8 +124,10 @@ makeRenderPipelineWith gps renderPass shaderPipeline props0 = Linear.do
   -- properties.
   -- Each Material and Mesh then allocates additional descriptor sets from this pool on creation.
 
+  (Ur descSetMap) <- pure $ createDescriptorSetBindingsMap shaderPipeline
+
   logT "Creating descriptor pool"
-  dpool0 <- createDescriptorPool shaderPipeline
+  dpool0 <- createDescriptorPool descSetMap
 
   -- Allocate descriptor set #0 to be used by this render pipeline's
   -- render properties
@@ -135,7 +139,7 @@ makeRenderPipelineWith gps renderPass shaderPipeline props0 = Linear.do
 
   -- Make the resource map for this render pipeline using the dummyRP
   logT "Making resources"
-  (resources0, props1) <- makeResources props0
+  (resources0, props1) <- makeResources ((fromMaybe (error "DescriptorSetMap doesn't contain shader pipeline descriptors.") (IM.lookup 0 descSetMap))) props0
 
   -- Bind resources to descriptor set
   logT "Updating descriptor set"
@@ -161,7 +165,7 @@ makeRenderPipelineWith gps renderPass shaderPipeline props0 = Linear.do
   -- Make the unique identifier for this pipeline reference
   Ur uniq <- liftSystemIOU newUnique
 
-  pure $ mkRP (RenderPipeline pipeline renderPass (dset2, resources2, dpool5) shaderPipeline uniq) props1
+  pure $ mkRP (RenderPipeline pipeline renderPass (dset2, resources2, (Ur descSetMap), dpool5) shaderPipeline uniq) props1
     where
       mkRP :: ∀ info (b :: [Type]). RenderPipeline info '[] ⊸ PropertyBindings b ⊸ RenderPipeline info b
       mkRP x GHNil = x
@@ -182,9 +186,9 @@ instance HasProperties (RenderPipeline π) where
 
   descriptors :: RenderPipeline π α ⊸ Renderer (Alias DescriptorSet, Alias ResourceMap, RenderPipeline π α)
   descriptors = \case
-    RenderPipeline gpip rpass (dset0, rmap0, dpool) spip uq -> Linear.do
+    RenderPipeline gpip rpass (dset0, rmap0, dmap, dpool) spip uq -> Linear.do
       ((dset1, rmap1), (dset2, rmap2)) <- Alias.share (dset0, rmap0)
-      pure (dset1, rmap1, RenderPipeline gpip rpass (dset2, rmap2, dpool) spip uq)
+      pure (dset1, rmap1, RenderPipeline gpip rpass (dset2, rmap2, dmap, dpool) spip uq)
     RenderProperty p xs -> Linear.do
       (dset, rmap, mat') <- descriptors xs
       pure (dset, rmap, RenderProperty p mat')
@@ -197,7 +201,7 @@ destroyRenderPipeline :: RenderPipeline α τ ⊸ Renderer ()
 destroyRenderPipeline (RenderProperty b rp) = enterD "Destroying render pipeline" Linear.do
   Alias.forget b
   destroyRenderPipeline rp
-destroyRenderPipeline (RenderPipeline gp rp (a,b,c) _ _) = enterD "Destroying render pipeline" Linear.do
+destroyRenderPipeline (RenderPipeline gp rp (a,b,(Ur _),c) _ _) = enterD "Destroying render pipeline" Linear.do
   Alias.forget a >> Alias.forget b >> Alias.forget c
   Alias.forget rp
   destroyPipeline gp