diff --git a/src/CommandBuffer.hs b/src/CommandBuffer.hs index 7769826..ae1268b 100644 --- a/src/CommandBuffer.hs +++ b/src/CommandBuffer.hs @@ -22,12 +22,15 @@ import qualified Vulkan.Zero as Vk import Devices import Types -createCommandPool - :: (MonadResource m) +frameOverlap :: Int +frameOverlap = 2 + +createFrames + :: (MonadResource m, MonadFail m) => Vk.PhysicalDevice -> Vk.Device - -> m (Vk.CommandPool, Vk.Queue) -createCommandPool physicalDevice logicalDevice = do + -> m (V.Vector FrameData, Vk.Queue) +createFrames physicalDevice logicalDevice = do queueFamilyIndex <- getQueueFamily physicalDevice Vk.QUEUE_GRAPHICS_BIT @@ -38,31 +41,56 @@ createCommandPool physicalDevice logicalDevice = do graphicsQueue <- Vk.getDeviceQueue logicalDevice queueFamilyIndex 0 - commandPool <- snd <$> allocate - (Vk.createCommandPool logicalDevice poolCreateInfo Nothing) - (\commandPool -> do - putStrLn "destroying command pool" - Vk.destroyCommandPool logicalDevice commandPool Nothing - ) + frames <- V.mapM + (\_ -> do - return (commandPool, graphicsQueue) + commandPool <- snd <$> allocate + (Vk.createCommandPool logicalDevice poolCreateInfo Nothing) + (\commandPool -> do + putStrLn "destroying command pool" + Vk.destroyCommandPool logicalDevice commandPool Nothing + ) -createCommandBuffer - :: (MonadResource m) - => Vk.Device - -> Vk.CommandPool - -> Int - -> m (V.Vector Vk.CommandBuffer) -createCommandBuffer logicalDevice commandPool number = do + let commandBufferAllocationInfo = Vk.zero + { Vk.commandPool = commandPool + , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY + , Vk.commandBufferCount = 1 + } - let commandBufferAllocationInfo = Vk.zero - { Vk.commandPool = commandPool - , Vk.level = Vk.COMMAND_BUFFER_LEVEL_PRIMARY - , Vk.commandBufferCount = 1 + commandBuffer <- Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo + + let semaphoreCreateInfo = Vk.zero + fenceCreateInfo = Vk.zero + { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT + } :: Vk.FenceCreateInfo '[] + + [presentSemaphore, renderSemaphore] <- replicateM 2 + (snd <$> allocate + (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing) + (\semaphore -> do + putStrLn "destroying semaphore" + Vk.destroySemaphore logicalDevice semaphore Nothing + ) + ) + renderFence <- snd <$> allocate + (Vk.createFence logicalDevice fenceCreateInfo Nothing) + (\fence -> do + putStrLn "destroying fence" + Vk.destroyFence logicalDevice fence Nothing + ) + + return FrameData + { framePresentSemaphore = presentSemaphore + , frameRenderSemaphore = renderSemaphore + , frameRenderFence = renderFence + , frameCommandPool = commandPool + , frameMainCommandBuffer = V.head commandBuffer } - V.concat <$> - replicateM number (Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo) + ) + (V.fromList [1 .. frameOverlap]) + + return (frames, graphicsQueue) recordCommandBuffer :: (MonadResource m, MonadReader ReadState m, MonadIO m) @@ -170,31 +198,3 @@ recordCommandBuffer Vk.cmdEndRenderPass commandBuffer Vk.endCommandBuffer commandBuffer - -createSyncObjects - :: (MonadResource m, MonadFail m) - => Vk.Device - -> m (Vk.Semaphore, Vk.Semaphore, Vk.Fence) -createSyncObjects logicalDevice = do - - let semaphoreCreateInfo = Vk.zero - fenceCreateInfo = Vk.zero - { Vk.flags = Vk.FENCE_CREATE_SIGNALED_BIT - } :: Vk.FenceCreateInfo '[] - - [imageAvailableSemaphore, renderFinishedSemaphore] <- replicateM 2 - (snd <$> allocate - (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing) - (\semaphore -> do - putStrLn "destroying semaphore" - Vk.destroySemaphore logicalDevice semaphore Nothing - ) - ) - inFlightFence <- snd <$> allocate - (Vk.createFence logicalDevice fenceCreateInfo Nothing) - (\fence -> do - putStrLn "destroying fence" - Vk.destroyFence logicalDevice fence Nothing - ) - - return (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) diff --git a/src/Draw.hs b/src/Draw.hs index e5eb1a0..55fd27f 100644 --- a/src/Draw.hs +++ b/src/Draw.hs @@ -19,33 +19,30 @@ import qualified Vulkan.Zero as Vk import CommandBuffer import Types +import Util (getFrame) drawFrame :: (MonadResource m, MonadFail m, MonadReader ReadState m) => EngineData + -> Int -> m () -drawFrame engineData = do +drawFrame engineData frameNumber = do - unless (all (V.length (engineCommandBuffers engineData) ==) - [ V.length (engineCommandBuffers engineData) - , V.length (engineFramebuffers engineData) - ]) $ - error ("Numbers of elements mismatch: command buffers " <> - show (V.length $ engineCommandBuffers engineData) <> - ", frame buffers " <> show (V.length $ engineFramebuffers engineData) - ) + let frame = getFrame engineData frameNumber - let fences = V.singleton $ engineInFlightFence engineData - - void $ Vk.waitForFences (engineLogicalDevice engineData) fences True maxBound - Vk.resetFences (engineLogicalDevice engineData) fences + void $ Vk.waitForFences + (engineLogicalDevice engineData) + (V.singleton $ frameRenderFence frame) + True + maxBound + Vk.resetFences (engineLogicalDevice engineData) (V.singleton $ frameRenderFence frame) (imageResult, index) <- Khr.acquireNextImageKHR (engineLogicalDevice engineData) (engineSwapchain engineData) maxBound - (engineImageAvailableSemaphore engineData) + (frameRenderSemaphore frame) Vk.NULL_HANDLE unless (imageResult == Vk.SUCCESS) $ @@ -53,13 +50,13 @@ drawFrame engineData = do -- liftIO $ putStrLn "resetting command buffer" Vk.resetCommandBuffer - (engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0) + (frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0) matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary -- liftIO $ putStrLn "recording command buffer" recordCommandBuffer - (engineCommandBuffers engineData V.! fromIntegral index) + (frameMainCommandBuffer frame) (engineRenderPass engineData) (engineFramebuffers engineData V.! fromIntegral index) (engineWindowDimensions engineData) @@ -68,23 +65,23 @@ drawFrame engineData = do let submitInfo = Vk.zero { Vk.waitSemaphores = - V.singleton $ engineImageAvailableSemaphore engineData + V.singleton $ frameRenderSemaphore frame , Vk.waitDstStageMask = V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT , Vk.commandBuffers = - V.singleton (Vk.commandBufferHandle $ engineCommandBuffers engineData V.! fromIntegral index) + V.singleton (Vk.commandBufferHandle $ frameMainCommandBuffer frame) , Vk.signalSemaphores = - V.singleton $ engineRenderFinishedSemaphore engineData + V.singleton $ framePresentSemaphore frame } -- liftIO $ putStrLn "submitting to queue" Vk.queueSubmit (engineQueue engineData) (V.singleton (Vk.SomeStruct submitInfo)) - (engineInFlightFence engineData) + (frameRenderFence frame) let presentInfo = Vk.zero - { Khr.waitSemaphores = V.singleton $ engineRenderFinishedSemaphore engineData + { Khr.waitSemaphores = V.singleton $ framePresentSemaphore frame , Khr.swapchains = V.singleton $ engineSwapchain engineData , Khr.imageIndices = V.singleton index } diff --git a/src/Init.hs b/src/Init.hs index 79c4a91..e8d6c44 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -24,10 +24,10 @@ import Instance import Devices import GraphicsPipeline import Framebuffers -import CommandBuffer import Memory import Types import Mesh +import CommandBuffer initEngine :: Render EngineData @@ -101,11 +101,7 @@ initVulkan window = do frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews depthImageView dimensions - (commandPool, graphicsQueue) <- createCommandPool vulkanPhysicalDevice vulkanLogicalDevice - commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool (length frameBuffers) - - (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <- - createSyncObjects vulkanLogicalDevice + (frames, queue) <- createFrames vulkanPhysicalDevice vulkanLogicalDevice loadMeshes allocator @@ -118,18 +114,15 @@ initVulkan window = do vulkanLogicalDevice vulkanInstance swapchain - graphicsQueue - commandBuffer + queue frameBuffers meshLayout renderPass - inFlightFence - imageAvailableSemaphore - renderFinishedSemaphore allocator depthImageView depthAllocatedImage Vk.FORMAT_D32_SFLOAT + frames initScene :: (MonadReader ReadState m, MonadIO m) => m () initScene = do diff --git a/src/Main.hs b/src/Main.hs index 5cbed5b..7c082c8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -27,6 +27,7 @@ main = do renderablesContainer <- STM.newTMVarIO (V.empty) meshMap <- STM.newTMVarIO (M.empty) materialMap <- STM.newTMVarIO (M.empty) + frameNumber <- STM.newTMVarIO 0 let initState = ReadState { renderables = renderablesContainer , meshLibrary = meshMap @@ -45,8 +46,12 @@ main = do (liftIO $ STM.atomically $ STM.readTMVar quit ) ( do + number <- liftIO $ STM.atomically $ do + number <- STM.readTMVar frameNumber + void $ STM.swapTMVar frameNumber (succ number) + return number -- draw - drawFrame engineData + drawFrame engineData number -- poll events evs <- liftIO SDL.pollEvents -- flip abort condition on window close diff --git a/src/Types.hs b/src/Types.hs index 3e1410e..c780c88 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -31,17 +31,14 @@ data EngineData = EngineData , engineInstance :: Vk.Instance , engineSwapchain :: Vk.SwapchainKHR , engineQueue :: Vk.Queue - , engineCommandBuffers :: V.Vector Vk.CommandBuffer , engineFramebuffers :: V.Vector Vk.Framebuffer , meshPipelineLayout :: Vk.PipelineLayout , engineRenderPass :: Vk.RenderPass - , engineInFlightFence :: Vk.Fence - , engineImageAvailableSemaphore :: Vk.Semaphore - , engineRenderFinishedSemaphore :: Vk.Semaphore , engineAllocator :: VMA.Allocator , engineDepthImageView :: Vk.ImageView , engineDepthImage :: AllocatedImage , engineDepthFormat :: Vk.Format + , engineFrames :: V.Vector FrameData } data AllocatedBuffer = AllocatedBuffer @@ -180,3 +177,12 @@ type Render a = RenderReader ReadState ResIO a runRender :: ReadState -> Render a -> IO a runRender rd actions = runResourceT $ flip runReaderT rd $ runRenderInner actions + +data FrameData = FrameData + { framePresentSemaphore :: Vk.Semaphore + , frameRenderSemaphore :: Vk.Semaphore + , frameRenderFence :: Vk.Fence + , frameCommandPool :: Vk.CommandPool + , frameMainCommandBuffer :: Vk.CommandBuffer + } + deriving (Show) diff --git a/vulkan-tutorial.cabal b/vulkan-tutorial.cabal index b538e6e..bf470be 100644 --- a/vulkan-tutorial.cabal +++ b/vulkan-tutorial.cabal @@ -35,6 +35,7 @@ executable vulkan-tutorial Mesh Image Types + Util -- LANGUAGE extensions used by modules in this package. -- other-extensions: