92 lines
3 KiB
Haskell
92 lines
3 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
|
|
|
|
-- internal imports
|
|
|
|
import CommandBuffer
|
|
import Types
|
|
|
|
drawFrame
|
|
:: (MonadResource m, MonadFail m)
|
|
=> EngineData
|
|
-> Int
|
|
-> m ()
|
|
drawFrame engineData frameNumber = do
|
|
|
|
unless (all (V.length (engineCommandBuffers engineData) ==)
|
|
[ V.length (engineCommandBuffers engineData)
|
|
, V.length (engineFramebuffers engineData)
|
|
]) $
|
|
error ("Numbers of elements mismatch: command buffers " <>
|
|
show (V.length $ engineCommandBuffers engineData) <>
|
|
", frame buffers " <> show (V.length $ engineFramebuffers engineData)
|
|
)
|
|
|
|
let fences = V.singleton $ engineInFlightFence engineData
|
|
|
|
void $ Vk.waitForFences (engineLogicalDevice engineData) fences True maxBound
|
|
Vk.resetFences (engineLogicalDevice engineData) fences
|
|
|
|
(imageResult, index) <-
|
|
Khr.acquireNextImageKHR
|
|
(engineLogicalDevice engineData)
|
|
(engineSwapchain engineData)
|
|
maxBound
|
|
(engineImageAvailableSemaphore engineData)
|
|
Vk.NULL_HANDLE
|
|
|
|
unless (imageResult == Vk.SUCCESS) $
|
|
error "drawFrame: Failed acquiring next image from swapchain"
|
|
|
|
-- liftIO $ putStrLn "resetting command buffer"
|
|
Vk.resetCommandBuffer
|
|
(engineCommandBuffers engineData V.! fromIntegral index) (Vk.CommandBufferResetFlagBits 0)
|
|
|
|
-- liftIO $ putStrLn "recording command buffer"
|
|
recordCommandBuffer
|
|
(engineCommandBuffers engineData V.! fromIntegral index)
|
|
(engineRenderPass engineData)
|
|
(engineFramebuffers engineData V.! fromIntegral index)
|
|
(engineWindowDimensions engineData)
|
|
(meshPipeline engineData V.! fromIntegral index)
|
|
(meshPipelineLayout engineData)
|
|
(Just $ engineMesh engineData)
|
|
frameNumber
|
|
|
|
let submitInfo = Vk.zero
|
|
{ Vk.waitSemaphores =
|
|
V.singleton $ engineImageAvailableSemaphore engineData
|
|
, Vk.waitDstStageMask =
|
|
V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
|
|
, Vk.commandBuffers =
|
|
V.singleton (Vk.commandBufferHandle $ engineCommandBuffers engineData V.! fromIntegral index)
|
|
, Vk.signalSemaphores =
|
|
V.singleton $ engineRenderFinishedSemaphore engineData
|
|
}
|
|
|
|
-- liftIO $ putStrLn "submitting to queue"
|
|
Vk.queueSubmit
|
|
(engineQueue engineData)
|
|
(V.singleton (Vk.SomeStruct submitInfo))
|
|
(engineInFlightFence engineData)
|
|
|
|
let presentInfo = Vk.zero
|
|
{ Khr.waitSemaphores = V.singleton $ engineRenderFinishedSemaphore engineData
|
|
, Khr.swapchains = V.singleton $ engineSwapchain engineData
|
|
, Khr.imageIndices = V.singleton index
|
|
}
|
|
|
|
-- liftIO $ putStrLn "presenting queue"
|
|
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
|
|
|
|
unless (presentResult == Vk.SUCCESS) $
|
|
error "drawFrame: presentation failed"
|