From bfb3b1a8145795890fc62850a138207ba94fbae4 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 14 Jul 2022 02:23:29 +0200 Subject: [PATCH] prepare synchronisation objects for drawing --- src/CommandBuffer.hs | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/src/CommandBuffer.hs b/src/CommandBuffer.hs index 0f81af8..993975e 100644 --- a/src/CommandBuffer.hs +++ b/src/CommandBuffer.hs @@ -4,23 +4,16 @@ module CommandBuffer where import Control.Monad -import Control.Monad.Loops -import Control.Monad.IO.Class import Control.Monad.Trans.Resource -import Data.Bits import qualified Data.Vector as V -import Data.Word import Foreign.C.Types (CInt) import Linear -import qualified SDL hiding (V2) -import qualified Control.Concurrent.STM as STM import qualified Vulkan as Vk import qualified Vulkan.Zero as Vk -- internal imports import Devices -import qualified Vulkan.Dynamic as Vk createCommandPool :: (MonadResource m) @@ -120,3 +113,25 @@ recordCommandBuffer commandBuffer renderPass frameBuffer (V2 width height) graph Vk.cmdDraw commandBuffer 3 1 0 0 Vk.cmdEndRenderPass commandBuffer + + +createSyncObjects + :: (MonadResource m, MonadFail m) + => Vk.Device + -> m (Vk.Semaphore, Vk.Semaphore, Vk.Fence) +createSyncObjects logicalDevice = do + + let semaphoreCreateInfo = Vk.zero + fenceCreateInfo = Vk.zero + + [imageAvailableSemaphore, renderFinishedSemaphore] <- replicateM 2 + (snd <$> allocate + (Vk.createSemaphore logicalDevice semaphoreCreateInfo Nothing) + (\semaphore -> do + putStrLn "destroying semaphore" + Vk.destroySemaphore logicalDevice semaphore Nothing + ) + ) + inFlightFence <- Vk.createFence logicalDevice fenceCreateInfo Nothing + + return (imageAvailableSemaphore, renderFinishedSemaphore,inFlightFence)