{-# 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)
