{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} module Draw where import qualified Control.Concurrent.STM as STM import Control.Monad 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 import Control.Monad.IO.Class (MonadIO(liftIO)) drawFrame :: (MonadResource m) => EngineData -> STM.TMVar Pipelines -> m () drawFrame engineData switch = do unless (all (V.length (engineCommandBuffers engineData) ==) [ V.length (engineCommandBuffers engineData) , V.length (engineFramebuffers engineData) ]) $ error ("Numbers of elements mismatch: command buffers " <> show (V.length $ engineCommandBuffers engineData) <> ", frame buffers " <> show (V.length $ engineFramebuffers 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) switchState <- liftIO $ STM.atomically $ STM.readTMVar switch -- liftIO $ putStrLn "recording command buffer" recordCommandBuffer (engineCommandBuffers engineData V.! fromIntegral index) (engineRenderPass engineData) (engineFramebuffers engineData V.! fromIntegral index) (engineWindowDimensions engineData) (case switchState of Rainbow -> redEnginePipelines engineData V.! fromIntegral index Red -> rainbowEnginePipelines engineData V.! fromIntegral index Green -> meshPipeline 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"