66 lines
1.9 KiB
Haskell
66 lines
1.9 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||
|
module Draw where
|
||
|
|
||
|
import Control.Monad
|
||
|
import Control.Monad.Trans.Resource
|
||
|
import qualified Data.Vector as V
|
||
|
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
|
||
|
|
||
|
|
||
|
drawFrame
|
||
|
:: (MonadResource m)
|
||
|
=> Vk.Device
|
||
|
-> Khr.SwapchainKHR
|
||
|
-> Vk.Queue
|
||
|
-> Vk.CommandBuffer
|
||
|
-> Vk.Fence
|
||
|
-> Vk.Semaphore
|
||
|
-> Vk.Semaphore
|
||
|
-> m ()
|
||
|
drawFrame
|
||
|
logicalDevice
|
||
|
swapchain
|
||
|
graphicsQueue
|
||
|
commandBuffer
|
||
|
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 inFlightFence
|
||
|
|
||
|
unless (imageResult == Vk.SUCCESS) $
|
||
|
error "drawFrame: Failed acquiring next image from swapchain"
|
||
|
|
||
|
Vk.resetCommandBuffer commandBuffer (Vk.CommandBufferResetFlagBits 0)
|
||
|
|
||
|
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"
|