{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} module Sync where import Control.Monad.Trans.Resource import Data.Bits (bit) import qualified Data.Vector as V import Data.Word import qualified Vulkan as Vk import qualified Vulkan.Zero as Vk -- internal imports import Control.Monad.Reader import Types import Util initSyncStructures :: (MonadResource m) => Vk.Device -> Word32 -> m UploadContext initSyncStructures logicalDevice queueFamilyIndex = do let fenceCreateInfo = Vk.zero syncFence <- snd <$> Vk.withFence logicalDevice fenceCreateInfo Nothing allocate let uploadCommandPoolCreateInfo = Vk.zero { Vk.queueFamilyIndex = queueFamilyIndex } :: Vk.CommandPoolCreateInfo syncCommandPool <- snd <$> Vk.withCommandPool logicalDevice uploadCommandPoolCreateInfo Nothing allocate let cmdBufAllocInfo = Vk.zero { Vk.commandPool = syncCommandPool , Vk.commandBufferCount = 1 } syncCommandBuffer <- V.head . snd <$> Vk.withCommandBuffers logicalDevice cmdBufAllocInfo allocate return $ UploadContext { uploadFence = syncFence , uploadCommandBuffer = syncCommandBuffer , uploadCommandPool = syncCommandPool } immediateSubmit :: (MonadIO m) => UploadContext -> Vk.Queue -> Vk.Device -> (Vk.CommandBuffer -> m ()) -> m () immediateSubmit uploadContext queue device func = do let cmdBegin = beginCommandBuffer Vk.COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT Vk.useCommandBuffer (uploadCommandBuffer uploadContext) cmdBegin (func (uploadCommandBuffer uploadContext)) let submitInfo = createSubmitInfo (uploadCommandBuffer uploadContext) Vk.queueSubmit queue submitInfo (uploadFence uploadContext) void $ Vk.waitForFences device (V.singleton $ uploadFence uploadContext) True maxBound Vk.resetFences device (V.singleton $ uploadFence uploadContext) Vk.resetCommandPool device (uploadCommandPool uploadContext) (bit 0)