vulkan-tutorial/src/Draw.hs

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