Use Block in favour of Storable when possible

examples/common/Common.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
 module Common where
 
 import Data.Coerce
@@ -39,6 +40,7 @@ import qualified Ghengin.Core.Shader as G
 import qualified Math.Linear as FIR
 import qualified Prelude
 import Data.Typeable
+import Graphics.Gl.Block
 
 viewportVertices :: [ Vertex '[Vec3] ]
 viewportVertices =
@@ -56,11 +58,13 @@ viewportIndices
 
 newtype MousePos = MousePos Vec2
   deriving ShaderData via (StructVec2 "mousePos")
-  deriving Storable
+  deriving Generic
+  deriving anyclass Block
 
 newtype Time = Time Float
   deriving ShaderData via (StructFloat "val")
-  deriving Storable
+  deriving Generic
+  deriving anyclass Block
 
 type PipelineProps = [MousePos, Time]
 

examples/ghengin-games.cabal

@@ -37,8 +37,8 @@ common common-flags
     -- Can't depend on ghengin-core and friends without instancing them because of backpack
     ghengin-core, ghengin-core:vulkan, ghengin:geometry, ghengin-core:backend-independent-bits,
     ghengin:camera, mtl, vector, hsnoise, containers, random, linear-base,
-    derive-storable, geomancy, vulkan >= 3.26, time, fir, filepath, text-short,
-    vector-sized, base >=4.19.0.0, os-string
+    geomancy, vulkan >= 3.26, time, fir, filepath, text-short,
+    vector-sized, base >=4.19.0.0, os-string, gl-block
 
   if flag(debug)
     ghc-options: -Wall
@@ -206,7 +206,7 @@ executable simple-camera
     import:        common-flags
     main-is:       Main.hs
     other-modules: Shaders
-    build-depends: ghengin-games, derive-storable
+    build-depends: ghengin-games
     hs-source-dirs: simple-camera/
 
 

examples/simple-camera/Main.hs

@@ -7,7 +7,6 @@
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 module Main where
 
-import Foreign.Storable.Generic -- we want to get rid of storable in favour of gl-block
 import GHC.Generics
 import Geomancy.Vec3
 import Geomancy.Mat4
@@ -96,7 +95,7 @@ data Camera
            , proj :: Mat4
            }
            deriving Generic
-           deriving anyclass GStorable
+           deriving anyclass Block
 
 
 defaultCamera :: Camera

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

@@ -11,10 +11,9 @@ module Ghengin.Core.Mesh.Vertex
   ) where
 
 import GHC.TypeNats
-import Data.Kind
 import Data.Proxy
 import Graphics.Gl.Block
-import Foreign.Ptr.Diff (Diff(..), peekDiffOff, pokeDiffOff)
+import Foreign.Ptr.Diff (Diff(..))
 import Foreign.Storable
 import Prelude
 
@@ -25,6 +24,13 @@ import Prelude
 -- specification...
 -- https://sheaf.gitlab.io/fir/FIR-Validation-Layout.html
 --
+-- The vulkan docs for shader layouts:
+-- https://docs.vulkan.org/guide/latest/shader_memory_layout.html
+--
+-- std140 may be very slightly slower (?) if this were put under a lot of stress
+-- (though it never will) -- for that case we could use existing vulkan
+-- extensions to allow std430 for uniform buffers too (VK_KHR_uniform_buffer_standard_layout)
+--
 -- So I don't even know if it is possible to provide an instance for a vertex
 -- of any attributes. Maybe FIR's Poke can do it...
 --
@@ -95,9 +101,9 @@ instance (Block (Vertex (y:ys)), Block x) => Block (Vertex (x:y:ys)) where
     writePacked p (Diff o) (Sin a)
     writePacked p (Diff $ o + sizeOfPacked (Proxy @(Vertex '[x]))) b
 
--- This isn't quite right since Vertices need to abide by the
--- location/component layout specification... but since Std140 gives some
--- padding this should work fine if you are using Vertices with Vector attributes only.
+-- NB: We use Std140 for Storable Vertex, which isn't quite right since
+-- vertices need to abide by the location/component layout, but is fine for now.
+-- Note Ghengin.Vulkan.Renderer.Buffer assumes this too.
 deriving via (Std140 (Vertex '[x])) instance Block x => Storable (Vertex '[x])
 deriving via (Std140 (Vertex (x:y:ys))) instance (Block x, Block (Vertex (y:ys))) => Storable (Vertex (x:y:ys))
 

ghengin-core/ghengin-core-indep/Ghengin/Core/Prelude.hs

@@ -15,7 +15,7 @@ module Ghengin.Core.Prelude
 
   -- base
   , Generic(..), NE.NonEmpty(..), Type, Constraint
-  , Word32, IORef, KnownNat
+  , Word32, IORef, KnownNat, Proxy(..)
 
   -- linear-base
   , bimap, UrT(..)
@@ -31,6 +31,9 @@ module Ghengin.Core.Prelude
   -- reference-counting
   , Aliasable, Forgettable, Shareable, SomeAlias(..)
 
+  -- gl-block
+  , Block(..)
+
   -- * Re-exports under different names
   , (<$$>)
   -- ** With multiplicity generalization
@@ -45,6 +48,7 @@ module Ghengin.Core.Prelude
   )
   where
 
+import Data.Proxy
 import Data.Unrestricted.Linear
 import GHC.TypeLits
 -- Perhaps it would be better to re-export explicit modules instead of their prelude
@@ -83,6 +87,8 @@ import Data.Kind
 import Data.Word
 import Data.IORef (IORef)
 
+import Graphics.Gl.Block
+
 import Data.Linear.Alias as Alias
 
 import qualified Unsafe.Linear as Unsafe

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

@@ -15,7 +15,6 @@ import Control.Functor.Linear as Linear
 import Ghengin.Core.Renderer.Buffer
 import Ghengin.Core.Renderer.Kernel
 import Ghengin.Core.Renderer
-import Ghengin.Core.Renderer.DescriptorSet
 
 import qualified Data.Linear.Alias as Alias
 

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

@@ -8,12 +8,10 @@ module Ghengin.Core.Render.Pipeline where
 -- import Geomancy.Mat4 ( Mat4 )
 -- import Control.Lens (Lens', lens)
 
-import Data.Functor.Compose
-import Data.V.Linear (V,make)
+import Data.V.Linear (make)
 import Ghengin.Core.Prelude as Linear
 
 import Data.Typeable
-import Foreign.Storable ( Storable(sizeOf) )
 
 import Ghengin.Core.Type.Compatible ( CompatiblePipeline )
 
@@ -142,7 +140,7 @@ makeRenderPipeline shaderPipeline props0 = Linear.do
   (pipeline, simpleRenderPass2, dpool2) <- createGraphicsPipeline
                                      shaderPipeline simpleRenderPass dpool1
                                      -- ROMES:TODO: Update push constants! This is not it! (It's hardcoded, and things are never actually pushed)
-                                     [Vk.PushConstantRange { offset = 0 , size   = fromIntegral 64, stageFlags = Vk.SHADER_STAGE_VERTEX_BIT }] -- Model transform in push constant
+                                     [Vk.PushConstantRange { offset = 0 , size = 64 :: Word32, stageFlags = Vk.SHADER_STAGE_VERTEX_BIT }] -- Model transform in push constant
 
   logT "Creating reference counted"
   dpool3 <- Alias.newAlias destroyDescriptorPool dpool2

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

@@ -12,9 +12,9 @@ module Ghengin.Core.Render.Property
   , GHList(..)
   ) where
 
+import Data.Proxy
 import GHC.TypeError
 import Ghengin.Core.Prelude as Linear
-import Foreign.Storable (Storable(sizeOf))
 import Ghengin.Core.Renderer.Kernel
 import Ghengin.Core.Renderer
 import Ghengin.Core.Render
@@ -24,6 +24,8 @@ import qualified Data.Linear.Alias as Alias
 import qualified Data.IntMap.Linear as IM
 import qualified Prelude
 
+import Graphics.Gl.Block
+
 import qualified Vulkan as Vk -- TODO: Core shouldn't depend on any specific renderer implementation external to Core
 
 -- |
@@ -36,15 +38,20 @@ import qualified Vulkan as Vk -- TODO: Core shouldn't depend on any specific ren
 -- frame, you should use a 'DynamicBinding'.
 data PropertyBinding α where
 
+-- NB: Currently, we use std140 for uniform buffers, but this could eventually
+-- be std430 if we used VK_KHR_uniform_buffer_standard_layout. These layouts
+-- are provided by Block from gl-block (though this would require FIR to also
+-- line this up).
+
   -- | Write the property to a mapped buffer every frame
-  DynamicBinding :: ∀ α. (Storable α, PBInv α ~ Ur α) -- Storable to write the buffers
+  DynamicBinding :: ∀ α. (Block α, PBInv α ~ Ur α) -- Block to write the buffers with proper standard
                  => Ur α -- ^ A dynamic binding is written to a mapped buffer based on the value of the constructor every frame
                  -> PropertyBinding α
 
   -- | A static buffer is re-used (without being written to) every frame to bind this property.
   -- The static buffer is written when the property is edited, and only then.
   -- If you want data that updates frequently, use a 'DynamicBinding' instead
-  StaticBinding :: ∀ α. (Storable α, PBInv α ~ Ur α) -- Storable to write the buffers
+  StaticBinding :: ∀ α. (Block α, PBInv α ~ Ur α) -- Block to write the buffers with proper standard
                 => Ur α
                 -> PropertyBinding α
 
@@ -129,20 +136,22 @@ makeResources = go_build 0
     go pb = case pb of
       DynamicBinding (Ur x) -> Linear.do
 
-        -- Allocate the associated buffers
-        mb <- createMappedBuffer (fromIntegral $ sizeOf x) Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
+        -- Allocate the associated buffers. These buffers will be written to
+        -- every frame (unlike buffers underlying `StaticBinding`s)
+        mb <- createMappedBuffer (fromIntegral $ sizeOf140 (Proxy @β)) Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
         pure (UniformResource mb, DynamicBinding (Ur x))
 
       StaticBinding (Ur x) -> Linear.do
 
         -- Allocate the associated buffers
-        mb <- createMappedBuffer (fromIntegral $ sizeOf x) Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER -- TODO: Should this be a deviceLocalBuffer?
+        -- TODO: This be a deviceLocalBuffer
+        -- TODO: instead -> createDeviceLocalBuffer Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT x
+        mb <- createMappedBuffer (fromIntegral $ sizeOf140 (Proxy @β)) Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
 
-        -- Write the static information to this buffer right away
+        -- Write the static information to this buffer right away. It may be
+        -- later updated if the static property is edited with `editProperty`.
         mb' <- writeMappedBuffer mb x
 
-        -- TODO: instead -> createDeviceLocalBuffer Vk.BUFFER_USAGE_UNIFORM_BUFFER_BIT x
-
         pure (UniformResource mb', StaticBinding (Ur x))
 
       Texture2DBinding t -> Linear.do
@@ -166,11 +175,12 @@ makeResources = go_build 0
 writeProperty :: DescriptorResource ⊸ PropertyBinding α ⊸ Renderer (DescriptorResource, PropertyBinding α)
 writeProperty dr pb = case pb of
   StaticBinding x ->
-    -- Already has been written to, we simply bind it together with the rest of
-    -- the set at draw time and do nothing here.
+    -- The static binding is static, and has already has been written to (at
+    -- initialisation and eventually `editProperty`). We simply bind it
+    -- together with the rest of the set at draw time and do nothing here.
     pure (dr, StaticBinding x)
   Texture2DBinding t ->
-  --   -- As above. Static bindings don't get written every frame.
+    -- As above. Static bindings don't get written every frame.
     pure (dr, Texture2DBinding t)
   DynamicBinding (Ur (a :: α)) ->
     case dr of
@@ -377,11 +387,13 @@ editProperty prop update i dset resmap0 = Linear.do
     DynamicBinding (x :: Ur α) -> Linear.do
       Ur ux <- update x
 
-      (UniformResource bufref, resmap1) <- getDescriptorResource resmap0 i
-
-      writeDynamicBinding bufref ux >>= Alias.forget
+      -- We don't need to do the following update on editProperty since
+      -- `writeProperty` will already write the uniform buffer of dynamic
+      -- properties every frame.
+      -- (UniformResource bufref, resmap1) <- getDescriptorResource resmap0 i
+      -- writeDynamicBinding bufref ux >>= Alias.forget
 
-      pure (DynamicBinding (Ur ux), dset, resmap1)
+      pure (DynamicBinding (Ur ux), dset, resmap0)
 
     StaticBinding x -> Linear.do
       Ur ux <- update x
@@ -408,12 +420,9 @@ editProperty prop update i dset resmap0 = Linear.do
       pure (Texture2DBinding ux2, dset1, resmap0)
 
   where
-    writeDynamicBinding :: Storable α => Alias MappedBuffer ⊸ α -> Renderer (Alias MappedBuffer)
-    writeDynamicBinding = writeMappedBuffer @α
-
-    -- TODO: For now, static bindings use a mapped buffer as well, but perhaps
-    -- it'd be better to use a GPU local buffer to which we write only so often
-    writeStaticBinding :: Storable α => Alias MappedBuffer ⊸ α -> Renderer (Alias MappedBuffer)
+    -- TODO: For now, static bindings use a mapped buffer as well, but it'd be
+    -- better to use a GPU local buffer to which we write only so often (see createDeviceLocalBuffer)
+    writeStaticBinding :: Block α => Alias MappedBuffer ⊸ α -> Renderer (Alias MappedBuffer)
     writeStaticBinding = writeMappedBuffer @α
 
     -- | Overwrite the texture bound on a descriptor set at binding #n

ghengin-core/ghengin-core/Ghengin/Core/Renderer.hsig

@@ -10,13 +10,9 @@ signature Ghengin.Core.Renderer
   )
   where
 
-import qualified Data.IntMap.Linear as IM
-import Ghengin.Core.Log
 import Prelude.Linear
 
-import Control.Functor.Linear as Linear
 import System.IO.Linear as Linear
-import Control.Monad.IO.Class.Linear as Linear
 
 import Ghengin.Core.Renderer.Buffer
 import Ghengin.Core.Renderer.Kernel
@@ -25,9 +21,6 @@ import Ghengin.Core.Renderer.Command
 import Ghengin.Core.Renderer.Texture
 import Ghengin.Core.Renderer.Sampler
 
-
-import qualified Data.Linear.Alias as Alias
-
 runRenderer :: (Int, Int)
             -- ^ Dimensions of the window to render on (width, height)
             -> Renderer a ⊸ Linear.IO a

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Buffer.hsig

@@ -8,13 +8,13 @@ import qualified Vulkan as Vk (DescriptorType, BufferUsageFlags)
 
 import Ghengin.Core.Mesh.Vertex
 import Ghengin.Core.Renderer.Kernel
+import Graphics.Gl.Block
 
 import Data.Linear.Alias (Aliasable)
 
 {-
 Note [Mapped vs Device-local Buffers]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 Mapped buffers are buffers of usage 'UNIFORM' (as in uniform buffer) which are
 mapped to a device-local buffer. Writing to a mapped buffer writes host-local
 memory which is synchronized automatically to the device-local memory.
@@ -29,6 +29,23 @@ to them seems much slower.
 
 In Vulkan at least. For some renderers this distinction might not exist...
 
+Note [Block vs Storable]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We use `Block` constraint when we can make the call about which layout to use down the line.
+For MappedBuffer, the (for now) only constructor is Uniform buffer. When
+writing into uniform buffers we know what layout to use (std140).
+
+However, for `DeviceLocalBuffer`s, at the moment, we don't know its use, so we
+delegate the decision of what standard to use to the definition site of the
+`Storable` instance which should in theory be derived via `Std140` or `Std430`
+or `Packed` from `gl-block`.
+
+Furthermore, for Vertex buffers, given that (1) we use device local buffers and
+(2) when copying data from CPU to the device buffers it's useful to have
+storable vectors since they already have the data laid out in memory correctly
+and we can simpy memcopy it over. To have a storable vector, we use `Storable`
+rather than `Block` and delegate again the decision of what standard to use to
+the `Storable` definition site (for `Vertex (...)`, in this case).
 -}
 
 -------- Specific buffers --------------
@@ -66,6 +83,6 @@ instance Aliasable MappedBuffer
 
 -- | TODO: Drop dependency on Vulkan and make DescriptorType a data type renderer agnostic
 createMappedBuffer :: Word -> Vk.DescriptorType -> Renderer (Alias MappedBuffer)
-writeMappedBuffer :: ∀ α. SV.Storable α => Alias MappedBuffer ⊸ α -> Renderer (Alias MappedBuffer)
+writeMappedBuffer :: ∀ α. Block α => Alias MappedBuffer ⊸ α -> Renderer (Alias MappedBuffer)
 
 

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Command.hsig

@@ -2,7 +2,6 @@ signature Ghengin.Core.Renderer.Command where
 
 import Ghengin.Core.Prelude
 import Ghengin.Core.Log
-import Control.Monad.IO.Class.Linear
 import qualified Data.Functor.Linear as Data
 
 import Ghengin.Core.Renderer.Pipeline

ghengin-core/ghengin-core/Ghengin/Core/Renderer/DescriptorSet.hsig

@@ -1,6 +1,5 @@
 signature Ghengin.Core.Renderer.DescriptorSet where
 
-import Data.V.Linear (V)
 import Ghengin.Core.Prelude
 
 import Ghengin.Core.Shader.Pipeline

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Texture.hsig

@@ -2,7 +2,6 @@ signature Ghengin.Core.Renderer.Texture where
 
 import Prelude (FilePath)
 import Data.Linear.Alias (Aliasable)
-import qualified FIR
 
 import Ghengin.Core.Renderer.Sampler
 import Ghengin.Core.Renderer.Kernel
@@ -17,4 +16,3 @@ texture :: FilePath -> Alias Sampler ⊸ Renderer (Alias Texture2D)
 --                  -> Sampler
 --                  -> Renderer Texture2D
 
--- ROMES:TODO: instance FIR.Syntactic Texture2D