116 lines
3.4 KiB
Haskell
116 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"
|