vulkan-tutorial/src/Draw.hs
2023-04-29 18:52:49 +02:00

117 lines
3.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
module Draw where
import qualified Control.Concurrent.STM as STM
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import qualified Data.Map.Strict as M
import qualified Data.Vector as V
import Linear
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
import Util (getFrame)
drawFrame
:: (MonadResource m, MonadFail m, MonadReader ReadState m)
=> EngineData
-> Int
-> m ()
drawFrame engineData frameNumber = do
let frame = getFrame engineData frameNumber
void $ Vk.waitForFences
(engineLogicalDevice engineData)
(V.singleton $ frameRenderFence frame)
True
maxBound
Vk.resetFences (engineLogicalDevice engineData) (V.singleton $ frameRenderFence frame)
(imageResult, index) <-
Khr.acquireNextImageKHR
(engineLogicalDevice engineData)
(engineSwapchain engineData)
maxBound
(frameRenderSemaphore frame)
Vk.NULL_HANDLE
unless (imageResult == Vk.SUCCESS) $
error "drawFrame: Failed acquiring next image from swapchain"
Vk.resetCommandBuffer
(frameMainCommandBuffer frame) (Vk.CommandBufferResetFlagBits 0)
matLibrary <- (liftIO . STM.atomically. STM.readTMVar) =<< asks materialLibrary
let (V2 width height) = engineWindowDimensions engineData
camPosition = V3
(-10 * sin (fromIntegral frameNumber / 90))
(-2)
(-10 * cos (fromIntegral frameNumber / 90))
camCenter = V3 0 0 0
camUp = V3 0 1 0
camView = lookAt camPosition camCenter camUp
camProjection = perspective
(pi/4)
(fromIntegral width / fromIntegral height)
0.1
200
cameraData = GPUCameraData
{ view = transpose camView
, projection = transpose camProjection
, viewProjection = transpose $ camProjection !*! camView
}
liftIO $
pokeData
frame
frameNumber
(engineSceneParameters engineData)
cameraData
recordCommandBuffer
(frameMainCommandBuffer frame)
(engineRenderPass engineData)
(engineFramebuffers engineData V.! fromIntegral index)
(engineWindowDimensions engineData)
(materialPipeline $ matLibrary M.! "defaultMesh")
frame
let submitInfo = Vk.zero
{ Vk.waitSemaphores =
V.singleton $ frameRenderSemaphore frame
, Vk.waitDstStageMask =
V.singleton Vk.PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT
, Vk.commandBuffers =
V.singleton (Vk.commandBufferHandle $ frameMainCommandBuffer frame)
, Vk.signalSemaphores =
V.singleton $ framePresentSemaphore frame
}
Vk.queueSubmit
(engineQueue engineData)
(V.singleton (Vk.SomeStruct submitInfo))
(frameRenderFence frame)
let presentInfo = Vk.zero
{ Khr.waitSemaphores = V.singleton $ framePresentSemaphore frame
, Khr.swapchains = V.singleton $ engineSwapchain engineData
, Khr.imageIndices = V.singleton index
}
presentResult <- Khr.queuePresentKHR (engineQueue engineData) presentInfo
unless (presentResult == Vk.SUCCESS) $
error "drawFrame: presentation failed"