From fa4f2d6838ee051af080267793dbbd22f5b36163 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 14 May 2023 13:28:19 +0200 Subject: [PATCH] optimisation --- src/CommandBuffer.hs | 1 + src/Init.hs | 15 ++++++- src/Mesh.hs | 102 ++++++++++++++++++++++++++++++++---------- src/Sync.hs | 77 +++++++++++++++++++++++++++++++ src/Types.hs | 49 +++++++++++--------- src/Util.hs | 16 +++++++ vulkan-tutorial.cabal | 1 + 7 files changed, 215 insertions(+), 46 deletions(-) create mode 100644 src/Sync.hs diff --git a/src/CommandBuffer.hs b/src/CommandBuffer.hs index e6be19d..057ba09 100644 --- a/src/CommandBuffer.hs +++ b/src/CommandBuffer.hs @@ -21,6 +21,7 @@ import qualified VulkanMemoryAllocator as VMA -- internal imports import Devices +import Sync import Types import Memory import Util diff --git a/src/Init.hs b/src/Init.hs index a72bdf2..474f8a4 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -30,6 +30,7 @@ import Memory import Types import Mesh import CommandBuffer +import Sync import Util initEngine @@ -89,6 +90,8 @@ initVulkan window = do vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance (vulkanLogicalDevice, surfaceFormats) <- createLogicalDevice vulkanPhysicalDevice vulkanSurface + uploadContext <- initSyncStructures vulkanPhysicalDevice vulkanLogicalDevice + (descriptorSetLayout1, descriptorSetLayout2, descriptorPool) <- initDescriptors vulkanLogicalDevice allocator <- initAllocator vulkanPhysicalDevice vulkanLogicalDevice vulkanInstance @@ -118,9 +121,16 @@ initVulkan window = do frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions - (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice allocator descriptorPool descriptorSetLayout1 descriptorSetLayout2 + (frames, queue) <- + createFrames + vulkanPhysicalDevice + vulkanLogicalDevice + allocator + descriptorPool + descriptorSetLayout1 + descriptorSetLayout2 - loadMeshes allocator + loadMeshes allocator uploadContext queue vulkanLogicalDevice initScene @@ -149,6 +159,7 @@ initVulkan window = do (V4 0 0 0 0) (V4 0 0 0 0) ) + uploadContext initScene :: (MonadReader ReadState m, MonadIO m) => m () diff --git a/src/Mesh.hs b/src/Mesh.hs index f6cf743..1a30d70 100644 --- a/src/Mesh.hs +++ b/src/Mesh.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} module Mesh where import Codec.Wavefront @@ -8,7 +9,7 @@ import Codec.Wavefront import qualified Control.Concurrent.STM as STM import qualified Control.Monad as CM (void) import Control.Monad.IO.Class -import Control.Monad.Reader (asks) +import Control.Monad.Reader import Control.Monad.Trans.Resource import qualified Data.Map.Strict as M @@ -25,19 +26,24 @@ import qualified Vulkan.Zero as Vk -- internal imports import Types +import Sync loadMeshes - :: VMA.Allocator - -> Render () -loadMeshes allocator = do + :: (MonadReader ReadState m, MonadResource m, MonadFail m) + => VMA.Allocator + -> UploadContext + -> Vk.Queue + -> Vk.Device + -> m () +loadMeshes allocator uploadContext queue device = do let triangle = V.fromList [ Vertex (V3 0.5 0.5 0) (V3 0 0 0) (V4 0 1 0 1) , Vertex (V3 (-0.5) 0.5 0) (V3 0 0 0) (V4 0 1 0 1) , Vertex (V3 0 (-0.5) 0) (V3 0 0 0) (V4 0 1 0 1) ] - triMesh <- uploadMesh triangle allocator - maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator + triMesh <- uploadMesh triangle allocator uploadContext queue device + maskMesh <- loadFromObj "./assets/cat_mask_cyberpunk.obj" allocator uploadContext queue device meshLib <- asks meshLibrary @@ -52,30 +58,75 @@ uploadMesh :: (MonadResource m, MonadFail m) => V.Vector Vertex -> VMA.Allocator + -> UploadContext + -> Vk.Queue + -> Vk.Device -> m Mesh -uploadMesh vertices allocator = do - let bufferCreateInfo = Vk.zero - { Vk.size = fromIntegral $ - V.length vertices * sizeOf (Vertex (V3 0 0 0) (V3 0 0 0 ) (V4 0 0 0 0)) - , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT +uploadMesh vertices allocator uploadContext queue device = do + + let bufferSize = fromIntegral $ V.length vertices * sizeOf (undefined :: Vertex) + stagingBufferCrateInfo = Vk.zero + { Vk.size = bufferSize + , Vk.usage = Vk.BUFFER_USAGE_TRANSFER_SRC_BIT } - allocationCreateInfo = Vk.zero - { VMA.usage = VMA.MEMORY_USAGE_CPU_TO_GPU + stagingAllocationCreateInfo = Vk.zero + { VMA.usage = VMA.MEMORY_USAGE_CPU_ONLY } :: VMA.AllocationCreateInfo - mesh <- do - (buffer, bAllocation, bInfo) <- snd <$> - VMA.withBuffer allocator bufferCreateInfo allocationCreateInfo allocate - return (Mesh vertices (AllocatedBuffer buffer bAllocation bInfo)) + + (stagingReleaseKey, stagingBuffer) <- do + (releaseKey, (buffer, bAllocation, bInfo)) <- + VMA.withBuffer allocator stagingBufferCrateInfo stagingAllocationCreateInfo allocate + return (releaseKey, AllocatedBuffer + { bufferInfo = bInfo + , bufferAllocation = bAllocation + , allocatedBuffer = buffer + }) (dataReleaseKey, dataPtr) <- - VMA.withMappedMemory allocator (bufferAllocation $ meshBuffer mesh) allocate + VMA.withMappedMemory allocator (bufferAllocation stagingBuffer) allocate - liftIO $ mapM_ (\(idx, vertex) -> - poke (castPtr (dataPtr `plusPtr` (idx * sizeOf vertex))) vertex + liftIO $ V.mapM_ (\(idx, vertex) -> + poke + (castPtr dataPtr `plusPtr` (idx * sizeOf vertex)) + vertex ) - (zip [0..] (V.toList vertices)) + (V.zip + (V.fromList [0..]) + vertices + ) - release dataReleaseKey + liftIO $ release dataReleaseKey + + let vertexBufferCreateInfo = Vk.zero + { Vk.size = bufferSize + , Vk.usage = Vk.BUFFER_USAGE_VERTEX_BUFFER_BIT .|. Vk.BUFFER_USAGE_TRANSFER_DST_BIT + } + allocationCreateInfo = Vk.zero + { VMA.usage = VMA.MEMORY_USAGE_GPU_ONLY + } :: VMA.AllocationCreateInfo + + mesh <- do + (buffer, bAllocation, bInfo) <- snd <$> + VMA.withBuffer allocator vertexBufferCreateInfo allocationCreateInfo allocate + return $ Mesh + { meshVertices = vertices + , meshBuffer = AllocatedBuffer + { bufferInfo = bInfo + , bufferAllocation = bAllocation + , allocatedBuffer = buffer + } + } + + immediateSubmit uploadContext queue device$ \cmd -> do + let copy = V.singleton $ Vk.BufferCopy + { size = bufferSize + , dstOffset = 0 + , srcOffset = 0 + } + + Vk.cmdCopyBuffer cmd (allocatedBuffer stagingBuffer) (allocatedBuffer $ meshBuffer mesh) copy + + release stagingReleaseKey return mesh @@ -83,15 +134,18 @@ loadFromObj :: (MonadResource m, MonadFail m) => FilePath -> VMA.Allocator + -> UploadContext + -> Vk.Queue + -> Vk.Device -> m Mesh -loadFromObj filepath vma = do +loadFromObj filepath vma uploadContext queue device = do eitherObj <- liftIO $ fromFile filepath case eitherObj of Left err -> error ("loadFromObj: loading mesh data: " <> err) Right obj -> do let vertices = digestFaces (objFaces obj) (objLocations obj) - uploadMesh vertices vma + uploadMesh vertices vma uploadContext queue device where digestFaces :: V.Vector (Element Face) -> V.Vector Location -> V.Vector Vertex digestFaces faces locations = diff --git a/src/Sync.hs b/src/Sync.hs new file mode 100644 index 0000000..357b96c --- /dev/null +++ b/src/Sync.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +module Sync where + +import Control.Monad.Trans.Resource +import Data.Bits (bit) +import qualified Data.Vector as V +import qualified Vulkan as Vk +import qualified Vulkan.Zero as Vk + +-- internal imports + +import Control.Monad.Reader +import Devices +import Types +import Util + +initSyncStructures + :: (MonadResource m) + => Vk.PhysicalDevice + -> Vk.Device + -> m UploadContext +initSyncStructures physicalDevice logicalDevice = do + + let fenceCreateInfo = Vk.zero + + syncFence <- snd <$> + Vk.withFence logicalDevice fenceCreateInfo Nothing allocate + + queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT + + let uploadCommandPoolCreateInfo = Vk.zero + { Vk.queueFamilyIndex = queueFamilyIndex + } :: Vk.CommandPoolCreateInfo + + syncCommandPool <- snd <$> + Vk.withCommandPool logicalDevice uploadCommandPoolCreateInfo Nothing allocate + + let cmdBufAllocInfo = Vk.zero + { Vk.commandPool = syncCommandPool + , Vk.commandBufferCount = 1 + } + + syncCommandBuffer <- V.head . snd <$> Vk.withCommandBuffers logicalDevice cmdBufAllocInfo allocate + + return $ UploadContext + { uploadFence = syncFence + , uploadCommandBuffer = syncCommandBuffer + , uploadCommandPool = syncCommandPool + } + +immediateSubmit + :: (MonadIO m) + => UploadContext + -> Vk.Queue + -> Vk.Device + -> (Vk.CommandBuffer -> m ()) + -> m () +immediateSubmit uploadContext queue device func = do + + let cmdBegin = beginCommandBuffer Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT + + Vk.useCommandBuffer + (uploadCommandBuffer uploadContext) + cmdBegin + (func (uploadCommandBuffer uploadContext)) + + let submitInfo = createSubmitInfo (uploadCommandBuffer uploadContext) + + Vk.queueSubmit queue submitInfo (uploadFence uploadContext) + + void $ Vk.waitForFences device (V.singleton $ uploadFence uploadContext) True maxBound + Vk.resetFences device (V.singleton $ uploadFence uploadContext) + + Vk.resetCommandPool device (uploadCommandPool uploadContext) (bit 0) diff --git a/src/Types.hs b/src/Types.hs index 781677b..8c3637e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,24 +24,25 @@ data ShaderContainer = ShaderContainer deriving (Show) data EngineData = EngineData - { engineWindow :: SDL.Window - , engineWindowDimensions :: V2 CInt - , enginePhysicalDevice :: Vk.PhysicalDevice - , engineLogicalDevice :: Vk.Device - , engineInstance :: Vk.Instance - , engineSwapchain :: Vk.SwapchainKHR - , engineQueue :: Vk.Queue - , engineFramebuffers :: V.Vector Vk.Framebuffer - , engineRenderPass :: Vk.RenderPass - , engineAllocator :: VMA.Allocator - , engineDepthImageView :: Vk.ImageView - , engineDepthImage :: AllocatedImage - , engineDepthFormat :: Vk.Format - , engineFrames :: V.Vector FrameData - , engineGlobalSetLayout :: Vk.DescriptorSetLayout - , engineObjectSetLayout :: Vk.DescriptorSetLayout - , engineDescriptorPool :: Vk.DescriptorPool - , engineSceneParameters :: GPUSceneData + { engineWindow :: SDL.Window + , engineWindowDimensions :: V2 CInt + , enginePhysicalDevice :: Vk.PhysicalDevice + , engineLogicalDevice :: Vk.Device + , engineInstance :: Vk.Instance + , engineSwapchain :: Vk.SwapchainKHR + , engineQueue :: Vk.Queue + , engineFramebuffers :: V.Vector Vk.Framebuffer + , engineRenderPass :: Vk.RenderPass + , engineAllocator :: VMA.Allocator + , engineDepthImageView :: Vk.ImageView + , engineDepthImage :: AllocatedImage + , engineDepthFormat :: Vk.Format + , engineFrames :: V.Vector FrameData + , engineGlobalSetLayout :: Vk.DescriptorSetLayout + , engineObjectSetLayout :: Vk.DescriptorSetLayout + , engineDescriptorPool :: Vk.DescriptorPool + , engineSceneParameters :: GPUSceneData + , engineUploadContext :: UploadContext } data AllocatedBuffer = AllocatedBuffer @@ -60,7 +61,7 @@ data Vertex = Vertex instance Storable Vertex where - sizeOf (Vertex position normal color) = sizeOf position + sizeOf normal + sizeOf color + sizeOf _ = sizeOf (undefined :: V3 Float) * 2 + sizeOf (undefined :: V4 Float) peek ptr = do pos <- peek (castPtr ptr) @@ -180,7 +181,8 @@ data ReadState = ReadState newtype RenderReader rd m a = RenderReader { runRenderInner :: RenderInner rd m a } - deriving (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail) + deriving + (Functor, Applicative, Monad, MonadIO, MonadReader rd, MonadResource, MonadFail) type RenderInner rd m = ReaderT rd m @@ -285,3 +287,10 @@ instance Storable GPUSceneData where poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist)) ambCol poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol)) sunDir poke (castPtr $ ptr `plusPtr` (sizeOf fogCol + sizeOf fogDist + sizeOf ambCol + sizeOf sunDir)) sunCol + +data UploadContext = UploadContext + { uploadFence :: Vk.Fence + , uploadCommandPool :: Vk.CommandPool + , uploadCommandBuffer :: Vk.CommandBuffer + } + deriving (Show) diff --git a/src/Util.hs b/src/Util.hs index e0011cf..2e54d7e 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -64,3 +64,19 @@ writeDescriptorBuffer type' dstSet dBufferInfo binding = Vk.SomeStruct $ , Vk.descriptorType = type' , Vk.bufferInfo = V.singleton dBufferInfo } + +beginCommandBuffer + :: Vk.CommandBufferUsageFlags + -> Vk.CommandBufferBeginInfo '[] +beginCommandBuffer flags = + Vk.zero + { Vk.flags = flags + } + +createSubmitInfo + :: Vk.CommandBuffer + -> V.Vector (Vk.SomeStruct Vk.SubmitInfo) +createSubmitInfo cmd = V.singleton $ Vk.SomeStruct $ + Vk.zero + { Vk.commandBuffers = V.singleton (Vk.commandBufferHandle cmd) + } diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal index 9b14870..6134990 100644 --- a/vulkan-tutorial.cabal +++ b/vulkan-tutorial.cabal @@ -34,6 +34,7 @@ executable vulkan-tutorial Memory Mesh Image + Sync Types Util