{-# language CPP #-}
module Vulkan.Core10.Pipeline ( createGraphicsPipelines
, withGraphicsPipelines
, createComputePipelines
, withComputePipelines
, destroyPipeline
, Viewport(..)
, SpecializationMapEntry(..)
, SpecializationInfo(..)
, PipelineShaderStageCreateInfo(..)
, ComputePipelineCreateInfo(..)
, VertexInputBindingDescription(..)
, VertexInputAttributeDescription(..)
, PipelineVertexInputStateCreateInfo(..)
, PipelineInputAssemblyStateCreateInfo(..)
, PipelineTessellationStateCreateInfo(..)
, PipelineViewportStateCreateInfo(..)
, PipelineRasterizationStateCreateInfo(..)
, PipelineMultisampleStateCreateInfo(..)
, PipelineColorBlendAttachmentState(..)
, PipelineColorBlendStateCreateInfo(..)
, PipelineDynamicStateCreateInfo(..)
, StencilOpState(..)
, PipelineDepthStencilStateCreateInfo(..)
, GraphicsPipelineCreateInfo(..)
, Pipeline(..)
, PipelineLayoutCreateFlags(..)
, PipelineDepthStencilStateCreateFlags(..)
, PipelineDynamicStateCreateFlags(..)
, PipelineColorBlendStateCreateFlags(..)
, PipelineMultisampleStateCreateFlags(..)
, PipelineRasterizationStateCreateFlags(..)
, PipelineViewportStateCreateFlags(..)
, PipelineTessellationStateCreateFlags(..)
, PipelineInputAssemblyStateCreateFlags(..)
, PipelineVertexInputStateCreateFlags(..)
, PrimitiveTopology(..)
, CompareOp(..)
, PolygonMode(..)
, FrontFace(..)
, BlendFactor(..)
, BlendOp(..)
, StencilOp(..)
, LogicOp(..)
, VertexInputRate(..)
, DynamicState(..)
, CullModeFlagBits(..)
, CullModeFlags
, ShaderStageFlagBits(..)
, ShaderStageFlags
, PipelineCreateFlagBits(..)
, PipelineCreateFlags
, PipelineShaderStageCreateFlagBits(..)
, PipelineShaderStageCreateFlags
, ColorComponentFlagBits(..)
, ColorComponentFlags
, SampleMask
) where
import Vulkan.CStruct.Utils (FixedArray)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (traverse_)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import qualified Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(CFloat))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.CStruct.Extends (withSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Enums.BlendFactor (BlendFactor)
import Vulkan.Core10.Enums.BlendOp (BlendOp)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Enums.ColorComponentFlagBits (ColorComponentFlags)
import Vulkan.Core10.Enums.CompareOp (CompareOp)
import Vulkan.Core10.Enums.CullModeFlagBits (CullModeFlags)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateComputePipelines))
import Vulkan.Dynamic (DeviceCmds(pVkCreateGraphicsPipelines))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyPipeline))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.DynamicState (DynamicState)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.FrontFace (FrontFace)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_device_generated_commands (GraphicsPipelineShaderGroupsCreateInfoNV)
import Vulkan.Core10.Enums.LogicOp (LogicOp)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Handles (PipelineCache)
import Vulkan.Core10.Handles (PipelineCache(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_blend_operation_advanced (PipelineColorBlendAdvancedStateCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineColorBlendStateCreateFlags (PipelineColorBlendStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_AMD_pipeline_compiler_control (PipelineCompilerControlCreateInfoAMD)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_framebuffer_mixed_samples (PipelineCoverageModulationStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_coverage_reduction_mode (PipelineCoverageReductionStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_fragment_coverage_to_color (PipelineCoverageToColorStateCreateInfoNV)
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_pipeline_creation_feedback (PipelineCreationFeedbackCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineDepthStencilStateCreateFlags (PipelineDepthStencilStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_discard_rectangles (PipelineDiscardRectangleStateCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineDynamicStateCreateFlags (PipelineDynamicStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_fragment_shading_rate (PipelineFragmentShadingRateStateCreateInfoKHR)
import Vulkan.Core10.Enums.PipelineInputAssemblyStateCreateFlags (PipelineInputAssemblyStateCreateFlags)
import Vulkan.Core10.Handles (PipelineLayout)
import Vulkan.Core10.Enums.PipelineMultisampleStateCreateFlags (PipelineMultisampleStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_conservative_rasterization (PipelineRasterizationConservativeStateCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_depth_clip_enable (PipelineRasterizationDepthClipStateCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_line_rasterization (PipelineRasterizationLineStateCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineRasterizationStateCreateFlags (PipelineRasterizationStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_AMD_rasterization_order (PipelineRasterizationStateRasterizationOrderAMD)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_transform_feedback (PipelineRasterizationStateStreamCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_representative_fragment_test (PipelineRepresentativeFragmentTestStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_sample_locations (PipelineSampleLocationsStateCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits (PipelineShaderStageCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_subgroup_size_control (PipelineShaderStageRequiredSubgroupSizeCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_maintenance2 (PipelineTessellationDomainOriginStateCreateInfo)
import Vulkan.Core10.Enums.PipelineTessellationStateCreateFlags (PipelineTessellationStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_vertex_attribute_divisor (PipelineVertexInputDivisorStateCreateInfoEXT)
import Vulkan.Core10.Enums.PipelineVertexInputStateCreateFlags (PipelineVertexInputStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_shading_rate_image (PipelineViewportCoarseSampleOrderStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_scissor_exclusive (PipelineViewportExclusiveScissorStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_shading_rate_image (PipelineViewportShadingRateImageStateCreateInfoNV)
import Vulkan.Core10.Enums.PipelineViewportStateCreateFlags (PipelineViewportStateCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_viewport_swizzle (PipelineViewportSwizzleStateCreateInfoNV)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_clip_space_w_scaling (PipelineViewportWScalingStateCreateInfoNV)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.PolygonMode (PolygonMode)
import Vulkan.Core10.Enums.PrimitiveTopology (PrimitiveTopology)
import Vulkan.Core10.FundamentalTypes (Rect2D)
import Vulkan.Core10.Handles (RenderPass)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits(SampleCountFlagBits))
import Vulkan.Core10.FundamentalTypes (SampleMask)
import Vulkan.Core10.Handles (ShaderModule)
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlagBits)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.CStruct.Extends (SomeStruct(..))
import Vulkan.Core10.Enums.StencilOp (StencilOp)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Core10.Enums.VertexInputRate (VertexInputRate)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_GRAPHICS_PIPELINE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_DEPTH_STENCIL_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_DYNAMIC_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_INPUT_ASSEMBLY_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_MULTISAMPLE_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_TESSELLATION_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_VERTEX_INPUT_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_VIEWPORT_STATE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.BlendFactor (BlendFactor(..))
import Vulkan.Core10.Enums.BlendOp (BlendOp(..))
import Vulkan.Core10.Enums.ColorComponentFlagBits (ColorComponentFlagBits(..))
import Vulkan.Core10.Enums.ColorComponentFlagBits (ColorComponentFlags)
import Vulkan.Core10.Enums.CompareOp (CompareOp(..))
import Vulkan.Core10.Enums.CullModeFlagBits (CullModeFlagBits(..))
import Vulkan.Core10.Enums.CullModeFlagBits (CullModeFlags)
import Vulkan.Core10.Enums.DynamicState (DynamicState(..))
import Vulkan.Core10.Enums.FrontFace (FrontFace(..))
import Vulkan.Core10.Enums.LogicOp (LogicOp(..))
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Enums.PipelineColorBlendStateCreateFlags (PipelineColorBlendStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlagBits(..))
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import Vulkan.Core10.Enums.PipelineDepthStencilStateCreateFlags (PipelineDepthStencilStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineDynamicStateCreateFlags (PipelineDynamicStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineInputAssemblyStateCreateFlags (PipelineInputAssemblyStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineLayoutCreateFlags (PipelineLayoutCreateFlags(..))
import Vulkan.Core10.Enums.PipelineMultisampleStateCreateFlags (PipelineMultisampleStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineRasterizationStateCreateFlags (PipelineRasterizationStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits (PipelineShaderStageCreateFlagBits(..))
import Vulkan.Core10.Enums.PipelineShaderStageCreateFlagBits (PipelineShaderStageCreateFlags)
import Vulkan.Core10.Enums.PipelineTessellationStateCreateFlags (PipelineTessellationStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineVertexInputStateCreateFlags (PipelineVertexInputStateCreateFlags(..))
import Vulkan.Core10.Enums.PipelineViewportStateCreateFlags (PipelineViewportStateCreateFlags(..))
import Vulkan.Core10.Enums.PolygonMode (PolygonMode(..))
import Vulkan.Core10.Enums.PrimitiveTopology (PrimitiveTopology(..))
import Vulkan.Core10.FundamentalTypes (SampleMask)
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlagBits(..))
import Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Vulkan.Core10.Enums.StencilOp (StencilOp(..))
import Vulkan.Core10.Enums.VertexInputRate (VertexInputRate(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateGraphicsPipelines
:: FunPtr (Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct GraphicsPipelineCreateInfo) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result) -> Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct GraphicsPipelineCreateInfo) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result
createGraphicsPipelines :: forall io
. (MonadIO io)
=>
Device
->
PipelineCache
->
("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, ("pipelines" ::: Vector Pipeline))
createGraphicsPipelines :: Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
createGraphicsPipelines device :: Device
device pipelineCache :: PipelineCache
pipelineCache createInfos :: "createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline))
-> (ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ do
let vkCreateGraphicsPipelinesPtr :: FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateGraphicsPipelinesPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
pVkCreateGraphicsPipelines (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateGraphicsPipelinesPtr FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateGraphicsPipelines is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateGraphicsPipelines' :: Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateGraphicsPipelines' = FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
mkVkCreateGraphicsPipelines FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateGraphicsPipelinesPtr
Ptr (GraphicsPipelineCreateInfo Any)
pPCreateInfos <- ((Ptr (GraphicsPipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (GraphicsPipelineCreateInfo Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (GraphicsPipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (GraphicsPipelineCreateInfo Any)))
-> ((Ptr (GraphicsPipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (GraphicsPipelineCreateInfo Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (GraphicsPipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(GraphicsPipelineCreateInfo _) ((("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 144) 8
(Int
-> SomeStruct GraphicsPipelineCreateInfo
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct GraphicsPipelineCreateInfo
e -> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> SomeStruct GraphicsPipelineCreateInfo
-> IO (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (a :: [*] -> *) b.
(forall (es :: [*]).
(Extendss a es, PokeChain es) =>
ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (GraphicsPipelineCreateInfo Any)
-> "pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (GraphicsPipelineCreateInfo Any)
pPCreateInfos Ptr (GraphicsPipelineCreateInfo Any)
-> Int -> Ptr (GraphicsPipelineCreateInfo _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (144 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (GraphicsPipelineCreateInfo _))) (SomeStruct GraphicsPipelineCreateInfo
e) (IO (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> (() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> () -> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ ())) ("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pPipelines" ::: Ptr Pipeline
pPPipelines <- ((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline))
-> ((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline)
forall a b. (a -> b) -> a -> b
$ IO ("pPipelines" ::: Ptr Pipeline)
-> (("pPipelines" ::: Ptr Pipeline) -> IO ())
-> (("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPipelines" ::: Ptr Pipeline)
forall a. Int -> IO (Ptr a)
callocBytes @Pipeline ((("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos)) :: Word32))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("pPipelines" ::: Ptr Pipeline) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result)
-> IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateGraphicsPipelines' (Device -> Ptr Device_T
deviceHandle (Device
device)) (PipelineCache
pipelineCache) ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos)) :: Word32)) (Ptr (GraphicsPipelineCreateInfo Any)
-> "pCreateInfos" ::: Ptr (SomeStruct GraphicsPipelineCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (GraphicsPipelineCreateInfo Any)
pPCreateInfos)) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pPipelines" ::: Ptr Pipeline
pPPipelines)
IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
"pipelines" ::: Vector Pipeline
pPipelines <- IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline))
-> IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Pipeline) -> IO ("pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
createInfos)) :: Word32))) (\i :: Int
i -> ("pPipelines" ::: Ptr Pipeline) -> IO Pipeline
forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelines" ::: Ptr Pipeline
pPPipelines ("pPipelines" ::: Ptr Pipeline)
-> Int -> "pPipelines" ::: Ptr Pipeline
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Pipeline)))
(Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline))
-> (Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ (Result
r, "pipelines" ::: Vector Pipeline
pPipelines)
withGraphicsPipelines :: forall io r . MonadIO io => Device -> PipelineCache -> Vector (SomeStruct GraphicsPipelineCreateInfo) -> Maybe AllocationCallbacks -> (io (Result, Vector Pipeline) -> ((Result, Vector Pipeline) -> io ()) -> r) -> r
withGraphicsPipelines :: Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r)
-> r
withGraphicsPipelines device :: Device
device pipelineCache :: PipelineCache
pipelineCache pCreateInfos :: "createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
pCreateInfos pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r
b =
io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r
b (Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct GraphicsPipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
createGraphicsPipelines Device
device PipelineCache
pipelineCache "createInfos" ::: Vector (SomeStruct GraphicsPipelineCreateInfo)
pCreateInfos "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(_, o1 :: "pipelines" ::: Vector Pipeline
o1) -> (Pipeline -> io ()) -> ("pipelines" ::: Vector Pipeline) -> io ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\o1Elem :: Pipeline
o1Elem -> Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyPipeline Device
device Pipeline
o1Elem "allocator" ::: Maybe AllocationCallbacks
pAllocator) "pipelines" ::: Vector Pipeline
o1)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateComputePipelines
:: FunPtr (Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result) -> Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result
createComputePipelines :: forall io
. (MonadIO io)
=>
Device
->
PipelineCache
->
("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, ("pipelines" ::: Vector Pipeline))
createComputePipelines :: Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
createComputePipelines device :: Device
device pipelineCache :: PipelineCache
pipelineCache createInfos :: "createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline))
-> (ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ do
let vkCreateComputePipelinesPtr :: FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateComputePipelinesPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
pVkCreateComputePipelines (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateComputePipelinesPtr FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateComputePipelines is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkCreateComputePipelines' :: Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateComputePipelines' = FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
-> Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
mkVkCreateComputePipelines FunPtr
(Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result)
vkCreateComputePipelinesPtr
Ptr (ComputePipelineCreateInfo Any)
pPCreateInfos <- ((Ptr (ComputePipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (ComputePipelineCreateInfo Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ComputePipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (ComputePipelineCreateInfo Any)))
-> ((Ptr (ComputePipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Ptr (ComputePipelineCreateInfo Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (ComputePipelineCreateInfo Any)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(ComputePipelineCreateInfo _) ((("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 96) 8
(Int
-> SomeStruct ComputePipelineCreateInfo
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct ComputePipelineCreateInfo
e -> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> SomeStruct ComputePipelineCreateInfo
-> IO (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (a :: [*] -> *) b.
(forall (es :: [*]).
(Extendss a es, PokeChain es) =>
ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (ComputePipelineCreateInfo Any)
-> "pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (ComputePipelineCreateInfo Any)
pPCreateInfos Ptr (ComputePipelineCreateInfo Any)
-> Int -> Ptr (ComputePipelineCreateInfo _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (ComputePipelineCreateInfo _))) (SomeStruct ComputePipelineCreateInfo
e) (IO (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> (() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> () -> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ ())) ("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pPipelines" ::: Ptr Pipeline
pPPipelines <- ((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline))
-> ((("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pPipelines" ::: Ptr Pipeline)
forall a b. (a -> b) -> a -> b
$ IO ("pPipelines" ::: Ptr Pipeline)
-> (("pPipelines" ::: Ptr Pipeline) -> IO ())
-> (("pPipelines" ::: Ptr Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPipelines" ::: Ptr Pipeline)
forall a. Int -> IO (Ptr a)
callocBytes @Pipeline ((("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos)) :: Word32))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("pPipelines" ::: Ptr Pipeline) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result)
-> IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> PipelineCache
-> ("createInfoCount" ::: Word32)
-> ("pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateComputePipelines' (Device -> Ptr Device_T
deviceHandle (Device
device)) (PipelineCache
pipelineCache) ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos)) :: Word32)) (Ptr (ComputePipelineCreateInfo Any)
-> "pCreateInfos" ::: Ptr (SomeStruct ComputePipelineCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (ComputePipelineCreateInfo Any)
pPCreateInfos)) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pPipelines" ::: Ptr Pipeline
pPPipelines)
IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
"pipelines" ::: Vector Pipeline
pPipelines <- IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline))
-> IO ("pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
("pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Pipeline) -> IO ("pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int)
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
createInfos)) :: Word32))) (\i :: Int
i -> ("pPipelines" ::: Ptr Pipeline) -> IO Pipeline
forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelines" ::: Ptr Pipeline
pPPipelines ("pPipelines" ::: Ptr Pipeline)
-> Int -> "pPipelines" ::: Ptr Pipeline
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Pipeline)))
(Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline))
-> (Result, "pipelines" ::: Vector Pipeline)
-> ContT
(Result, "pipelines" ::: Vector Pipeline)
IO
(Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ (Result
r, "pipelines" ::: Vector Pipeline
pPipelines)
withComputePipelines :: forall io r . MonadIO io => Device -> PipelineCache -> Vector (SomeStruct ComputePipelineCreateInfo) -> Maybe AllocationCallbacks -> (io (Result, Vector Pipeline) -> ((Result, Vector Pipeline) -> io ()) -> r) -> r
withComputePipelines :: Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r)
-> r
withComputePipelines device :: Device
device pipelineCache :: PipelineCache
pipelineCache pCreateInfos :: "createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
pCreateInfos pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r
b =
io (Result, "pipelines" ::: Vector Pipeline)
-> ((Result, "pipelines" ::: Vector Pipeline) -> io ()) -> r
b (Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall (io :: * -> *).
MonadIO io =>
Device
-> PipelineCache
-> ("createInfos"
::: Vector (SomeStruct ComputePipelineCreateInfo))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
createComputePipelines Device
device PipelineCache
pipelineCache "createInfos" ::: Vector (SomeStruct ComputePipelineCreateInfo)
pCreateInfos "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(_, o1 :: "pipelines" ::: Vector Pipeline
o1) -> (Pipeline -> io ()) -> ("pipelines" ::: Vector Pipeline) -> io ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\o1Elem :: Pipeline
o1Elem -> Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyPipeline Device
device Pipeline
o1Elem "allocator" ::: Maybe AllocationCallbacks
pAllocator) "pipelines" ::: Vector Pipeline
o1)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyPipeline
:: FunPtr (Ptr Device_T -> Pipeline -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Pipeline -> Ptr AllocationCallbacks -> IO ()
destroyPipeline :: forall io
. (MonadIO io)
=>
Device
->
Pipeline
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyPipeline :: Device
-> Pipeline -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyPipeline device :: Device
device pipeline :: Pipeline
pipeline allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
let vkDestroyPipelinePtr :: FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyPipelinePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyPipeline (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyPipelinePtr FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroyPipeline is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkDestroyPipeline' :: Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyPipeline' = FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Pipeline
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyPipeline FunPtr
(Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyPipelinePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> Pipeline -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyPipeline' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Pipeline
pipeline) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()
data Viewport = Viewport
{
Viewport -> Float
x :: Float
,
Viewport -> Float
y :: Float
,
Viewport -> Float
width :: Float
,
Viewport -> Float
height :: Float
,
Viewport -> Float
minDepth :: Float
,
Viewport -> Float
maxDepth :: Float
}
deriving (Typeable, Viewport -> Viewport -> Bool
(Viewport -> Viewport -> Bool)
-> (Viewport -> Viewport -> Bool) -> Eq Viewport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Viewport -> Viewport -> Bool
$c/= :: Viewport -> Viewport -> Bool
== :: Viewport -> Viewport -> Bool
$c== :: Viewport -> Viewport -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Viewport)
#endif
deriving instance Show Viewport
instance ToCStruct Viewport where
withCStruct :: Viewport -> (Ptr Viewport -> IO b) -> IO b
withCStruct x :: Viewport
x f :: Ptr Viewport -> IO b
f = Int -> Int -> (Ptr Viewport -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 4 ((Ptr Viewport -> IO b) -> IO b) -> (Ptr Viewport -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Viewport
p -> Ptr Viewport -> Viewport -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Viewport
p Viewport
x (Ptr Viewport -> IO b
f Ptr Viewport
p)
pokeCStruct :: Ptr Viewport -> Viewport -> IO b -> IO b
pokeCStruct p :: Ptr Viewport
p Viewport{..} f :: IO b
f = do
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
x))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
y))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
width))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
height))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
minDepth))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxDepth))
IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: Ptr Viewport -> IO b -> IO b
pokeZeroCStruct p :: Ptr Viewport
p f :: IO b
f = do
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
IO b
f
instance FromCStruct Viewport where
peekCStruct :: Ptr Viewport -> IO Viewport
peekCStruct p :: Ptr Viewport
p = do
CFloat
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat))
CFloat
y <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
CFloat
width <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CFloat))
CFloat
height <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr CFloat))
CFloat
minDepth <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat))
CFloat
maxDepth <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Viewport
p Ptr Viewport -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr CFloat))
Viewport -> IO Viewport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Viewport -> IO Viewport) -> Viewport -> IO Viewport
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Float -> Float -> Viewport
Viewport
((\(CFloat a :: Float
a) -> Float
a) CFloat
x) ((\(CFloat a :: Float
a) -> Float
a) CFloat
y) ((\(CFloat a :: Float
a) -> Float
a) CFloat
width) ((\(CFloat a :: Float
a) -> Float
a) CFloat
height) ((\(CFloat a :: Float
a) -> Float
a) CFloat
minDepth) ((\(CFloat a :: Float
a) -> Float
a) CFloat
maxDepth)
instance Storable Viewport where
sizeOf :: Viewport -> Int
sizeOf ~Viewport
_ = 24
alignment :: Viewport -> Int
alignment ~Viewport
_ = 4
peek :: Ptr Viewport -> IO Viewport
peek = Ptr Viewport -> IO Viewport
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr Viewport -> Viewport -> IO ()
poke ptr :: Ptr Viewport
ptr poked :: Viewport
poked = Ptr Viewport -> Viewport -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Viewport
ptr Viewport
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero Viewport where
zero :: Viewport
zero = Float -> Float -> Float -> Float -> Float -> Float -> Viewport
Viewport
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
Float
forall a. Zero a => a
zero
data SpecializationMapEntry = SpecializationMapEntry
{
SpecializationMapEntry -> "createInfoCount" ::: Word32
constantID :: Word32
,
SpecializationMapEntry -> "createInfoCount" ::: Word32
offset :: Word32
,
SpecializationMapEntry -> Word64
size :: Word64
}
deriving (Typeable, SpecializationMapEntry -> SpecializationMapEntry -> Bool
(SpecializationMapEntry -> SpecializationMapEntry -> Bool)
-> (SpecializationMapEntry -> SpecializationMapEntry -> Bool)
-> Eq SpecializationMapEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecializationMapEntry -> SpecializationMapEntry -> Bool
$c/= :: SpecializationMapEntry -> SpecializationMapEntry -> Bool
== :: SpecializationMapEntry -> SpecializationMapEntry -> Bool
$c== :: SpecializationMapEntry -> SpecializationMapEntry -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SpecializationMapEntry)
#endif
deriving instance Show SpecializationMapEntry
instance ToCStruct SpecializationMapEntry where
withCStruct :: SpecializationMapEntry
-> (Ptr SpecializationMapEntry -> IO b) -> IO b
withCStruct x :: SpecializationMapEntry
x f :: Ptr SpecializationMapEntry -> IO b
f = Int -> Int -> (Ptr SpecializationMapEntry -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> (Ptr SpecializationMapEntry -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SpecializationMapEntry
p -> Ptr SpecializationMapEntry
-> SpecializationMapEntry -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SpecializationMapEntry
p SpecializationMapEntry
x (Ptr SpecializationMapEntry -> IO b
f Ptr SpecializationMapEntry
p)
pokeCStruct :: Ptr SpecializationMapEntry
-> SpecializationMapEntry -> IO b -> IO b
pokeCStruct p :: Ptr SpecializationMapEntry
p SpecializationMapEntry{..} f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
constantID)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
offset)
Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
size))
IO b
f
cStructSize :: Int
cStructSize = 16
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr SpecializationMapEntry -> IO b -> IO b
pokeZeroCStruct p :: Ptr SpecializationMapEntry
p f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
forall a. Zero a => a
zero))
IO b
f
instance FromCStruct SpecializationMapEntry where
peekCStruct :: Ptr SpecializationMapEntry -> IO SpecializationMapEntry
peekCStruct p :: Ptr SpecializationMapEntry
p = do
"createInfoCount" ::: Word32
constantID <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
"createInfoCount" ::: Word32
offset <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
CSize
size <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr SpecializationMapEntry
p Ptr SpecializationMapEntry -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr CSize))
SpecializationMapEntry -> IO SpecializationMapEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecializationMapEntry -> IO SpecializationMapEntry)
-> SpecializationMapEntry -> IO SpecializationMapEntry
forall a b. (a -> b) -> a -> b
$ ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> Word64
-> SpecializationMapEntry
SpecializationMapEntry
"createInfoCount" ::: Word32
constantID "createInfoCount" ::: Word32
offset ((\(CSize a :: Word64
a) -> Word64
a) CSize
size)
instance Storable SpecializationMapEntry where
sizeOf :: SpecializationMapEntry -> Int
sizeOf ~SpecializationMapEntry
_ = 16
alignment :: SpecializationMapEntry -> Int
alignment ~SpecializationMapEntry
_ = 8
peek :: Ptr SpecializationMapEntry -> IO SpecializationMapEntry
peek = Ptr SpecializationMapEntry -> IO SpecializationMapEntry
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr SpecializationMapEntry -> SpecializationMapEntry -> IO ()
poke ptr :: Ptr SpecializationMapEntry
ptr poked :: SpecializationMapEntry
poked = Ptr SpecializationMapEntry
-> SpecializationMapEntry -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SpecializationMapEntry
ptr SpecializationMapEntry
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero SpecializationMapEntry where
zero :: SpecializationMapEntry
zero = ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> Word64
-> SpecializationMapEntry
SpecializationMapEntry
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
Word64
forall a. Zero a => a
zero
data SpecializationInfo = SpecializationInfo
{
SpecializationInfo -> Vector SpecializationMapEntry
mapEntries :: Vector SpecializationMapEntry
,
SpecializationInfo -> Word64
dataSize :: Word64
,
SpecializationInfo -> Ptr ()
data' :: Ptr ()
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SpecializationInfo)
#endif
deriving instance Show SpecializationInfo
instance ToCStruct SpecializationInfo where
withCStruct :: SpecializationInfo -> (Ptr SpecializationInfo -> IO b) -> IO b
withCStruct x :: SpecializationInfo
x f :: Ptr SpecializationInfo -> IO b
f = Int -> Int -> (Ptr SpecializationInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SpecializationInfo -> IO b) -> IO b)
-> (Ptr SpecializationInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SpecializationInfo
p -> Ptr SpecializationInfo -> SpecializationInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SpecializationInfo
p SpecializationInfo
x (Ptr SpecializationInfo -> IO b
f Ptr SpecializationInfo
p)
pokeCStruct :: Ptr SpecializationInfo -> SpecializationInfo -> IO b -> IO b
pokeCStruct p :: Ptr SpecializationInfo
p SpecializationInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SpecializationMapEntry -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SpecializationMapEntry -> Int)
-> Vector SpecializationMapEntry -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SpecializationMapEntry
mapEntries)) :: Word32))
Ptr SpecializationMapEntry
pPMapEntries' <- ((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry))
-> ((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr SpecializationMapEntry -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SpecializationMapEntry ((Vector SpecializationMapEntry -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SpecializationMapEntry
mapEntries)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
(Int -> SpecializationMapEntry -> ContT b IO ())
-> Vector SpecializationMapEntry -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SpecializationMapEntry
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SpecializationMapEntry
-> SpecializationMapEntry -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SpecializationMapEntry
pPMapEntries' Ptr SpecializationMapEntry -> Int -> Ptr SpecializationMapEntry
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SpecializationMapEntry) (SpecializationMapEntry
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector SpecializationMapEntry
mapEntries)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr SpecializationMapEntry)
-> Ptr SpecializationMapEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr SpecializationMapEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr SpecializationMapEntry))) (Ptr SpecializationMapEntry
pPMapEntries')
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CSize)) (Word64 -> CSize
CSize (Word64
dataSize))
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ()))) (Ptr ()
data')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 32
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr SpecializationInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SpecializationInfo
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
Ptr SpecializationMapEntry
pPMapEntries' <- ((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry))
-> ((Ptr SpecializationMapEntry -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationMapEntry)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr SpecializationMapEntry -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SpecializationMapEntry ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
(Int -> SpecializationMapEntry -> ContT b IO ())
-> Vector SpecializationMapEntry -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SpecializationMapEntry
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SpecializationMapEntry
-> SpecializationMapEntry -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SpecializationMapEntry
pPMapEntries' Ptr SpecializationMapEntry -> Int -> Ptr SpecializationMapEntry
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SpecializationMapEntry) (SpecializationMapEntry
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector SpecializationMapEntry
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr SpecializationMapEntry)
-> Ptr SpecializationMapEntry -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr SpecializationMapEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr SpecializationMapEntry))) (Ptr SpecializationMapEntry
pPMapEntries')
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ()))) (Ptr ()
forall a. Zero a => a
zero)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct SpecializationInfo where
peekCStruct :: Ptr SpecializationInfo -> IO SpecializationInfo
peekCStruct p :: Ptr SpecializationInfo
p = do
"createInfoCount" ::: Word32
mapEntryCount <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
Ptr SpecializationMapEntry
pMapEntries <- Ptr (Ptr SpecializationMapEntry) -> IO (Ptr SpecializationMapEntry)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SpecializationMapEntry) ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr SpecializationMapEntry)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr SpecializationMapEntry)))
Vector SpecializationMapEntry
pMapEntries' <- Int
-> (Int -> IO SpecializationMapEntry)
-> IO (Vector SpecializationMapEntry)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "createInfoCount" ::: Word32
mapEntryCount) (\i :: Int
i -> Ptr SpecializationMapEntry -> IO SpecializationMapEntry
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SpecializationMapEntry ((Ptr SpecializationMapEntry
pMapEntries Ptr SpecializationMapEntry -> Int -> Ptr SpecializationMapEntry
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SpecializationMapEntry)))
CSize
dataSize <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CSize))
Ptr ()
pData <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr SpecializationInfo
p Ptr SpecializationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ())))
SpecializationInfo -> IO SpecializationInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecializationInfo -> IO SpecializationInfo)
-> SpecializationInfo -> IO SpecializationInfo
forall a b. (a -> b) -> a -> b
$ Vector SpecializationMapEntry
-> Word64 -> Ptr () -> SpecializationInfo
SpecializationInfo
Vector SpecializationMapEntry
pMapEntries' ((\(CSize a :: Word64
a) -> Word64
a) CSize
dataSize) Ptr ()
pData
instance Zero SpecializationInfo where
zero :: SpecializationInfo
zero = Vector SpecializationMapEntry
-> Word64 -> Ptr () -> SpecializationInfo
SpecializationInfo
Vector SpecializationMapEntry
forall a. Monoid a => a
mempty
Word64
forall a. Zero a => a
zero
Ptr ()
forall a. Zero a => a
zero
data PipelineShaderStageCreateInfo (es :: [Type]) = PipelineShaderStageCreateInfo
{
PipelineShaderStageCreateInfo es -> Chain es
next :: Chain es
,
PipelineShaderStageCreateInfo es -> PipelineShaderStageCreateFlags
flags :: PipelineShaderStageCreateFlags
,
PipelineShaderStageCreateInfo es -> ShaderStageFlagBits
stage :: ShaderStageFlagBits
,
PipelineShaderStageCreateInfo es -> ShaderModule
module' :: ShaderModule
,
PipelineShaderStageCreateInfo es -> ByteString
name :: ByteString
,
PipelineShaderStageCreateInfo es -> Maybe SpecializationInfo
specializationInfo :: Maybe SpecializationInfo
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineShaderStageCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (PipelineShaderStageCreateInfo es)
instance Extensible PipelineShaderStageCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO
setNext :: PipelineShaderStageCreateInfo ds
-> Chain es -> PipelineShaderStageCreateInfo es
setNext x :: PipelineShaderStageCreateInfo ds
x next :: Chain es
next = PipelineShaderStageCreateInfo ds
x{$sel:next:PipelineShaderStageCreateInfo :: Chain es
next = Chain es
next}
getNext :: PipelineShaderStageCreateInfo es -> Chain es
getNext PipelineShaderStageCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends PipelineShaderStageCreateInfo e => b) -> Maybe b
extends :: proxy e
-> (Extends PipelineShaderStageCreateInfo e => b) -> Maybe b
extends _ f :: Extends PipelineShaderStageCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineShaderStageRequiredSubgroupSizeCreateInfoEXT) =>
Maybe (e :~: PipelineShaderStageRequiredSubgroupSizeCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineShaderStageRequiredSubgroupSizeCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineShaderStageCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss PipelineShaderStageCreateInfo es, PokeChain es) => ToCStruct (PipelineShaderStageCreateInfo es) where
withCStruct :: PipelineShaderStageCreateInfo es
-> (Ptr (PipelineShaderStageCreateInfo es) -> IO b) -> IO b
withCStruct x :: PipelineShaderStageCreateInfo es
x f :: Ptr (PipelineShaderStageCreateInfo es) -> IO b
f = Int
-> Int -> (Ptr (PipelineShaderStageCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr (PipelineShaderStageCreateInfo es) -> IO b) -> IO b)
-> (Ptr (PipelineShaderStageCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (PipelineShaderStageCreateInfo es)
p -> Ptr (PipelineShaderStageCreateInfo es)
-> PipelineShaderStageCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (PipelineShaderStageCreateInfo es)
p PipelineShaderStageCreateInfo es
x (Ptr (PipelineShaderStageCreateInfo es) -> IO b
f Ptr (PipelineShaderStageCreateInfo es)
p)
pokeCStruct :: Ptr (PipelineShaderStageCreateInfo es)
-> PipelineShaderStageCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (PipelineShaderStageCreateInfo es)
p PipelineShaderStageCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineShaderStageCreateFlags
-> PipelineShaderStageCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr PipelineShaderStageCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineShaderStageCreateFlags)) (PipelineShaderStageCreateFlags
flags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ShaderStageFlagBits -> ShaderStageFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr ShaderStageFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ShaderStageFlagBits)) (ShaderStageFlagBits
stage)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ShaderModule -> ShaderModule -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr ShaderModule
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ShaderModule)) (ShaderModule
module')
CString
pName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
name)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar))) CString
pName''
Ptr SpecializationInfo
pSpecializationInfo'' <- case (Maybe SpecializationInfo
specializationInfo) of
Nothing -> Ptr SpecializationInfo -> ContT b IO (Ptr SpecializationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr SpecializationInfo
forall a. Ptr a
nullPtr
Just j :: SpecializationInfo
j -> ((Ptr SpecializationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SpecializationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationInfo))
-> ((Ptr SpecializationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr SpecializationInfo)
forall a b. (a -> b) -> a -> b
$ SpecializationInfo -> (Ptr SpecializationInfo -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SpecializationInfo
j)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr SpecializationInfo) -> Ptr SpecializationInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr (Ptr SpecializationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr SpecializationInfo))) Ptr SpecializationInfo
pSpecializationInfo''
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 48
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (PipelineShaderStageCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (PipelineShaderStageCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ShaderStageFlagBits -> ShaderStageFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr ShaderStageFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ShaderStageFlagBits)) (ShaderStageFlagBits
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ShaderModule -> ShaderModule -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr ShaderModule
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ShaderModule)) (ShaderModule
forall a. Zero a => a
zero)
CString
pName'' <- ((CString -> IO b) -> IO b) -> ContT b IO CString
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((CString -> IO b) -> IO b) -> ContT b IO CString)
-> ((CString -> IO b) -> IO b) -> ContT b IO CString
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO b) -> IO b
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (ByteString
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar))) CString
pName''
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss PipelineShaderStageCreateInfo es, PeekChain es) => FromCStruct (PipelineShaderStageCreateInfo es) where
peekCStruct :: Ptr (PipelineShaderStageCreateInfo es)
-> IO (PipelineShaderStageCreateInfo es)
peekCStruct p :: Ptr (PipelineShaderStageCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
PipelineShaderStageCreateFlags
flags <- Ptr PipelineShaderStageCreateFlags
-> IO PipelineShaderStageCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineShaderStageCreateFlags ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr PipelineShaderStageCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineShaderStageCreateFlags))
ShaderStageFlagBits
stage <- Ptr ShaderStageFlagBits -> IO ShaderStageFlagBits
forall a. Storable a => Ptr a -> IO a
peek @ShaderStageFlagBits ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr ShaderStageFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr ShaderStageFlagBits))
ShaderModule
module' <- Ptr ShaderModule -> IO ShaderModule
forall a. Storable a => Ptr a -> IO a
peek @ShaderModule ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr ShaderModule
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr ShaderModule))
ByteString
pName <- CString -> IO ByteString
packCString (CString -> IO ByteString) -> IO CString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar)))
Ptr SpecializationInfo
pSpecializationInfo <- Ptr (Ptr SpecializationInfo) -> IO (Ptr SpecializationInfo)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SpecializationInfo) ((Ptr (PipelineShaderStageCreateInfo es)
p Ptr (PipelineShaderStageCreateInfo es)
-> Int -> Ptr (Ptr SpecializationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr SpecializationInfo)))
Maybe SpecializationInfo
pSpecializationInfo' <- (Ptr SpecializationInfo -> IO SpecializationInfo)
-> Ptr SpecializationInfo -> IO (Maybe SpecializationInfo)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: Ptr SpecializationInfo
j -> Ptr SpecializationInfo -> IO SpecializationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SpecializationInfo (Ptr SpecializationInfo
j)) Ptr SpecializationInfo
pSpecializationInfo
PipelineShaderStageCreateInfo es
-> IO (PipelineShaderStageCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineShaderStageCreateInfo es
-> IO (PipelineShaderStageCreateInfo es))
-> PipelineShaderStageCreateInfo es
-> IO (PipelineShaderStageCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> PipelineShaderStageCreateFlags
-> ShaderStageFlagBits
-> ShaderModule
-> ByteString
-> Maybe SpecializationInfo
-> PipelineShaderStageCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineShaderStageCreateFlags
-> ShaderStageFlagBits
-> ShaderModule
-> ByteString
-> Maybe SpecializationInfo
-> PipelineShaderStageCreateInfo es
PipelineShaderStageCreateInfo
Chain es
next PipelineShaderStageCreateFlags
flags ShaderStageFlagBits
stage ShaderModule
module' ByteString
pName Maybe SpecializationInfo
pSpecializationInfo'
instance es ~ '[] => Zero (PipelineShaderStageCreateInfo es) where
zero :: PipelineShaderStageCreateInfo es
zero = Chain es
-> PipelineShaderStageCreateFlags
-> ShaderStageFlagBits
-> ShaderModule
-> ByteString
-> Maybe SpecializationInfo
-> PipelineShaderStageCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineShaderStageCreateFlags
-> ShaderStageFlagBits
-> ShaderModule
-> ByteString
-> Maybe SpecializationInfo
-> PipelineShaderStageCreateInfo es
PipelineShaderStageCreateInfo
()
PipelineShaderStageCreateFlags
forall a. Zero a => a
zero
ShaderStageFlagBits
forall a. Zero a => a
zero
ShaderModule
forall a. Zero a => a
zero
ByteString
forall a. Monoid a => a
mempty
Maybe SpecializationInfo
forall a. Maybe a
Nothing
data ComputePipelineCreateInfo (es :: [Type]) = ComputePipelineCreateInfo
{
ComputePipelineCreateInfo es -> Chain es
next :: Chain es
,
ComputePipelineCreateInfo es -> PipelineCreateFlags
flags :: PipelineCreateFlags
,
ComputePipelineCreateInfo es
-> SomeStruct PipelineShaderStageCreateInfo
stage :: SomeStruct PipelineShaderStageCreateInfo
,
ComputePipelineCreateInfo es -> PipelineLayout
layout :: PipelineLayout
,
ComputePipelineCreateInfo es -> Pipeline
basePipelineHandle :: Pipeline
,
ComputePipelineCreateInfo es -> Int32
basePipelineIndex :: Int32
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ComputePipelineCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ComputePipelineCreateInfo es)
instance Extensible ComputePipelineCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO
setNext :: ComputePipelineCreateInfo ds
-> Chain es -> ComputePipelineCreateInfo es
setNext x :: ComputePipelineCreateInfo ds
x next :: Chain es
next = ComputePipelineCreateInfo ds
x{$sel:next:ComputePipelineCreateInfo :: Chain es
next = Chain es
next}
getNext :: ComputePipelineCreateInfo es -> Chain es
getNext ComputePipelineCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends ComputePipelineCreateInfo e => b) -> Maybe b
extends :: proxy e -> (Extends ComputePipelineCreateInfo e => b) -> Maybe b
extends _ f :: Extends ComputePipelineCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable PipelineCompilerControlCreateInfoAMD) =>
Maybe (e :~: PipelineCompilerControlCreateInfoAMD)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineCompilerControlCreateInfoAMD = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ComputePipelineCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable PipelineCreationFeedbackCreateInfoEXT) =>
Maybe (e :~: PipelineCreationFeedbackCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineCreationFeedbackCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ComputePipelineCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss ComputePipelineCreateInfo es, PokeChain es) => ToCStruct (ComputePipelineCreateInfo es) where
withCStruct :: ComputePipelineCreateInfo es
-> (Ptr (ComputePipelineCreateInfo es) -> IO b) -> IO b
withCStruct x :: ComputePipelineCreateInfo es
x f :: Ptr (ComputePipelineCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (ComputePipelineCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 96 8 ((Ptr (ComputePipelineCreateInfo es) -> IO b) -> IO b)
-> (Ptr (ComputePipelineCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (ComputePipelineCreateInfo es)
p -> Ptr (ComputePipelineCreateInfo es)
-> ComputePipelineCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ComputePipelineCreateInfo es)
p ComputePipelineCreateInfo es
x (Ptr (ComputePipelineCreateInfo es) -> IO b
f Ptr (ComputePipelineCreateInfo es)
p)
pokeCStruct :: Ptr (ComputePipelineCreateInfo es)
-> ComputePipelineCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (ComputePipelineCreateInfo es)
p ComputePipelineCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineCreateFlags -> PipelineCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> Ptr PipelineCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineCreateFlags)) (PipelineCreateFlags
flags)
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct PipelineShaderStageCreateInfo)
-> SomeStruct PipelineShaderStageCreateInfo -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
(Extendss a es, PokeChain es) =>
ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (PipelineShaderStageCreateInfo Any)
-> Ptr (SomeStruct PipelineShaderStageCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> Ptr (PipelineShaderStageCreateInfo _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (PipelineShaderStageCreateInfo _)))) (SomeStruct PipelineShaderStageCreateInfo
stage) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineLayout -> PipelineLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr PipelineLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr PipelineLayout)) (PipelineLayout
layout)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPipelines" ::: Ptr Pipeline) -> Pipeline -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> "pPipelines" ::: Ptr Pipeline
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr Pipeline)) (Pipeline
basePipelineHandle)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88 :: Ptr Int32)) (Int32
basePipelineIndex)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 96
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (ComputePipelineCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (ComputePipelineCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct PipelineShaderStageCreateInfo)
-> SomeStruct PipelineShaderStageCreateInfo -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
(Extendss a es, PokeChain es) =>
ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (PipelineShaderStageCreateInfo Any)
-> Ptr (SomeStruct PipelineShaderStageCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> Ptr (PipelineShaderStageCreateInfo _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (PipelineShaderStageCreateInfo _)))) ((PipelineShaderStageCreateInfo '[]
-> SomeStruct PipelineShaderStageCreateInfo
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct PipelineShaderStageCreateInfo '[]
forall a. Zero a => a
zero)) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineLayout -> PipelineLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr PipelineLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr PipelineLayout)) (PipelineLayout
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss ComputePipelineCreateInfo es, PeekChain es) => FromCStruct (ComputePipelineCreateInfo es) where
peekCStruct :: Ptr (ComputePipelineCreateInfo es)
-> IO (ComputePipelineCreateInfo es)
peekCStruct p :: Ptr (ComputePipelineCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
PipelineCreateFlags
flags <- Ptr PipelineCreateFlags -> IO PipelineCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineCreateFlags ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> Ptr PipelineCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineCreateFlags))
SomeStruct PipelineShaderStageCreateInfo
stage <- Ptr (SomeStruct PipelineShaderStageCreateInfo)
-> IO (SomeStruct PipelineShaderStageCreateInfo)
forall (a :: [*] -> *).
(Extensible a,
forall (es :: [*]).
(Extendss a es, PeekChain es) =>
FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (PipelineShaderStageCreateInfo Any)
-> Ptr (SomeStruct PipelineShaderStageCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> Ptr (PipelineShaderStageCreateInfo a)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (PipelineShaderStageCreateInfo a))))
PipelineLayout
layout <- Ptr PipelineLayout -> IO PipelineLayout
forall a. Storable a => Ptr a -> IO a
peek @PipelineLayout ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr PipelineLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72 :: Ptr PipelineLayout))
Pipeline
basePipelineHandle <- ("pPipelines" ::: Ptr Pipeline) -> IO Pipeline
forall a. Storable a => Ptr a -> IO a
peek @Pipeline ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es)
-> Int -> "pPipelines" ::: Ptr Pipeline
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr Pipeline))
Int32
basePipelineIndex <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr (ComputePipelineCreateInfo es)
p Ptr (ComputePipelineCreateInfo es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88 :: Ptr Int32))
ComputePipelineCreateInfo es -> IO (ComputePipelineCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputePipelineCreateInfo es -> IO (ComputePipelineCreateInfo es))
-> ComputePipelineCreateInfo es
-> IO (ComputePipelineCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> PipelineCreateFlags
-> SomeStruct PipelineShaderStageCreateInfo
-> PipelineLayout
-> Pipeline
-> Int32
-> ComputePipelineCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineCreateFlags
-> SomeStruct PipelineShaderStageCreateInfo
-> PipelineLayout
-> Pipeline
-> Int32
-> ComputePipelineCreateInfo es
ComputePipelineCreateInfo
Chain es
next PipelineCreateFlags
flags SomeStruct PipelineShaderStageCreateInfo
stage PipelineLayout
layout Pipeline
basePipelineHandle Int32
basePipelineIndex
instance es ~ '[] => Zero (ComputePipelineCreateInfo es) where
zero :: ComputePipelineCreateInfo es
zero = Chain es
-> PipelineCreateFlags
-> SomeStruct PipelineShaderStageCreateInfo
-> PipelineLayout
-> Pipeline
-> Int32
-> ComputePipelineCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineCreateFlags
-> SomeStruct PipelineShaderStageCreateInfo
-> PipelineLayout
-> Pipeline
-> Int32
-> ComputePipelineCreateInfo es
ComputePipelineCreateInfo
()
PipelineCreateFlags
forall a. Zero a => a
zero
(PipelineShaderStageCreateInfo '[]
-> SomeStruct PipelineShaderStageCreateInfo
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct PipelineShaderStageCreateInfo '[]
forall a. Zero a => a
zero)
PipelineLayout
forall a. Zero a => a
zero
Pipeline
forall a. Zero a => a
zero
Int32
forall a. Zero a => a
zero
data VertexInputBindingDescription = VertexInputBindingDescription
{
VertexInputBindingDescription -> "createInfoCount" ::: Word32
binding :: Word32
,
VertexInputBindingDescription -> "createInfoCount" ::: Word32
stride :: Word32
,
VertexInputBindingDescription -> VertexInputRate
inputRate :: VertexInputRate
}
deriving (Typeable, VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool
(VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool)
-> (VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool)
-> Eq VertexInputBindingDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool
$c/= :: VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool
== :: VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool
$c== :: VertexInputBindingDescription
-> VertexInputBindingDescription -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (VertexInputBindingDescription)
#endif
deriving instance Show VertexInputBindingDescription
instance ToCStruct VertexInputBindingDescription where
withCStruct :: VertexInputBindingDescription
-> (Ptr VertexInputBindingDescription -> IO b) -> IO b
withCStruct x :: VertexInputBindingDescription
x f :: Ptr VertexInputBindingDescription -> IO b
f = Int -> Int -> (Ptr VertexInputBindingDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 12 4 ((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> (Ptr VertexInputBindingDescription -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr VertexInputBindingDescription
p -> Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr VertexInputBindingDescription
p VertexInputBindingDescription
x (Ptr VertexInputBindingDescription -> IO b
f Ptr VertexInputBindingDescription
p)
pokeCStruct :: Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO b -> IO b
pokeCStruct p :: Ptr VertexInputBindingDescription
p VertexInputBindingDescription{..} f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
binding)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
stride)
Ptr VertexInputRate -> VertexInputRate -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription -> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr VertexInputRate)) (VertexInputRate
inputRate)
IO b
f
cStructSize :: Int
cStructSize = 12
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: Ptr VertexInputBindingDescription -> IO b -> IO b
pokeZeroCStruct p :: Ptr VertexInputBindingDescription
p f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr VertexInputRate -> VertexInputRate -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription -> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr VertexInputRate)) (VertexInputRate
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct VertexInputBindingDescription where
peekCStruct :: Ptr VertexInputBindingDescription
-> IO VertexInputBindingDescription
peekCStruct p :: Ptr VertexInputBindingDescription
p = do
"createInfoCount" ::: Word32
binding <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
"createInfoCount" ::: Word32
stride <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
VertexInputRate
inputRate <- Ptr VertexInputRate -> IO VertexInputRate
forall a. Storable a => Ptr a -> IO a
peek @VertexInputRate ((Ptr VertexInputBindingDescription
p Ptr VertexInputBindingDescription -> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr VertexInputRate))
VertexInputBindingDescription -> IO VertexInputBindingDescription
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VertexInputBindingDescription -> IO VertexInputBindingDescription)
-> VertexInputBindingDescription
-> IO VertexInputBindingDescription
forall a b. (a -> b) -> a -> b
$ ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> VertexInputRate
-> VertexInputBindingDescription
VertexInputBindingDescription
"createInfoCount" ::: Word32
binding "createInfoCount" ::: Word32
stride VertexInputRate
inputRate
instance Storable VertexInputBindingDescription where
sizeOf :: VertexInputBindingDescription -> Int
sizeOf ~VertexInputBindingDescription
_ = 12
alignment :: VertexInputBindingDescription -> Int
alignment ~VertexInputBindingDescription
_ = 4
peek :: Ptr VertexInputBindingDescription
-> IO VertexInputBindingDescription
peek = Ptr VertexInputBindingDescription
-> IO VertexInputBindingDescription
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO ()
poke ptr :: Ptr VertexInputBindingDescription
ptr poked :: VertexInputBindingDescription
poked = Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr VertexInputBindingDescription
ptr VertexInputBindingDescription
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero VertexInputBindingDescription where
zero :: VertexInputBindingDescription
zero = ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> VertexInputRate
-> VertexInputBindingDescription
VertexInputBindingDescription
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
VertexInputRate
forall a. Zero a => a
zero
data VertexInputAttributeDescription = VertexInputAttributeDescription
{
VertexInputAttributeDescription -> "createInfoCount" ::: Word32
location :: Word32
,
VertexInputAttributeDescription -> "createInfoCount" ::: Word32
binding :: Word32
,
VertexInputAttributeDescription -> Format
format :: Format
,
VertexInputAttributeDescription -> "createInfoCount" ::: Word32
offset :: Word32
}
deriving (Typeable, VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool
(VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool)
-> (VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool)
-> Eq VertexInputAttributeDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool
$c/= :: VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool
== :: VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool
$c== :: VertexInputAttributeDescription
-> VertexInputAttributeDescription -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (VertexInputAttributeDescription)
#endif
deriving instance Show VertexInputAttributeDescription
instance ToCStruct VertexInputAttributeDescription where
withCStruct :: VertexInputAttributeDescription
-> (Ptr VertexInputAttributeDescription -> IO b) -> IO b
withCStruct x :: VertexInputAttributeDescription
x f :: Ptr VertexInputAttributeDescription -> IO b
f = Int -> Int -> (Ptr VertexInputAttributeDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 4 ((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> (Ptr VertexInputAttributeDescription -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr VertexInputAttributeDescription
p -> Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr VertexInputAttributeDescription
p VertexInputAttributeDescription
x (Ptr VertexInputAttributeDescription -> IO b
f Ptr VertexInputAttributeDescription
p)
pokeCStruct :: Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO b -> IO b
pokeCStruct p :: Ptr VertexInputAttributeDescription
p VertexInputAttributeDescription{..} f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
location)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
binding)
Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Format)) (Format
format)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) ("createInfoCount" ::: Word32
offset)
IO b
f
cStructSize :: Int
cStructSize = 16
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: Ptr VertexInputAttributeDescription -> IO b -> IO b
pokeZeroCStruct p :: Ptr VertexInputAttributeDescription
p f :: IO b
f = do
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct VertexInputAttributeDescription where
peekCStruct :: Ptr VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
peekCStruct p :: Ptr VertexInputAttributeDescription
p = do
"createInfoCount" ::: Word32
location <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
"createInfoCount" ::: Word32
binding <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
Format
format <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Format))
"createInfoCount" ::: Word32
offset <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VertexInputAttributeDescription
p Ptr VertexInputAttributeDescription
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32))
VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VertexInputAttributeDescription
-> IO VertexInputAttributeDescription)
-> VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
forall a b. (a -> b) -> a -> b
$ ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> Format
-> ("createInfoCount" ::: Word32)
-> VertexInputAttributeDescription
VertexInputAttributeDescription
"createInfoCount" ::: Word32
location "createInfoCount" ::: Word32
binding Format
format "createInfoCount" ::: Word32
offset
instance Storable VertexInputAttributeDescription where
sizeOf :: VertexInputAttributeDescription -> Int
sizeOf ~VertexInputAttributeDescription
_ = 16
alignment :: VertexInputAttributeDescription -> Int
alignment ~VertexInputAttributeDescription
_ = 4
peek :: Ptr VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
peek = Ptr VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO ()
poke ptr :: Ptr VertexInputAttributeDescription
ptr poked :: VertexInputAttributeDescription
poked = Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr VertexInputAttributeDescription
ptr VertexInputAttributeDescription
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero VertexInputAttributeDescription where
zero :: VertexInputAttributeDescription
zero = ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32)
-> Format
-> ("createInfoCount" ::: Word32)
-> VertexInputAttributeDescription
VertexInputAttributeDescription
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
Format
forall a. Zero a => a
zero
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
data PipelineVertexInputStateCreateInfo (es :: [Type]) = PipelineVertexInputStateCreateInfo
{
PipelineVertexInputStateCreateInfo es -> Chain es
next :: Chain es
,
PipelineVertexInputStateCreateInfo es
-> PipelineVertexInputStateCreateFlags
flags :: PipelineVertexInputStateCreateFlags
,
PipelineVertexInputStateCreateInfo es
-> Vector VertexInputBindingDescription
vertexBindingDescriptions :: Vector VertexInputBindingDescription
,
PipelineVertexInputStateCreateInfo es
-> Vector VertexInputAttributeDescription
vertexAttributeDescriptions :: Vector VertexInputAttributeDescription
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineVertexInputStateCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (PipelineVertexInputStateCreateInfo es)
instance Extensible PipelineVertexInputStateCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_PIPELINE_VERTEX_INPUT_STATE_CREATE_INFO
setNext :: PipelineVertexInputStateCreateInfo ds
-> Chain es -> PipelineVertexInputStateCreateInfo es
setNext x :: PipelineVertexInputStateCreateInfo ds
x next :: Chain es
next = PipelineVertexInputStateCreateInfo ds
x{$sel:next:PipelineVertexInputStateCreateInfo :: Chain es
next = Chain es
next}
getNext :: PipelineVertexInputStateCreateInfo es -> Chain es
getNext PipelineVertexInputStateCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends PipelineVertexInputStateCreateInfo e => b) -> Maybe b
extends :: proxy e
-> (Extends PipelineVertexInputStateCreateInfo e => b) -> Maybe b
extends _ f :: Extends PipelineVertexInputStateCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineVertexInputDivisorStateCreateInfoEXT) =>
Maybe (e :~: PipelineVertexInputDivisorStateCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineVertexInputDivisorStateCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineVertexInputStateCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss PipelineVertexInputStateCreateInfo es, PokeChain es) => ToCStruct (PipelineVertexInputStateCreateInfo es) where
withCStruct :: PipelineVertexInputStateCreateInfo es
-> (Ptr (PipelineVertexInputStateCreateInfo es) -> IO b) -> IO b
withCStruct x :: PipelineVertexInputStateCreateInfo es
x f :: Ptr (PipelineVertexInputStateCreateInfo es) -> IO b
f = Int
-> Int
-> (Ptr (PipelineVertexInputStateCreateInfo es) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr (PipelineVertexInputStateCreateInfo es) -> IO b) -> IO b)
-> (Ptr (PipelineVertexInputStateCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (PipelineVertexInputStateCreateInfo es)
p -> Ptr (PipelineVertexInputStateCreateInfo es)
-> PipelineVertexInputStateCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (PipelineVertexInputStateCreateInfo es)
p PipelineVertexInputStateCreateInfo es
x (Ptr (PipelineVertexInputStateCreateInfo es) -> IO b
f Ptr (PipelineVertexInputStateCreateInfo es)
p)
pokeCStruct :: Ptr (PipelineVertexInputStateCreateInfo es)
-> PipelineVertexInputStateCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (PipelineVertexInputStateCreateInfo es)
p PipelineVertexInputStateCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_VERTEX_INPUT_STATE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineVertexInputStateCreateFlags
-> PipelineVertexInputStateCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr PipelineVertexInputStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineVertexInputStateCreateFlags)) (PipelineVertexInputStateCreateFlags
flags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector VertexInputBindingDescription -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector VertexInputBindingDescription -> Int)
-> Vector VertexInputBindingDescription -> Int
forall a b. (a -> b) -> a -> b
$ (Vector VertexInputBindingDescription
vertexBindingDescriptions)) :: Word32))
Ptr VertexInputBindingDescription
pPVertexBindingDescriptions' <- ((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription))
-> ((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr VertexInputBindingDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @VertexInputBindingDescription ((Vector VertexInputBindingDescription -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector VertexInputBindingDescription
vertexBindingDescriptions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 12) 4
(Int -> VertexInputBindingDescription -> ContT b IO ())
-> Vector VertexInputBindingDescription -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: VertexInputBindingDescription
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr VertexInputBindingDescription
pPVertexBindingDescriptions' Ptr VertexInputBindingDescription
-> Int -> Ptr VertexInputBindingDescription
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputBindingDescription) (VertexInputBindingDescription
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector VertexInputBindingDescription
vertexBindingDescriptions)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr VertexInputBindingDescription)
-> Ptr VertexInputBindingDescription -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputBindingDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr VertexInputBindingDescription))) (Ptr VertexInputBindingDescription
pPVertexBindingDescriptions')
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector VertexInputAttributeDescription -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector VertexInputAttributeDescription -> Int)
-> Vector VertexInputAttributeDescription -> Int
forall a b. (a -> b) -> a -> b
$ (Vector VertexInputAttributeDescription
vertexAttributeDescriptions)) :: Word32))
Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions' <- ((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription))
-> ((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr VertexInputAttributeDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @VertexInputAttributeDescription ((Vector VertexInputAttributeDescription -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector VertexInputAttributeDescription
vertexAttributeDescriptions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 4
(Int -> VertexInputAttributeDescription -> ContT b IO ())
-> Vector VertexInputAttributeDescription -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: VertexInputAttributeDescription
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions' Ptr VertexInputAttributeDescription
-> Int -> Ptr VertexInputAttributeDescription
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputAttributeDescription) (VertexInputAttributeDescription
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector VertexInputAttributeDescription
vertexAttributeDescriptions)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr VertexInputAttributeDescription)
-> Ptr VertexInputAttributeDescription -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputAttributeDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr VertexInputAttributeDescription))) (Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 48
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (PipelineVertexInputStateCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (PipelineVertexInputStateCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_VERTEX_INPUT_STATE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
Ptr VertexInputBindingDescription
pPVertexBindingDescriptions' <- ((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription))
-> ((Ptr VertexInputBindingDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputBindingDescription)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr VertexInputBindingDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @VertexInputBindingDescription ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 12) 4
(Int -> VertexInputBindingDescription -> ContT b IO ())
-> Vector VertexInputBindingDescription -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: VertexInputBindingDescription
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr VertexInputBindingDescription
-> VertexInputBindingDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr VertexInputBindingDescription
pPVertexBindingDescriptions' Ptr VertexInputBindingDescription
-> Int -> Ptr VertexInputBindingDescription
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputBindingDescription) (VertexInputBindingDescription
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector VertexInputBindingDescription
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr VertexInputBindingDescription)
-> Ptr VertexInputBindingDescription -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputBindingDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr VertexInputBindingDescription))) (Ptr VertexInputBindingDescription
pPVertexBindingDescriptions')
Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions' <- ((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription))
-> ((Ptr VertexInputAttributeDescription -> IO b) -> IO b)
-> ContT b IO (Ptr VertexInputAttributeDescription)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr VertexInputAttributeDescription -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @VertexInputAttributeDescription ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 4
(Int -> VertexInputAttributeDescription -> ContT b IO ())
-> Vector VertexInputAttributeDescription -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: VertexInputAttributeDescription
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr VertexInputAttributeDescription
-> VertexInputAttributeDescription -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions' Ptr VertexInputAttributeDescription
-> Int -> Ptr VertexInputAttributeDescription
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputAttributeDescription) (VertexInputAttributeDescription
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector VertexInputAttributeDescription
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr VertexInputAttributeDescription)
-> Ptr VertexInputAttributeDescription -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputAttributeDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr VertexInputAttributeDescription))) (Ptr VertexInputAttributeDescription
pPVertexAttributeDescriptions')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss PipelineVertexInputStateCreateInfo es, PeekChain es) => FromCStruct (PipelineVertexInputStateCreateInfo es) where
peekCStruct :: Ptr (PipelineVertexInputStateCreateInfo es)
-> IO (PipelineVertexInputStateCreateInfo es)
peekCStruct p :: Ptr (PipelineVertexInputStateCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
PipelineVertexInputStateCreateFlags
flags <- Ptr PipelineVertexInputStateCreateFlags
-> IO PipelineVertexInputStateCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineVertexInputStateCreateFlags ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr PipelineVertexInputStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineVertexInputStateCreateFlags))
"createInfoCount" ::: Word32
vertexBindingDescriptionCount <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32))
Ptr VertexInputBindingDescription
pVertexBindingDescriptions <- Ptr (Ptr VertexInputBindingDescription)
-> IO (Ptr VertexInputBindingDescription)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr VertexInputBindingDescription) ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputBindingDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr VertexInputBindingDescription)))
Vector VertexInputBindingDescription
pVertexBindingDescriptions' <- Int
-> (Int -> IO VertexInputBindingDescription)
-> IO (Vector VertexInputBindingDescription)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "createInfoCount" ::: Word32
vertexBindingDescriptionCount) (\i :: Int
i -> Ptr VertexInputBindingDescription
-> IO VertexInputBindingDescription
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @VertexInputBindingDescription ((Ptr VertexInputBindingDescription
pVertexBindingDescriptions Ptr VertexInputBindingDescription
-> Int -> Ptr VertexInputBindingDescription
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputBindingDescription)))
"createInfoCount" ::: Word32
vertexAttributeDescriptionCount <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
Ptr VertexInputAttributeDescription
pVertexAttributeDescriptions <- Ptr (Ptr VertexInputAttributeDescription)
-> IO (Ptr VertexInputAttributeDescription)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr VertexInputAttributeDescription) ((Ptr (PipelineVertexInputStateCreateInfo es)
p Ptr (PipelineVertexInputStateCreateInfo es)
-> Int -> Ptr (Ptr VertexInputAttributeDescription)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr VertexInputAttributeDescription)))
Vector VertexInputAttributeDescription
pVertexAttributeDescriptions' <- Int
-> (Int -> IO VertexInputAttributeDescription)
-> IO (Vector VertexInputAttributeDescription)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("createInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "createInfoCount" ::: Word32
vertexAttributeDescriptionCount) (\i :: Int
i -> Ptr VertexInputAttributeDescription
-> IO VertexInputAttributeDescription
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @VertexInputAttributeDescription ((Ptr VertexInputAttributeDescription
pVertexAttributeDescriptions Ptr VertexInputAttributeDescription
-> Int -> Ptr VertexInputAttributeDescription
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputAttributeDescription)))
PipelineVertexInputStateCreateInfo es
-> IO (PipelineVertexInputStateCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineVertexInputStateCreateInfo es
-> IO (PipelineVertexInputStateCreateInfo es))
-> PipelineVertexInputStateCreateInfo es
-> IO (PipelineVertexInputStateCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> PipelineVertexInputStateCreateFlags
-> Vector VertexInputBindingDescription
-> Vector VertexInputAttributeDescription
-> PipelineVertexInputStateCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineVertexInputStateCreateFlags
-> Vector VertexInputBindingDescription
-> Vector VertexInputAttributeDescription
-> PipelineVertexInputStateCreateInfo es
PipelineVertexInputStateCreateInfo
Chain es
next PipelineVertexInputStateCreateFlags
flags Vector VertexInputBindingDescription
pVertexBindingDescriptions' Vector VertexInputAttributeDescription
pVertexAttributeDescriptions'
instance es ~ '[] => Zero (PipelineVertexInputStateCreateInfo es) where
zero :: PipelineVertexInputStateCreateInfo es
zero = Chain es
-> PipelineVertexInputStateCreateFlags
-> Vector VertexInputBindingDescription
-> Vector VertexInputAttributeDescription
-> PipelineVertexInputStateCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineVertexInputStateCreateFlags
-> Vector VertexInputBindingDescription
-> Vector VertexInputAttributeDescription
-> PipelineVertexInputStateCreateInfo es
PipelineVertexInputStateCreateInfo
()
PipelineVertexInputStateCreateFlags
forall a. Zero a => a
zero
Vector VertexInputBindingDescription
forall a. Monoid a => a
mempty
Vector VertexInputAttributeDescription
forall a. Monoid a => a
mempty
data PipelineInputAssemblyStateCreateInfo = PipelineInputAssemblyStateCreateInfo
{
PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateFlags
flags :: PipelineInputAssemblyStateCreateFlags
,
PipelineInputAssemblyStateCreateInfo -> PrimitiveTopology
topology :: PrimitiveTopology
,
PipelineInputAssemblyStateCreateInfo -> Bool
primitiveRestartEnable :: Bool
}
deriving (Typeable, PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool
(PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool)
-> (PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool)
-> Eq PipelineInputAssemblyStateCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool
$c/= :: PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool
== :: PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool
$c== :: PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineInputAssemblyStateCreateInfo)
#endif
deriving instance Show PipelineInputAssemblyStateCreateInfo
instance ToCStruct PipelineInputAssemblyStateCreateInfo where
withCStruct :: PipelineInputAssemblyStateCreateInfo
-> (Ptr PipelineInputAssemblyStateCreateInfo -> IO b) -> IO b
withCStruct x :: PipelineInputAssemblyStateCreateInfo
x f :: Ptr PipelineInputAssemblyStateCreateInfo -> IO b
f = Int
-> Int
-> (Ptr PipelineInputAssemblyStateCreateInfo -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr PipelineInputAssemblyStateCreateInfo -> IO b) -> IO b)
-> (Ptr PipelineInputAssemblyStateCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PipelineInputAssemblyStateCreateInfo
p -> Ptr PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineInputAssemblyStateCreateInfo
p PipelineInputAssemblyStateCreateInfo
x (Ptr PipelineInputAssemblyStateCreateInfo -> IO b
f Ptr PipelineInputAssemblyStateCreateInfo
p)
pokeCStruct :: Ptr PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr PipelineInputAssemblyStateCreateInfo
p PipelineInputAssemblyStateCreateInfo{..} f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INPUT_ASSEMBLY_STATE_CREATE_INFO)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr PipelineInputAssemblyStateCreateFlags
-> PipelineInputAssemblyStateCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr PipelineInputAssemblyStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineInputAssemblyStateCreateFlags)) (PipelineInputAssemblyStateCreateFlags
flags)
Ptr PrimitiveTopology -> PrimitiveTopology -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr PrimitiveTopology
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr PrimitiveTopology)) (PrimitiveTopology
topology)
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
primitiveRestartEnable))
IO b
f
cStructSize :: Int
cStructSize = 32
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr PipelineInputAssemblyStateCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr PipelineInputAssemblyStateCreateInfo
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INPUT_ASSEMBLY_STATE_CREATE_INFO)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr PrimitiveTopology -> PrimitiveTopology -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr PrimitiveTopology
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr PrimitiveTopology)) (PrimitiveTopology
forall a. Zero a => a
zero)
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PipelineInputAssemblyStateCreateInfo where
peekCStruct :: Ptr PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo
peekCStruct p :: Ptr PipelineInputAssemblyStateCreateInfo
p = do
PipelineInputAssemblyStateCreateFlags
flags <- Ptr PipelineInputAssemblyStateCreateFlags
-> IO PipelineInputAssemblyStateCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineInputAssemblyStateCreateFlags ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr PipelineInputAssemblyStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineInputAssemblyStateCreateFlags))
PrimitiveTopology
topology <- Ptr PrimitiveTopology -> IO PrimitiveTopology
forall a. Storable a => Ptr a -> IO a
peek @PrimitiveTopology ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo
-> Int -> Ptr PrimitiveTopology
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr PrimitiveTopology))
Bool32
primitiveRestartEnable <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PipelineInputAssemblyStateCreateInfo
p Ptr PipelineInputAssemblyStateCreateInfo -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32))
PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo)
-> PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo
forall a b. (a -> b) -> a -> b
$ PipelineInputAssemblyStateCreateFlags
-> PrimitiveTopology
-> Bool
-> PipelineInputAssemblyStateCreateInfo
PipelineInputAssemblyStateCreateInfo
PipelineInputAssemblyStateCreateFlags
flags PrimitiveTopology
topology (Bool32 -> Bool
bool32ToBool Bool32
primitiveRestartEnable)
instance Storable PipelineInputAssemblyStateCreateInfo where
sizeOf :: PipelineInputAssemblyStateCreateInfo -> Int
sizeOf ~PipelineInputAssemblyStateCreateInfo
_ = 32
alignment :: PipelineInputAssemblyStateCreateInfo -> Int
alignment ~PipelineInputAssemblyStateCreateInfo
_ = 8
peek :: Ptr PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo
peek = Ptr PipelineInputAssemblyStateCreateInfo
-> IO PipelineInputAssemblyStateCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> IO ()
poke ptr :: Ptr PipelineInputAssemblyStateCreateInfo
ptr poked :: PipelineInputAssemblyStateCreateInfo
poked = Ptr PipelineInputAssemblyStateCreateInfo
-> PipelineInputAssemblyStateCreateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineInputAssemblyStateCreateInfo
ptr PipelineInputAssemblyStateCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineInputAssemblyStateCreateInfo where
zero :: PipelineInputAssemblyStateCreateInfo
zero = PipelineInputAssemblyStateCreateFlags
-> PrimitiveTopology
-> Bool
-> PipelineInputAssemblyStateCreateInfo
PipelineInputAssemblyStateCreateInfo
PipelineInputAssemblyStateCreateFlags
forall a. Zero a => a
zero
PrimitiveTopology
forall a. Zero a => a
zero
Bool
forall a. Zero a => a
zero
data PipelineTessellationStateCreateInfo (es :: [Type]) = PipelineTessellationStateCreateInfo
{
PipelineTessellationStateCreateInfo es -> Chain es
next :: Chain es
,
PipelineTessellationStateCreateInfo es
-> PipelineTessellationStateCreateFlags
flags :: PipelineTessellationStateCreateFlags
,
PipelineTessellationStateCreateInfo es
-> "createInfoCount" ::: Word32
patchControlPoints :: Word32
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineTessellationStateCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (PipelineTessellationStateCreateInfo es)
instance Extensible PipelineTessellationStateCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_PIPELINE_TESSELLATION_STATE_CREATE_INFO
setNext :: PipelineTessellationStateCreateInfo ds
-> Chain es -> PipelineTessellationStateCreateInfo es
setNext x :: PipelineTessellationStateCreateInfo ds
x next :: Chain es
next = PipelineTessellationStateCreateInfo ds
x{$sel:next:PipelineTessellationStateCreateInfo :: Chain es
next = Chain es
next}
getNext :: PipelineTessellationStateCreateInfo es -> Chain es
getNext PipelineTessellationStateCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends PipelineTessellationStateCreateInfo e => b) -> Maybe b
extends :: proxy e
-> (Extends PipelineTessellationStateCreateInfo e => b) -> Maybe b
extends _ f :: Extends PipelineTessellationStateCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineTessellationDomainOriginStateCreateInfo) =>
Maybe (e :~: PipelineTessellationDomainOriginStateCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineTessellationDomainOriginStateCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineTessellationStateCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss PipelineTessellationStateCreateInfo es, PokeChain es) => ToCStruct (PipelineTessellationStateCreateInfo es) where
withCStruct :: PipelineTessellationStateCreateInfo es
-> (Ptr (PipelineTessellationStateCreateInfo es) -> IO b) -> IO b
withCStruct x :: PipelineTessellationStateCreateInfo es
x f :: Ptr (PipelineTessellationStateCreateInfo es) -> IO b
f = Int
-> Int
-> (Ptr (PipelineTessellationStateCreateInfo es) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr (PipelineTessellationStateCreateInfo es) -> IO b) -> IO b)
-> (Ptr (PipelineTessellationStateCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (PipelineTessellationStateCreateInfo es)
p -> Ptr (PipelineTessellationStateCreateInfo es)
-> PipelineTessellationStateCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (PipelineTessellationStateCreateInfo es)
p PipelineTessellationStateCreateInfo es
x (Ptr (PipelineTessellationStateCreateInfo es) -> IO b
f Ptr (PipelineTessellationStateCreateInfo es)
p)
pokeCStruct :: Ptr (PipelineTessellationStateCreateInfo es)
-> PipelineTessellationStateCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (PipelineTessellationStateCreateInfo es)
p PipelineTessellationStateCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_TESSELLATION_STATE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineTessellationStateCreateFlags
-> PipelineTessellationStateCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr PipelineTessellationStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineTessellationStateCreateFlags)) (PipelineTessellationStateCreateFlags
flags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) ("createInfoCount" ::: Word32
patchControlPoints)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (PipelineTessellationStateCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (PipelineTessellationStateCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_TESSELLATION_STATE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) ("createInfoCount" ::: Word32
forall a. Zero a => a
zero)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance (Extendss PipelineTessellationStateCreateInfo es, PeekChain es) => FromCStruct (PipelineTessellationStateCreateInfo es) where
peekCStruct :: Ptr (PipelineTessellationStateCreateInfo es)
-> IO (PipelineTessellationStateCreateInfo es)
peekCStruct p :: Ptr (PipelineTessellationStateCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
PipelineTessellationStateCreateFlags
flags <- Ptr PipelineTessellationStateCreateFlags
-> IO PipelineTessellationStateCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineTessellationStateCreateFlags ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr PipelineTessellationStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineTessellationStateCreateFlags))
"createInfoCount" ::: Word32
patchControlPoints <- Ptr ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (PipelineTessellationStateCreateInfo es)
p Ptr (PipelineTessellationStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32))
PipelineTessellationStateCreateInfo es
-> IO (PipelineTessellationStateCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineTessellationStateCreateInfo es
-> IO (PipelineTessellationStateCreateInfo es))
-> PipelineTessellationStateCreateInfo es
-> IO (PipelineTessellationStateCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> PipelineTessellationStateCreateFlags
-> ("createInfoCount" ::: Word32)
-> PipelineTessellationStateCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineTessellationStateCreateFlags
-> ("createInfoCount" ::: Word32)
-> PipelineTessellationStateCreateInfo es
PipelineTessellationStateCreateInfo
Chain es
next PipelineTessellationStateCreateFlags
flags "createInfoCount" ::: Word32
patchControlPoints
instance es ~ '[] => Zero (PipelineTessellationStateCreateInfo es) where
zero :: PipelineTessellationStateCreateInfo es
zero = Chain es
-> PipelineTessellationStateCreateFlags
-> ("createInfoCount" ::: Word32)
-> PipelineTessellationStateCreateInfo es
forall (es :: [*]).
Chain es
-> PipelineTessellationStateCreateFlags
-> ("createInfoCount" ::: Word32)
-> PipelineTessellationStateCreateInfo es
PipelineTessellationStateCreateInfo
()
PipelineTessellationStateCreateFlags
forall a. Zero a => a
zero
"createInfoCount" ::: Word32
forall a. Zero a => a
zero
data PipelineViewportStateCreateInfo (es :: [Type]) = PipelineViewportStateCreateInfo
{
PipelineViewportStateCreateInfo es -> Chain es
next :: Chain es
,
PipelineViewportStateCreateInfo es
-> PipelineViewportStateCreateFlags
flags :: PipelineViewportStateCreateFlags
,
PipelineViewportStateCreateInfo es -> "createInfoCount" ::: Word32
viewportCount :: Word32
,
PipelineViewportStateCreateInfo es -> Vector Viewport
viewports :: Vector Viewport
,
PipelineViewportStateCreateInfo es -> "createInfoCount" ::: Word32
scissorCount :: Word32
,
PipelineViewportStateCreateInfo es -> Vector Rect2D
scissors :: Vector Rect2D
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineViewportStateCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (PipelineViewportStateCreateInfo es)
instance Extensible PipelineViewportStateCreateInfo where
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_PIPELINE_VIEWPORT_STATE_CREATE_INFO
setNext :: PipelineViewportStateCreateInfo ds
-> Chain es -> PipelineViewportStateCreateInfo es
setNext x :: PipelineViewportStateCreateInfo ds
x next :: Chain es
next = PipelineViewportStateCreateInfo ds
x{$sel:next:PipelineViewportStateCreateInfo :: Chain es
next = Chain es
next}
getNext :: PipelineViewportStateCreateInfo es -> Chain es
getNext PipelineViewportStateCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends PipelineViewportStateCreateInfo e => b) -> Maybe b
extends :: proxy e
-> (Extends PipelineViewportStateCreateInfo e => b) -> Maybe b
extends _ f :: Extends PipelineViewportStateCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineViewportCoarseSampleOrderStateCreateInfoNV) =>
Maybe (e :~: PipelineViewportCoarseSampleOrderStateCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineViewportCoarseSampleOrderStateCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineViewportStateCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineViewportShadingRateImageStateCreateInfoNV) =>
Maybe (e :~: PipelineViewportShadingRateImageStateCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineViewportShadingRateImageStateCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineViewportStateCreateInfo e => b
f
| Just Refl <- (Typeable e,
Typeable PipelineViewportExclusiveScissorStateCreateInfoNV) =>
Maybe (e :~: PipelineViewportExclusiveScissorStateCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineViewportExclusiveScissorStateCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineViewportStateCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable PipelineViewportSwizzleStateCreateInfoNV) =>
Maybe (e :~: PipelineViewportSwizzleStateCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineViewportSwizzleStateCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineViewportStateCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable PipelineViewportWScalingStateCreateInfoNV) =>
Maybe (e :~: PipelineViewportWScalingStateCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @PipelineViewportWScalingStateCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends PipelineViewportStateCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss PipelineViewportStateCreateInfo es, PokeChain es) => ToCStruct (PipelineViewportStateCreateInfo es) where
withCStruct :: PipelineViewportStateCreateInfo es
-> (Ptr (PipelineViewportStateCreateInfo es) -> IO b) -> IO b
withCStruct x :: PipelineViewportStateCreateInfo es
x f :: Ptr (PipelineViewportStateCreateInfo es) -> IO b
f = Int
-> Int
-> (Ptr (PipelineViewportStateCreateInfo es) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr (PipelineViewportStateCreateInfo es) -> IO b) -> IO b)
-> (Ptr (PipelineViewportStateCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (PipelineViewportStateCreateInfo es)
p -> Ptr (PipelineViewportStateCreateInfo es)
-> PipelineViewportStateCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (PipelineViewportStateCreateInfo es)
p PipelineViewportStateCreateInfo es
x (Ptr (PipelineViewportStateCreateInfo es) -> IO b
f Ptr (PipelineViewportStateCreateInfo es)
p)
pokeCStruct :: Ptr (PipelineViewportStateCreateInfo es)
-> PipelineViewportStateCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (PipelineViewportStateCreateInfo es)
p PipelineViewportStateCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_VIEWPORT_STATE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PipelineViewportStateCreateFlags
-> PipelineViewportStateCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es)
-> Int -> Ptr PipelineViewportStateCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PipelineViewportStateCreateFlags)) (PipelineViewportStateCreateFlags
flags)
let pViewportsLength :: Int
pViewportsLength = Vector Viewport -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Viewport -> Int) -> Vector Viewport -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Viewport
viewports)
"createInfoCount" ::: Word32
viewportCount'' <- IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32))
-> IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32)
forall a b. (a -> b) -> a -> b
$ if ("createInfoCount" ::: Word32
viewportCount) ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then ("createInfoCount" ::: Word32) -> IO ("createInfoCount" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32))
-> ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pViewportsLength
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pViewportsLength ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== ("createInfoCount" ::: Word32
viewportCount) Bool -> Bool -> Bool
|| Int
pViewportsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "pViewports must be empty or have 'viewportCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
("createInfoCount" ::: Word32) -> IO ("createInfoCount" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("createInfoCount" ::: Word32
viewportCount)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) ("createInfoCount" ::: Word32
viewportCount'')
Ptr Viewport
pViewports'' <- if Vector Viewport -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector Viewport
viewports)
then Ptr Viewport -> ContT b IO (Ptr Viewport)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Viewport
forall a. Ptr a
nullPtr
else do
Ptr Viewport
pPViewports <- ((Ptr Viewport -> IO b) -> IO b) -> ContT b IO (Ptr Viewport)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Viewport -> IO b) -> IO b) -> ContT b IO (Ptr Viewport))
-> ((Ptr Viewport -> IO b) -> IO b) -> ContT b IO (Ptr Viewport)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Viewport -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Viewport (((Vector Viewport -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Viewport
viewports))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24) 4
(Int -> Viewport -> ContT b IO ())
-> Vector Viewport -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Viewport
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Viewport -> Viewport -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr Viewport
pPViewports Ptr Viewport -> Int -> Ptr Viewport
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Viewport) (Viewport
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) ((Vector Viewport
viewports))
Ptr Viewport -> ContT b IO (Ptr Viewport)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Viewport -> ContT b IO (Ptr Viewport))
-> Ptr Viewport -> ContT b IO (Ptr Viewport)
forall a b. (a -> b) -> a -> b
$ Ptr Viewport
pPViewports
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Viewport) -> Ptr Viewport -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es)
-> Int -> Ptr (Ptr Viewport)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Viewport))) Ptr Viewport
pViewports''
let pScissorsLength :: Int
pScissorsLength = Vector Rect2D -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Rect2D -> Int) -> Vector Rect2D -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Rect2D
scissors)
"createInfoCount" ::: Word32
scissorCount'' <- IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32))
-> IO ("createInfoCount" ::: Word32)
-> ContT b IO ("createInfoCount" ::: Word32)
forall a b. (a -> b) -> a -> b
$ if ("createInfoCount" ::: Word32
scissorCount) ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then ("createInfoCount" ::: Word32) -> IO ("createInfoCount" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32))
-> ("createInfoCount" ::: Word32)
-> IO ("createInfoCount" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pScissorsLength
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> "createInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pScissorsLength ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== ("createInfoCount" ::: Word32
scissorCount) Bool -> Bool -> Bool
|| Int
pScissorsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "pScissors must be empty or have 'scissorCount' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
("createInfoCount" ::: Word32) -> IO ("createInfoCount" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("createInfoCount" ::: Word32
scissorCount)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("createInfoCount" ::: Word32)
-> ("createInfoCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (PipelineViewportStateCreateInfo es)
p Ptr (PipelineViewportStateCreateInfo es)
-> Int -> Ptr ("createInfoCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ("createInfoCount" ::: Word32
scissorCount'')
Ptr Rect2D
pScissors'' <- if Vector Rect2D -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector Rect2D
scissors)
then Ptr Rect2D -> ContT b IO (Ptr Rect2D)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Rect2D
forall a. Ptr a
nullPtr
else do
Ptr Rect2D
pPScissors <- ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D))
-> ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Rect2D -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Rect2D (((Vector Rect2D -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Rect2D
scissors))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 4
(Int -> Rect2D -> ContT b IO ()) -> Vector Rect2D -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Rect2D
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a