{-# 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"