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 :: forall env (m :: * -> *).
MonadVulkan env m =>
Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
-> m (Vector DescriptorSetLayout)
create Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
dsBindings = do
  Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
  Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
-> ([(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
    -> m DescriptorSetLayout)
-> m (Vector DescriptorSetLayout)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
Vector.forM Vector [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
dsBindings \[(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
bindsFlags -> do
    let
      ([DescriptorSetLayoutBinding]
binds, [DescriptorBindingFlags]
flags) = [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
-> ([DescriptorSetLayoutBinding], [DescriptorBindingFlags])
forall a b. [(a, b)] -> ([a], [b])
List.unzip [(DescriptorSetLayoutBinding, DescriptorBindingFlags)]
bindsFlags

      setCI :: DescriptorSetLayoutCreateInfo
  '[DescriptorSetLayoutBindingFlagsCreateInfo]
setCI =
        DescriptorSetLayoutCreateInfo '[]
forall a. Zero a => a
zero
          { $sel:bindings:DescriptorSetLayoutCreateInfo :: Vector DescriptorSetLayoutBinding
Vk.bindings = [DescriptorSetLayoutBinding] -> Vector DescriptorSetLayoutBinding
forall a. [a] -> Vector a
Vector.fromList [DescriptorSetLayoutBinding]
binds
          }
        DescriptorSetLayoutCreateInfo '[]
-> Chain '[DescriptorSetLayoutBindingFlagsCreateInfo]
-> DescriptorSetLayoutCreateInfo
     '[DescriptorSetLayoutBindingFlagsCreateInfo]
forall (a :: [*] -> *) (es :: [*]) (es' :: [*]).
Extensible a =>
a es' -> Chain es -> a es
::& DescriptorSetLayoutBindingFlagsCreateInfo
forall a. Zero a => a
zero
          { $sel:bindingFlags:DescriptorSetLayoutBindingFlagsCreateInfo :: Vector DescriptorBindingFlags
Vk12.bindingFlags = [DescriptorBindingFlags] -> Vector DescriptorBindingFlags
forall a. [a] -> Vector a
Vector.fromList [DescriptorBindingFlags]
flags
          }
        DescriptorSetLayoutBindingFlagsCreateInfo
-> Chain '[] -> Chain '[DescriptorSetLayoutBindingFlagsCreateInfo]
forall e (es :: [*]). e -> Chain es -> Chain (e : es)
:& ()

    Device
-> DescriptorSetLayoutCreateInfo
     '[DescriptorSetLayoutBindingFlagsCreateInfo]
-> ("allocator" ::: Maybe AllocationCallbacks)
-> m DescriptorSetLayout
forall (a :: [*]) (io :: * -> *).
(Extendss DescriptorSetLayoutCreateInfo a, PokeChain a,
 MonadIO io) =>
Device
-> DescriptorSetLayoutCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io DescriptorSetLayout
Vk.createDescriptorSetLayout Device
device DescriptorSetLayoutCreateInfo
  '[DescriptorSetLayoutBindingFlagsCreateInfo]
setCI "allocator" ::: Maybe AllocationCallbacks
forall a. Maybe a
Nothing

forPipeline
  :: MonadVulkan env m
  => Vector Vk.DescriptorSetLayout
  -> Vector Vk.PushConstantRange
  -> m Vk.PipelineLayout
forPipeline :: forall env (m :: * -> *).
MonadVulkan env m =>
Vector DescriptorSetLayout
-> Vector PushConstantRange -> m PipelineLayout
forPipeline Vector DescriptorSetLayout
dsLayouts Vector PushConstantRange
pushConstantRanges = do
  Device
device <- (env -> Device) -> m Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> Device
forall a. HasVulkan a => a -> Device
getDevice
  Device
-> PipelineLayoutCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> m PipelineLayout
forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineLayoutCreateInfo
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io PipelineLayout
Vk.createPipelineLayout Device
device PipelineLayoutCreateInfo
layoutCI "allocator" ::: Maybe AllocationCallbacks
forall a. Maybe a
Nothing
  where
    layoutCI :: PipelineLayoutCreateInfo
layoutCI = Vk.PipelineLayoutCreateInfo
      { $sel:flags:PipelineLayoutCreateInfo :: PipelineLayoutCreateFlags
flags              = PipelineLayoutCreateFlags
forall a. Zero a => a
zero
      , $sel:setLayouts:PipelineLayoutCreateInfo :: Vector DescriptorSetLayout
setLayouts         = Vector DescriptorSetLayout
dsLayouts
      , $sel:pushConstantRanges:PipelineLayoutCreateInfo :: Vector PushConstantRange
pushConstantRanges = Vector PushConstantRange
pushConstantRanges
      }