Multiple #- SOURCE -# Annotation Fixes

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Buffer.hs

@@ -21,37 +21,26 @@ import Data.Bits
 import Vulkan.Zero (zero)
 import qualified Vulkan as Vk
 
-import Ghengin.Vulkan.Renderer.Kernel
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.Kernel
+-- import qualified Ghengin.Vulkan.Renderer.Command as Cmd
 import Ghengin.Vulkan.Renderer.Device
 import Ghengin.Core.Mesh.Vertex
+import qualified Data.Linear.Alias as Alias
 
 import qualified Unsafe.Linear as Unsafe
 
 -- Backpack craziness... importing things from the module we're instancing?
 -- We might need to duplicate these definitions? If we do, does it work?
 -- import {-# SOURCE #-} Ghengin.Core.Renderer.Buffer (Index32Buffer(..), VertexBuffer(..))
 
-import qualified Ghengin.Vulkan.Renderer.Command as Cmd
-
 -------- Specific buffers --------------
 
--- Inlined definitions from Ghengin Core
-data Index32Buffer where
-  Index32Buffer :: !DeviceLocalBuffer
-                 ⊸ Word32
-                -> Index32Buffer
-
 createIndex32Buffer :: SV.Vector Int32 -> Renderer Index32Buffer
 createIndex32Buffer vv = index32buffer <$> createDeviceLocalBuffer Vk.BUFFER_USAGE_INDEX_BUFFER_BIT vv <*> pure (Ur $ fromIntegral $ SV.length vv)
   where
     index32buffer :: DeviceLocalBuffer %1 -> Ur Word32 %1 -> Index32Buffer
     index32buffer d (Ur w) = Index32Buffer d w
 
-data VertexBuffer where
-  VertexBuffer :: !DeviceLocalBuffer
-                ⊸ Word32
-               -> VertexBuffer
-
 createVertexBuffer :: ∀ αs. SV.Storable (Vertex αs) => SV.Vector (Vertex αs) -> Renderer VertexBuffer
 createVertexBuffer vv = vertexBuffer <$> createDeviceLocalBuffer @(Vertex αs) Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT vv <*> pure (Ur $ fromIntegral $ SV.length vv) -- use Locations for vertex buffers
   where
@@ -167,22 +156,13 @@ createBuffer size usage properties = Linear.do
     Prelude.pure (buffer, devMem)
                      )
 
--- | Run a one-shot command that copies the whole data between two buffers.
--- Returns the two buffers, in the order they were passed to the function
-copyBuffer :: Vk.Buffer ⊸ Vk.Buffer ⊸ Vk.DeviceSize -> Renderer (Vk.Buffer, Vk.Buffer)
-copyBuffer src dst size = Linear.do
-  case Cmd.copyFullBuffer src dst size of
-    (cmd, src', dst') -> Linear.do
-      immediateSubmit cmd
-      pure (src', dst')
-
 -- | Fills a staging buffer with data, uses it with the given function that
 -- typically copies the buffer data from the staging buffer to another one
 -- (e.g. creating device local buffers and copying textures to the device), and
 -- finally frees the staging buffer
-withStagingBuffer :: ∀ α ρ. SV.Storable α => SV.Vector α -> (Vk.Buffer ⊸ Vk.DeviceSize -> Renderer ρ) ⊸ Renderer ρ
+withStagingBuffer :: ∀ α (ρ :: Type). SV.Storable α => SV.Vector α -> (Vk.Buffer ⊸ Vk.DeviceSize -> Renderer ρ) ⊸ Renderer ρ
 -- ROMES:TODO: nevermind brackets for now, if we ever make this compile we can worry about linear bracket-ing then
-withStagingBuffer bufferData f = enterD "withStagingBuffer" $ Linear.do
+withStagingBuffer bufferData f = enterD "withStagingBuffer" Linear.do
   -- Accquire staging buffer
   -- -----------------------
   let l          = SV.length bufferData

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Buffer.hs-boot

@@ -0,0 +1,76 @@
+-- | This module currently duplicates Buffer.hsig in ghengin-core, so it can be used in ghengin-vulkan
+module Ghengin.Vulkan.Renderer.Buffer where
+
+import Data.Word (Word, Word32)
+import Data.Int (Int32)
+import qualified Data.Vector.Storable as SV
+-- TODO:Exchange Vk specific types to renderer agnostic enumerations
+import qualified Vulkan as Vk (DescriptorType, BufferUsageFlags, Buffer, DeviceMemory)
+
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.Kernel
+import Ghengin.Core.Mesh.Vertex
+
+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.
+
+It is (probably?) faster to use a mapped buffer if you are writing it a lot.
+The alternative is a DeviceLocalBuffer such as a VertexBuffer, which is
+allocated on the device without being mapped to host-local memory. To write such
+a device-local buffer one needs to allocate a separate mapped buffer called a
+staging buffer and then issue a copy command from the staging buffer to the
+device-local buffer. Device-local buffers are more performant often, but writing
+to them seems much slower.
+
+In Vulkan at least. For some renderers this distinction might not exist...
+
+-}
+
+-------- Specific buffers --------------
+
+data Index32Buffer where
+  Index32Buffer :: !DeviceLocalBuffer
+                 ⊸ Word32                 -- ^ N indices
+                -> Index32Buffer
+
+createIndex32Buffer :: SV.Vector Int32 -- ^ Indices
+                    -> Renderer Index32Buffer
+
+data VertexBuffer where
+  VertexBuffer :: !DeviceLocalBuffer
+                ⊸ Word32               -- ^ N vertices
+               -> VertexBuffer
+
+createVertexBuffer :: ∀ αs. SV.Storable (Vertex αs)
+                   => SV.Vector (Vertex αs) -- ^ Vertices
+                   -> Renderer VertexBuffer
+
+-------- Device-local buffer -----------
+
+data DeviceLocalBuffer where
+  DeviceLocalBuffer :: {-# UNPACK #-} !Vk.Buffer
+                     ⊸ {-# UNPACK #-} !Vk.DeviceMemory
+                     -- ⊸ Word -- Size
+                     ⊸ DeviceLocalBuffer
+
+createDeviceLocalBuffer :: ∀ α. SV.Storable α => Vk.BufferUsageFlags -> SV.Vector α -> Renderer DeviceLocalBuffer
+
+destroyDeviceLocalBuffer :: DeviceLocalBuffer ⊸ Renderer ()
+
+-------- Mapped Buffer -----------------
+
+-- | A mapped (uniform) buffer. See Note [Mapped vs Device-local Buffers]
+data MappedBuffer
+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)
+
+

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Command.hs

@@ -70,12 +70,17 @@ import Foreign.Storable
 import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import Data.Vector (Vector)
+import qualified Data.Vector as Vector
 import qualified Vulkan.CStruct.Extends as Vk
 import qualified Vulkan.Zero as Vk
 import qualified Vulkan      as Vk
 
 import Ghengin.Vulkan.Renderer.Device
-import Ghengin.Vulkan.Renderer.Command
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.RenderPass
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.DescriptorSet
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.Pipeline
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.Kernel
+import {-# SOURCE #-} Ghengin.Vulkan.Renderer.Buffer
 
 import Ghengin.Core.Type.Utils (w32)
 import Ghengin.Core.Log
@@ -241,7 +246,7 @@ recordCommandOneShot = Unsafe.toLinear2 \buf (Command cmds) -> Linear.do
 {-# INLINE recordCommandOneShot #-}
 
 -- | Make a render pass part a command blueprint that can be further composed with other commands
-renderPassCmd' :: Linear.MonadIO m => Vk.RenderPass -> Vk.Framebuffer -> Vk.Extent2D -> RenderPassCmdM m a -> CommandM m a
+renderPassCmd' :: Linear.MonadIO m => Vk.RenderPass -> Vk.Framebuffer -> Vk.Extent2D -> RenderPassCmd m -> Command m
 renderPassCmd' rpass frameBuffer renderAreaExtent (RenderPassCmd rpcmds) = Command $ ReaderT \buf -> Linear.do
   let
     renderPassInfo = Vk.RenderPassBeginInfo { next = ()
@@ -466,7 +471,7 @@ drawVertexBufferIndexed (VertexBuffer (DeviceLocalBuffer vbuf mem) nverts) (Inde
        , Index32Buffer (DeviceLocalBuffer ibuf' imem) nixs
        )
 
-bindGraphicsPipeline :: Linear.MonadIO m => RendererPipeline Graphics ⊸ RenderPassCmdM m GraphicsPipeline
+bindGraphicsPipeline :: Linear.MonadIO m => RendererPipeline Graphics ⊸ RenderPassCmdM m (RendererPipeline Graphics)
 bindGraphicsPipeline pp = bindGraphicsPipeline' pp._pipeline
 {-# INLINE bindGraphicsPipeline #-}
 
@@ -479,7 +484,7 @@ bindGraphicsDescriptorSet pipelay ix dset = bindGraphicsDescriptorSet' pipelay._
 
 renderPassCmd :: Linear.MonadIO m => Int -- ^ needs a good explanation...
               -> RenderPass -> Vk.Extent2D -> RenderPassCmd m -> Command m
-renderPassCmd currentImage = Unsafe.toLinear \rpass renderAreaExtent rpcmds -> renderPassCmd' rpass._renderPass (rpass._framebuffers V.! currentImage) renderAreaExtent rpcmds
+renderPassCmd currentImage = Unsafe.toLinear \rpass renderAreaExtent rpcmds -> renderPassCmd' rpass._renderPass (rpass._framebuffers Vector.! currentImage) renderAreaExtent rpcmds
 
 ----- Linear Unsafe Utils
 

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs-boot

@@ -1,5 +1,6 @@
 module Ghengin.Vulkan.Renderer.DescriptorSet where
 
+import Data.Int
 import Data.Maybe (Maybe)
 import Data.Word (Word)
 import Data.IntMap (IntMap)
@@ -11,3 +12,8 @@ data DescriptorPool =
   DescriptorPool { dpool :: Vk.DescriptorPool
                  , set_bindings :: IntMap (Vk.DescriptorSetLayout, BindingsMap)
                  }
+
+data DescriptorSet
+  = DescriptorSet { _ix :: Int
+                  , _descriptorSet :: Vk.DescriptorSet
+                  }

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Kernel.hs

@@ -14,7 +14,7 @@ import Control.Monad.IO.Class.Linear as Linear
 import qualified Data.V.Linear as V
 
 import Ghengin.Vulkan.Renderer.Device
-import Ghengin.Vulkan.Renderer.Command (Command)
+import Ghengin.Vulkan.Renderer.Command (Command, copyFullBuffer)
 import Ghengin.Vulkan.Renderer.ImmediateSubmit
 import Ghengin.Vulkan.Renderer.SwapChain
 import Ghengin.Vulkan.Renderer.Frame
@@ -123,6 +123,15 @@ immediateSubmit cmd = renderer $ \(REnv{..}) -> Linear.do
   (dev', imsctx') <- immediateSubmit' _vulkanDevice _immediateSubmit cmd
   pure ((), REnv{_vulkanDevice=dev',_immediateSubmit=imsctx',..})
 
+-- | Run a one-shot command that copies the whole data between two buffers.
+-- Returns the two buffers, in the order they were passed to the function
+copyBuffer :: Vk.Buffer ⊸ Vk.Buffer ⊸ Vk.DeviceSize -> Renderer (Vk.Buffer, Vk.Buffer)
+copyBuffer src dst size = Linear.do
+  case Cmd.copyFullBuffer src dst size of
+    (cmd, src', dst') -> Linear.do
+      immediateSubmit cmd
+      pure (src', dst')
+
 -- | Get the extent of the images in the swapchain?
 getRenderExtent :: Renderer (Ur Vk.Extent2D)
 getRenderExtent = renderer $ Unsafe.toLinear $ \renv -> pure (Ur renv._vulkanSwapChain._surfaceExtent, renv)

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Kernel.hs-boot

@@ -0,0 +1,20 @@
+module Ghengin.Vulkan.Renderer.Kernel where
+
+import Ghengin.Core.Prelude
+import Ghengin.Core.Log
+import Ghengin.Vulkan.Renderer.Device
+import qualified Prelude
+import qualified Vulkan as Vk
+import qualified Data.Linear.Alias as Alias
+
+type Alias = Alias.Alias Renderer
+data Renderer a
+instance Functor Renderer
+instance Applicative Renderer
+instance Monad Renderer
+instance MonadIO Renderer
+instance HasLogger Renderer
+
+copyBuffer :: Vk.Buffer ⊸ Vk.Buffer ⊸ Vk.DeviceSize -> Renderer (Vk.Buffer, Vk.Buffer)
+unsafeUseVulkanDevice :: (VulkanDevice -> Prelude.IO b) -> Renderer b
+unsafeUseDevice :: (Vk.Device -> Prelude.IO b) -> Renderer b

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/Pipeline.hs-boot

@@ -0,0 +1,12 @@
+module Ghengin.Vulkan.Renderer.Pipeline where
+
+import qualified Vulkan as Vk
+
+data RendererPipeline (t :: PipelineType)
+  = VulkanPipeline { _pipeline :: Vk.Pipeline
+                   , _pipelineLayout :: Vk.PipelineLayout
+                   }
+
+-- ROMES:TODO: Type data
+data PipelineType = Graphics | Compute
+

ghengin-vulkan/ghengin-vulkan/Ghengin/Vulkan/Renderer/RenderPass.hs-boot

@@ -0,0 +1,17 @@
+module Ghengin.Vulkan.Renderer.RenderPass where
+
+import qualified Vulkan as Vk
+import qualified Data.Vector as Vector
+
+data RenderPass = VulkanRenderPass { _renderPass :: Vk.RenderPass
+                                   -- | We bundle framebuffer with the 
+                                   -- RenderPass because in rendering we have 
+                                   -- a fixed SwapChain so the Framebuffer is
+                                   -- differentiated just from the rendering pass.
+                                   -- That means that we have to create a
+                                   -- framebuffer for all of the images
+                                   -- in the swap chain and use the one
+                                   -- that corresponds to the retrieved
+                                   -- image at drawing time.
+                                   , _framebuffers :: Vector.Vector Vk.Framebuffer
+                                   }