vulkan-tutorial/src/Draw.hs

94 lines
2.8 KiB
Haskell
Raw Normal View History

2022-07-14 05:02:10 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
2023-01-05 22:07:21 +00:00
{-# LANGUAGE FlexibleContexts #-}
2022-07-14 05:02:10 +00:00
module Draw where
2023-01-05 22:07:21 +00:00
import qualified Control.Concurrent.STM as STM
2022-07-14 05:02:10 +00:00
import Control.Monad
2023-01-05 22:07:21 +00:00
import Control.Monad.IO.Class
import Control.Monad.Reader
2022-07-14 05:02:10 +00:00
import Control.Monad.Trans.Resource
2023-01-05 22:07:21 +00:00
import qualified Data.Map.Strict as M
2022-07-14 05:02:10 +00:00
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
2022-07-14 09:02:12 +00:00
-- internal imports
import CommandBuffer
2022-07-16 19:50:22 +00:00
import Types
2023-01-06 15:54:30 +00:00
import Util (getFrame)
2022-07-14 05:02:10 +00:00
drawFrame
2023-01-05 22:07:21 +00:00
:: (MonadResource m, MonadFail m, MonadReader ReadState m)
2022-07-16 19:50:22 +00:00
=> EngineData
2023-01-06 15:54:30 +00:00
-> Int
2022-07-14 05:02:10 +00:00
-> m ()
2023-01-06 15:54:30 +00:00
drawFrame engineData frameNumber = do
2022-07-16 19:50:22 +00:00
2023-01-06 15:54:30 +00:00
let frame = getFrame engineData frameNumber
2022-07-16 19:50:22 +00:00
2023-01-06 15:54:30 +00:00
void $ Vk.waitForFences
(engineLogicalDevice engineData)
(V.singleton $ frameRenderFence frame)
True
maxBound
Vk.resetFences (engineLogicalDevice engineData) (V.singleton $ frameRenderFence frame)
2022-07-16 19:50:22 +00:00
(imageResult, index) <-
Khr.acquireNextImageKHR
(engineLogicalDevice engineData)
(engineSwapchain engineData)
maxBound
2023-01-06 15:54:30 +00:00
(frameRenderSemaphore frame)
2022-07-16 19:50:22 +00:00
Vk.NULL_HANDLE
unless (imageResult == Vk.SUCCESS) $
error "drawFrame: Failed acquiring next image from swapchain"
-- liftIO $ putStrLn "resetting command buffer"
Vk.resetCommandBuffer
2023-01-06 15:54:30 +00:00
(frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0)
2022-07-16 19:50:22 +00:00
2023-01-05 22:07:21 +00:00
matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary
2022-07-16 19:50:22 +00:00
-- liftIO $ putStrLn "recording command buffer"
recordCommandBuffer
2023-01-06 15:54:30 +00:00
(frameMainCommandBuffer frame)
2022-07-16 19:50:22 +00:00
(engineRenderPass engineData)
(engineFramebuffers engineData V.! fromIntegral index)
(engineWindowDimensions engineData)
2023-01-05 22:07:21 +00:00
(materialPipeline $ matLibrary M.! "defaultMesh")
2022-12-11 08:02:17 +00:00
(meshPipelineLayout engineData)
2022-07-16 19:50:22 +00:00
let submitInfo = Vk.zero
{ Vk.waitSemaphores =
2023-01-06 15:54:30 +00:00
V.singleton $ frameRenderSemaphore frame
2022-07-16 19:50:22 +00:00
, Vk.waitDstStageMask =
V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
, Vk.commandBuffers =
2023-01-06 15:54:30 +00:00
V.singleton (Vk.commandBufferHandle $ frameMainCommandBuffer frame)
2022-07-16 19:50:22 +00:00
, Vk.signalSemaphores =
2023-01-06 15:54:30 +00:00
V.singleton $ framePresentSemaphore frame
2022-07-16 19:50:22 +00:00
}
-- liftIO $ putStrLn "submitting to queue"
Vk.queueSubmit
(engineQueue engineData)
(V.singleton (Vk.SomeStruct submitInfo))
2023-01-06 15:54:30 +00:00
(frameRenderFence frame)
2022-07-16 19:50:22 +00:00
let presentInfo = Vk.zero
2023-01-06 15:54:30 +00:00
{ Khr.waitSemaphores = V.singleton $ framePresentSemaphore frame
2022-07-16 19:50:22 +00:00
, 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"