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 }