{-# 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"