vulkan-tutorial/src/Draw.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module Draw where

import Control.Monad
import Control.Monad.Trans.Resource
import qualified Data.Vector as V
import Foreign.C.Types (CInt)
import Linear (V2(..))
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

drawFrame
  :: (MonadResource m)
  => Vk.Device
  -> Khr.SwapchainKHR
  -> Vk.Queue
  -> Vk.CommandBuffer
  -> Vk.RenderPass
  -> Vk.Framebuffer
  -> V2 CInt
  -> Vk.Pipeline
  -> Vk.Fence
  -> Vk.Semaphore
  -> Vk.Semaphore
  -> m ()
drawFrame
  logicalDevice
  swapchain
  graphicsQueue
  commandBuffer
  renderPass
  framebuffer
  dimensions
  pipeline
  inFlightFence
  imageAvailableSemaphore
  renderFinishedSemaphore
  = do

    let fences = V.singleton inFlightFence

    void $ Vk.waitForFences logicalDevice fences True maxBound
    Vk.resetFences logicalDevice fences

    (imageResult, index) <-
      Khr.acquireNextImageKHR logicalDevice swapchain maxBound imageAvailableSemaphore Vk.NULL_HANDLE

    unless (imageResult == Vk.SUCCESS) $
      error "drawFrame: Failed acquiring next image from swapchain"

    Vk.resetCommandBuffer commandBuffer (Vk.CommandBufferResetFlagBits 0)

    recordCommandBuffer commandBuffer renderPass framebuffer dimensions pipeline

    let submitInfo = Vk.zero
          { Vk.waitSemaphores = V.singleton imageAvailableSemaphore
          , Vk.waitDstStageMask = V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
          , Vk.commandBuffers = V.singleton (Vk.commandBufferHandle commandBuffer)
          , Vk.signalSemaphores = V.singleton renderFinishedSemaphore
          }

    Vk.queueSubmit graphicsQueue (V.singleton (Vk.SomeStruct submitInfo)) inFlightFence

    let presentInfo = Vk.zero
          { Khr.waitSemaphores = V.singleton renderFinishedSemaphore
          , Khr.swapchains = V.singleton swapchain
          , Khr.imageIndices = V.singleton index
          }

    presentResult <- Khr.queuePresentKHR graphicsQueue presentInfo

    unless (presentResult == Vk.SUCCESS) $
      error "drawFrame: presentation failed"