diff --git a/src/CommandBuffer.hs b/src/CommandBuffer.hs index 84d2f78..69b96e2 100644 --- a/src/CommandBuffer.hs +++ b/src/CommandBuffer.hs @@ -44,8 +44,9 @@ createCommandBuffer :: (MonadResource m) => Vk.Device -> Vk.CommandPool + -> Int -> m (V.Vector Vk.CommandBuffer) -createCommandBuffer logicalDevice commandPool = do +createCommandBuffer logicalDevice commandPool number = do let commandBufferAllocationInfo = Vk.zero { Vk.commandPool = commandPool @@ -53,7 +54,8 @@ createCommandBuffer logicalDevice commandPool = do , Vk.commandBufferCount = 1 } - Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo + V.concat <$> + replicateM number (Vk.allocateCommandBuffers logicalDevice commandBufferAllocationInfo) recordCommandBuffer :: (MonadResource m) diff --git a/src/Devices.hs b/src/Devices.hs index 2edc9d3..303563b 100644 --- a/src/Devices.hs +++ b/src/Devices.hs @@ -179,6 +179,9 @@ getImageViewHandles swapchain surfaceFormat logicalDevice = do when (result /= Vk.SUCCESS) $ error "getImageHandles: Failed acquiring images from swapchain" + liftIO $ + putStrLn ("number of images: " <> show (V.length handles)) + V.mapM (\image -> do let createInfo = Vk.zero diff --git a/src/Draw.hs b/src/Draw.hs index 98a7740..ed27d49 100644 --- a/src/Draw.hs +++ b/src/Draw.hs @@ -3,6 +3,7 @@ module Draw where import Control.Monad +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import qualified Data.Vector as V import Foreign.C.Types (CInt) @@ -21,11 +22,11 @@ drawFrame => Vk.Device -> Khr.SwapchainKHR -> Vk.Queue - -> Vk.CommandBuffer + -> V.Vector Vk.CommandBuffer -> Vk.RenderPass - -> Vk.Framebuffer + -> V.Vector Vk.Framebuffer -> V2 CInt - -> Vk.Pipeline + -> V.Vector Vk.Pipeline -> Vk.Fence -> Vk.Semaphore -> Vk.Semaphore @@ -34,16 +35,22 @@ drawFrame logicalDevice swapchain graphicsQueue - commandBuffer + commandBuffers renderPass - framebuffer + framebuffers dimensions - pipeline + pipelines inFlightFence imageAvailableSemaphore renderFinishedSemaphore = do + unless (all (V.length commandBuffers ==) + [V.length commandBuffers, V.length framebuffers, V.length pipelines]) $ + error ("Numbers of elements mismatch: command buffers " <> show (V.length commandBuffers) <> + ", frame buffers " <> show (V.length framebuffers) <> + ", pipelines " <> show (V.length pipelines)) + let fences = V.singleton inFlightFence void $ Vk.waitForFences logicalDevice fences True maxBound @@ -55,25 +62,34 @@ drawFrame unless (imageResult == Vk.SUCCESS) $ error "drawFrame: Failed acquiring next image from swapchain" - Vk.resetCommandBuffer commandBuffer (Vk.CommandBufferResetFlagBits 0) + liftIO $ putStrLn "resetting command buffer" + Vk.resetCommandBuffer (commandBuffers V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0) - recordCommandBuffer commandBuffer renderPass framebuffer dimensions pipeline + liftIO $ putStrLn "recording command buffer" + recordCommandBuffer + (commandBuffers V.! fromIntegral index) + renderPass + (framebuffers V.! fromIntegral index) + dimensions + (pipelines V.! fromIntegral index) let submitInfo = Vk.zero { Vk.waitSemaphores = V.singleton imageAvailableSemaphore , Vk.waitDstStageMask = V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT - , Vk.commandBuffers = V.singleton (Vk.commandBufferHandle commandBuffer) + , Vk.commandBuffers = V.singleton (Vk.commandBufferHandle $ commandBuffers V.! fromIntegral index) , Vk.signalSemaphores = V.singleton renderFinishedSemaphore } + liftIO $ putStrLn "submitting to queue" Vk.queueSubmit graphicsQueue (V.singleton (Vk.SomeStruct submitInfo)) inFlightFence let presentInfo = Vk.zero { Khr.waitSemaphores = V.singleton renderFinishedSemaphore , Khr.swapchains = V.singleton swapchain - , Khr.imageIndices = V.singleton 0 + , Khr.imageIndices = V.singleton index } + liftIO $ putStrLn "presenting queue" presentResult <- Khr.queuePresentKHR graphicsQueue presentInfo unless (presentResult == Vk.SUCCESS) $ diff --git a/src/Framebuffers.hs b/src/Framebuffers.hs index 5dae560..c3721e7 100644 --- a/src/Framebuffers.hs +++ b/src/Framebuffers.hs @@ -17,21 +17,27 @@ createFramebuffer -> Vk.RenderPass -> V.Vector Vk.ImageView -> V2 CInt - -> m Vk.Framebuffer + -> m (V.Vector Vk.Framebuffer) createFramebuffer logicalDevice renderPass swapchainImageViews (V2 swapchainWidth swapcheinHeight) = do let framebufferCreateInfo = Vk.zero { Vk.renderPass = renderPass - , Vk.attachments = swapchainImageViews , Vk.width = fromIntegral swapchainWidth , Vk.height = fromIntegral swapcheinHeight , Vk.layers = 1 } - snd <$> allocate - (Vk.createFramebuffer logicalDevice framebufferCreateInfo Nothing) - (\framebuffer -> do - putStrLn "destroying framebuffer" - Vk.destroyFramebuffer logicalDevice framebuffer Nothing + V.mapM + (\imageView -> do + let createInfo = framebufferCreateInfo + { Vk.attachments = V.singleton imageView + } :: Vk.FramebufferCreateInfo '[] + snd <$> allocate + (Vk.createFramebuffer logicalDevice createInfo Nothing) + (\framebuffer -> do + putStrLn "destroying framebuffer" + Vk.destroyFramebuffer logicalDevice framebuffer Nothing + ) ) + swapchainImageViews diff --git a/src/GraphicsPipeline.hs b/src/GraphicsPipeline.hs index 57c9639..9b9870e 100644 --- a/src/GraphicsPipeline.hs +++ b/src/GraphicsPipeline.hs @@ -57,6 +57,7 @@ createGraphicsPipelines -> BS.ByteString -> V2 CInt -> Vk.Format + -> Int -> m (V.Vector Vk.Pipeline, Vk.RenderPass) createGraphicsPipelines logicalDevice @@ -65,6 +66,7 @@ createGraphicsPipelines stageName (V2 width height) swapchainImageFormat + number = do let vertexShaderStageCreateInfo = Vk.zero @@ -185,7 +187,7 @@ createGraphicsPipelines Vk.ACCESS_COLOR_ATTACHMENT_READ_BIT .|. Vk.ACCESS_COLOR_ATTACHMENT_WRITE_BIT } renderPassCreateInfo = Vk.zero - { Vk.attachments = V.replicate 4 colorAttachmentDescription + { Vk.attachments = V.singleton colorAttachmentDescription , Vk.subpasses = V.singleton subpassDescriptor , Vk.dependencies = V.singleton subpassDependency } :: Vk.RenderPassCreateInfo '[] @@ -219,7 +221,7 @@ createGraphicsPipelines (result, pipelines) <- Vk.createGraphicsPipelines logicalDevice Vk.NULL_HANDLE - (V.singleton (Vk.SomeStruct pipelineCreateInfo)) + (V.replicate number (Vk.SomeStruct pipelineCreateInfo)) Nothing unless (result == Vk.SUCCESS) $ error "createGraphicsPiepelines: Failed creating pipelines" @@ -233,5 +235,4 @@ createGraphicsPipelines ) pipelines ) - return (pipelines, pipelineRenderPass) diff --git a/src/Init.hs b/src/Init.hs index 34949c9..4fcf639 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -33,7 +33,7 @@ initEngine , Khr.SwapchainKHR , Vk.Queue , V.Vector Vk.CommandBuffer - , Vk.Framebuffer + , V.Vector Vk.Framebuffer , V.Vector Vk.Pipeline , Vk.RenderPass , Vk.Fence @@ -79,7 +79,7 @@ initVulkan , Khr.SwapchainKHR , Vk.Queue , V.Vector Vk.CommandBuffer - , Vk.Framebuffer + , V.Vector Vk.Framebuffer , V.Vector Vk.Pipeline , Vk.RenderPass , Vk.Fence @@ -116,11 +116,12 @@ initVulkan window = do "main" dimensions (Khr.format surfaceFormat) + (length imageViews) - frameBuffer <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions + frameBuffers <- createFramebuffer vulkanLogicalDevice renderPass imageViews dimensions (commandPool, graphicsQueue) <- createCommandPool vulkanPhysicalDevice vulkanLogicalDevice - commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool + commandBuffer <- createCommandBuffer vulkanLogicalDevice commandPool (length frameBuffers) (imageAvailableSemaphore, renderFinishedSemaphore, inFlightFence) <- createSyncObjects vulkanLogicalDevice @@ -132,7 +133,7 @@ initVulkan window = do , swapchain , graphicsQueue , commandBuffer - , frameBuffer + , frameBuffers , pipelines , renderPass , inFlightFence diff --git a/src/Main.hs b/src/Main.hs index bc0af95..69465c5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,7 +22,7 @@ import Draw (drawFrame) main :: IO () main = runResourceT $ do - (window, dimensions, logicalDevice, swapchain, graphicsQueue, commandBuffer, framebuffer, pipelines, renderPass, inFlightFence, imageAvailableSemaphore, renderFinishedSemaphore) <- initEngine + (window, dimensions, logicalDevice, swapchain, graphicsQueue, commandBuffers, framebuffers, pipelines, renderPass, inFlightFence, imageAvailableSemaphore, renderFinishedSemaphore) <- initEngine SDL.showWindow window @@ -39,11 +39,11 @@ main = runResourceT $ do logicalDevice swapchain graphicsQueue - (V.head commandBuffer) + commandBuffers renderPass - framebuffer + framebuffers dimensions - (V.head pipelines) + pipelines inFlightFence imageAvailableSemaphore renderFinishedSemaphore