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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall a. HasVulkan a => a -> Device getDevice 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) = forall a b. [(a, b)] -> ([a], [b]) List.unzip [(DescriptorSetLayoutBinding, DescriptorBindingFlags)] bindsFlags setCI :: DescriptorSetLayoutCreateInfo '[DescriptorSetLayoutBindingFlagsCreateInfo] setCI = forall a. Zero a => a zero { $sel:bindings:DescriptorSetLayoutCreateInfo :: Vector DescriptorSetLayoutBinding Vk.bindings = forall a. [a] -> Vector a Vector.fromList [DescriptorSetLayoutBinding] binds } forall (a :: [*] -> *) (es :: [*]) (es' :: [*]). Extensible a => a es' -> Chain es -> a es ::& forall a. Zero a => a zero { $sel:bindingFlags:DescriptorSetLayoutBindingFlagsCreateInfo :: Vector DescriptorBindingFlags Vk12.bindingFlags = forall a. [a] -> Vector a Vector.fromList [DescriptorBindingFlags] flags } forall e (es :: [*]). e -> Chain es -> Chain (e : es) :& () 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 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall a. HasVulkan a => a -> Device getDevice forall (io :: * -> *). MonadIO io => Device -> PipelineLayoutCreateInfo -> ("allocator" ::: Maybe AllocationCallbacks) -> io PipelineLayout Vk.createPipelineLayout Device device PipelineLayoutCreateInfo layoutCI forall a. Maybe a Nothing where layoutCI :: PipelineLayoutCreateInfo layoutCI = Vk.PipelineLayoutCreateInfo { $sel:flags:PipelineLayoutCreateInfo :: PipelineLayoutCreateFlags flags = forall a. Zero a => a zero , $sel:setLayouts:PipelineLayoutCreateInfo :: Vector DescriptorSetLayout setLayouts = Vector DescriptorSetLayout dsLayouts , $sel:pushConstantRanges:PipelineLayoutCreateInfo :: Vector PushConstantRange pushConstantRanges = Vector PushConstantRange pushConstantRanges }