fix multiple frames

This commit is contained in:
nek0 2022-07-16 16:36:51 +02:00
parent 886498e4c4
commit 317d5916b0
7 changed files with 60 additions and 31 deletions

View file

@ -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)

View file

@ -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

View file

@ -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) $

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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