vulkan-tutorial/src/Framebuffers.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module Framebuffers where

import Linear
import Control.Monad.Trans.Resource
import qualified Data.Vector as V
import Foreign.C.Types (CInt)
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk


createFramebuffer
  :: (MonadResource m)
  => Vk.Device
  -> Vk.RenderPass
  -> V.Vector Vk.ImageView
  -> V2 CInt
  -> m (V.Vector Vk.Framebuffer)
createFramebuffer logicalDevice renderPass swapchainImageViews (V2 swapchainWidth swapcheinHeight)
  = do

    let framebufferCreateInfo = Vk.zero
          { Vk.renderPass = renderPass
          , Vk.width = fromIntegral swapchainWidth
          , Vk.height = fromIntegral swapcheinHeight
          , Vk.layers = 1
          }

    V.mapM
      (\imageView -> do
        let createInfo = framebufferCreateInfo
              {  Vk.attachments = V.singleton imageView
              } :: Vk.FramebufferCreateInfo '[]
        snd <$> allocate
          (Vk.createFramebuffer logicalDevice createInfo Nothing)
          (\framebuffer -> do
            putStrLn "destroying framebuffer"
            Vk.destroyFramebuffer logicalDevice framebuffer Nothing
            )
        )
      swapchainImageViews