vulkan-tutorial/src/Draw.hs

81 lines
2.2 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Draw where
import Control.Monad
import Control.Monad.Trans.Resource
import qualified Data.Vector as V
import Foreign.C.Types (CInt)
import Linear (V2(..))
import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Extensions.VK_KHR_swapchain as Khr
import qualified Vulkan.CStruct.Extends as Vk
import qualified Vulkan.Zero as Vk
-- internal imports
import CommandBuffer
drawFrame
:: (MonadResource m)
=> Vk.Device
-> Khr.SwapchainKHR
-> Vk.Queue
-> Vk.CommandBuffer
-> Vk.RenderPass
-> Vk.Framebuffer
-> V2 CInt
-> Vk.Pipeline
-> Vk.Fence
-> Vk.Semaphore
-> Vk.Semaphore
-> m ()
drawFrame
logicalDevice
swapchain
graphicsQueue
commandBuffer
renderPass
framebuffer
dimensions
pipeline
inFlightFence
imageAvailableSemaphore
renderFinishedSemaphore
= do
let fences = V.singleton inFlightFence
void $ Vk.waitForFences logicalDevice fences True maxBound
Vk.resetFences logicalDevice fences
(imageResult, index) <-
Khr.acquireNextImageKHR logicalDevice swapchain maxBound imageAvailableSemaphore Vk.NULL_HANDLE
unless (imageResult == Vk.SUCCESS) $
error "drawFrame: Failed acquiring next image from swapchain"
Vk.resetCommandBuffer commandBuffer (Vk.CommandBufferResetFlagBits 0)
recordCommandBuffer commandBuffer renderPass framebuffer dimensions pipeline
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.signalSemaphores = V.singleton renderFinishedSemaphore
}
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 index
}
presentResult <- Khr.queuePresentKHR graphicsQueue presentInfo
unless (presentResult == Vk.SUCCESS) $
error "drawFrame: presentation failed"