2023-05-14 11:28:19 +00:00
|
|
|
{-# 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
|
2023-05-15 10:10:02 +00:00
|
|
|
import Data.Word
|
2023-05-14 11:28:19 +00:00
|
|
|
import qualified Vulkan as Vk
|
|
|
|
import qualified Vulkan.Zero as Vk
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Control.Monad.Reader
|
|
|
|
import Types
|
|
|
|
import Util
|
|
|
|
|
|
|
|
initSyncStructures
|
|
|
|
:: (MonadResource m)
|
2023-05-15 10:10:02 +00:00
|
|
|
=> Vk.Device
|
|
|
|
-> Word32
|
2023-05-14 11:28:19 +00:00
|
|
|
-> m UploadContext
|
2023-05-15 10:10:02 +00:00
|
|
|
initSyncStructures logicalDevice queueFamilyIndex = do
|
2023-05-14 11:28:19 +00:00
|
|
|
|
|
|
|
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)
|