{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} module Draw where import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource import qualified Data.Vector as V 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 import Types drawFrame :: (MonadResource m) => EngineData -> m () drawFrame engineData = do unless (all (V.length (engineCommandBuffers engineData) ==) [ V.length (engineCommandBuffers engineData) , V.length (engineFramebuffers engineData) , V.length (enginePipelines engineData) ]) $ error ("Numbers of elements mismatch: command buffers " <> show (V.length $ engineCommandBuffers engineData) <> ", frame buffers " <> show (V.length $ engineFramebuffers engineData) <> ", pipelines " <> show (V.length $ enginePipelines engineData)) let fences = V.singleton $ engineInFlightFence engineData void $ Vk.waitForFences (engineLogicalDevice engineData) fences True maxBound Vk.resetFences (engineLogicalDevice engineData) fences (imageResult, index) <- Khr.acquireNextImageKHR (engineLogicalDevice engineData) (engineSwapchain engineData) maxBound (engineImageAvailableSemaphore engineData) Vk.NULL_HANDLE unless (imageResult == Vk.SUCCESS) $ error "drawFrame: Failed acquiring next image from swapchain" -- liftIO $ putStrLn "resetting command buffer" Vk.resetCommandBuffer (engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0) -- liftIO $ putStrLn "recording command buffer" recordCommandBuffer (engineCommandBuffers engineData V.! fromIntegral index) (engineRenderPass engineData) (engineFramebuffers engineData V.! fromIntegral index) (engineWindowDimensions engineData) (enginePipelines engineData V.! fromIntegral index) let submitInfo = Vk.zero { Vk.waitSemaphores = V.singleton $ engineImageAvailableSemaphore engineData , Vk.waitDstStageMask = V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT , Vk.commandBuffers = V.singleton (Vk.commandBufferHandle $ engineCommandBuffers engineData V.! fromIntegral index) , Vk.signalSemaphores = V.singleton $ engineRenderFinishedSemaphore engineData } -- liftIO $ putStrLn "submitting to queue" Vk.queueSubmit (engineQueue engineData) (V.singleton (Vk.SomeStruct submitInfo)) (engineInFlightFence engineData) let presentInfo = Vk.zero { Khr.waitSemaphores = V.singleton $ engineRenderFinishedSemaphore engineData , Khr.swapchains = V.singleton $ engineSwapchain engineData , Khr.imageIndices = V.singleton index } -- liftIO $ putStrLn "presenting queue" presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo unless (presentResult == Vk.SUCCESS) $ error "drawFrame: presentation failed"