DescriptorLayout.hs

module Resource.Vulkan.DescriptorLayout where

import RIO

import Data.Vector qualified as Vector
import Engine.Vulkan.Types (getDevice, MonadVulkan)
import RIO.List qualified as List
import Vulkan.Core10 qualified as Vk
import Vulkan.Core12 qualified as Vk12
import Vulkan.CStruct.Extends (pattern (:&), pattern (::&))
import Vulkan.Zero (zero)

create
  :: MonadVulkan env m
  => Vector [(Vk.DescriptorSetLayoutBinding, Vk12.DescriptorBindingFlags)]
  -> m (Vector Vk.DescriptorSetLayout)
create dsBindings = do
  device <- asks getDevice
  Vector.forM dsBindings \bindsFlags -> do
    let
      (binds, flags) = List.unzip bindsFlags

      setCI =
        zero
          { Vk.bindings = Vector.fromList binds
          }
        ::& zero
          { Vk12.bindingFlags = Vector.fromList flags
          }
        :& ()

    Vk.createDescriptorSetLayout device setCI Nothing

forPipeline
  :: MonadVulkan env m
  => Vector Vk.DescriptorSetLayout
  -> Vector Vk.PushConstantRange
  -> m Vk.PipelineLayout
forPipeline dsLayouts pushConstantRanges = do
  device <- asks getDevice
  Vk.createPipelineLayout device layoutCI Nothing
  where
    layoutCI = Vk.PipelineLayoutCreateInfo
      { flags              = zero
      , setLayouts         = dsLayouts
      , pushConstantRanges = pushConstantRanges
      }