{-# language CPP #-}
module Vulkan.Core11.Promoted_From_VK_KHR_multiview  ( PhysicalDeviceMultiviewFeatures(..)
                                                     , PhysicalDeviceMultiviewProperties(..)
                                                     , RenderPassMultiviewCreateInfo(..)
                                                     , StructureType(..)
                                                     , DependencyFlagBits(..)
                                                     , DependencyFlags
                                                     ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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 Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Data.Int (Int32)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
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.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDER_PASS_MULTIVIEW_CREATE_INFO))
import Vulkan.Core10.Enums.DependencyFlagBits (DependencyFlagBits(..))
import Vulkan.Core10.Enums.DependencyFlagBits (DependencyFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceMultiviewFeatures - Structure describing multiview
-- features that can be supported by an implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceMultiviewFeatures' structure describe
-- the following features:
--
-- = Description
--
-- -   @multiview@ specifies whether the implementation supports multiview
--     rendering within a render pass. If this feature is not enabled, the
--     view mask of each subpass /must/ always be zero.
--
-- -   @multiviewGeometryShader@ specifies whether the implementation
--     supports multiview rendering within a render pass, with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#geometry geometry shaders>.
--     If this feature is not enabled, then a pipeline compiled against a
--     subpass with a non-zero view mask /must/ not include a geometry
--     shader.
--
-- -   @multiviewTessellationShader@ specifies whether the implementation
--     supports multiview rendering within a render pass, with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#tessellation tessellation shaders>.
--     If this feature is not enabled, then a pipeline compiled against a
--     subpass with a non-zero view mask /must/ not include any
--     tessellation shaders.
--
-- If the 'PhysicalDeviceMultiviewFeatures' structure is included in the
-- @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
-- it is filled with values indicating whether each feature is supported.
-- 'PhysicalDeviceMultiviewFeatures' /can/ also be included in the @pNext@
-- chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to enable the features.
--
-- == Valid Usage
--
-- -   If @multiviewGeometryShader@ is enabled then @multiview@ /must/ also
--     be enabled
--
-- -   If @multiviewTessellationShader@ is enabled then @multiview@ /must/
--     also be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_FEATURES'
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceMultiviewFeatures = PhysicalDeviceMultiviewFeatures
  { -- No documentation found for Nested "VkPhysicalDeviceMultiviewFeatures" "multiview"
    PhysicalDeviceMultiviewFeatures -> Bool
multiview :: Bool
  , -- No documentation found for Nested "VkPhysicalDeviceMultiviewFeatures" "multiviewGeometryShader"
    PhysicalDeviceMultiviewFeatures -> Bool
multiviewGeometryShader :: Bool
  , -- No documentation found for Nested "VkPhysicalDeviceMultiviewFeatures" "multiviewTessellationShader"
    PhysicalDeviceMultiviewFeatures -> Bool
multiviewTessellationShader :: Bool
  }
  deriving (Typeable, PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> Bool
(PhysicalDeviceMultiviewFeatures
 -> PhysicalDeviceMultiviewFeatures -> Bool)
-> (PhysicalDeviceMultiviewFeatures
    -> PhysicalDeviceMultiviewFeatures -> Bool)
-> Eq PhysicalDeviceMultiviewFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> Bool
$c/= :: PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> Bool
== :: PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> Bool
$c== :: PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMultiviewFeatures)
#endif
deriving instance Show PhysicalDeviceMultiviewFeatures

instance ToCStruct PhysicalDeviceMultiviewFeatures where
  withCStruct :: PhysicalDeviceMultiviewFeatures
-> (Ptr PhysicalDeviceMultiviewFeatures -> IO b) -> IO b
withCStruct x :: PhysicalDeviceMultiviewFeatures
x f :: Ptr PhysicalDeviceMultiviewFeatures -> IO b
f = Int -> Int -> (Ptr PhysicalDeviceMultiviewFeatures -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr PhysicalDeviceMultiviewFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDeviceMultiviewFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceMultiviewFeatures
p -> Ptr PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceMultiviewFeatures
p PhysicalDeviceMultiviewFeatures
x (Ptr PhysicalDeviceMultiviewFeatures -> IO b
f Ptr PhysicalDeviceMultiviewFeatures
p)
  pokeCStruct :: Ptr PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceMultiviewFeatures
p PhysicalDeviceMultiviewFeatures{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multiview))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multiviewGeometryShader))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multiviewTessellationShader))
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceMultiviewFeatures -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceMultiviewFeatures
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> 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 PhysicalDeviceMultiviewFeatures where
  peekCStruct :: Ptr PhysicalDeviceMultiviewFeatures
-> IO PhysicalDeviceMultiviewFeatures
peekCStruct p :: Ptr PhysicalDeviceMultiviewFeatures
p = do
    Bool32
multiview <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
    Bool32
multiviewGeometryShader <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    Bool32
multiviewTessellationShader <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceMultiviewFeatures
p Ptr PhysicalDeviceMultiviewFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32))
    PhysicalDeviceMultiviewFeatures
-> IO PhysicalDeviceMultiviewFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMultiviewFeatures
 -> IO PhysicalDeviceMultiviewFeatures)
-> PhysicalDeviceMultiviewFeatures
-> IO PhysicalDeviceMultiviewFeatures
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> PhysicalDeviceMultiviewFeatures
PhysicalDeviceMultiviewFeatures
             (Bool32 -> Bool
bool32ToBool Bool32
multiview) (Bool32 -> Bool
bool32ToBool Bool32
multiviewGeometryShader) (Bool32 -> Bool
bool32ToBool Bool32
multiviewTessellationShader)

instance Storable PhysicalDeviceMultiviewFeatures where
  sizeOf :: PhysicalDeviceMultiviewFeatures -> Int
sizeOf ~PhysicalDeviceMultiviewFeatures
_ = 32
  alignment :: PhysicalDeviceMultiviewFeatures -> Int
alignment ~PhysicalDeviceMultiviewFeatures
_ = 8
  peek :: Ptr PhysicalDeviceMultiviewFeatures
-> IO PhysicalDeviceMultiviewFeatures
peek = Ptr PhysicalDeviceMultiviewFeatures
-> IO PhysicalDeviceMultiviewFeatures
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> IO ()
poke ptr :: Ptr PhysicalDeviceMultiviewFeatures
ptr poked :: PhysicalDeviceMultiviewFeatures
poked = Ptr PhysicalDeviceMultiviewFeatures
-> PhysicalDeviceMultiviewFeatures -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceMultiviewFeatures
ptr PhysicalDeviceMultiviewFeatures
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceMultiviewFeatures where
  zero :: PhysicalDeviceMultiviewFeatures
zero = Bool -> Bool -> Bool -> PhysicalDeviceMultiviewFeatures
PhysicalDeviceMultiviewFeatures
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkPhysicalDeviceMultiviewProperties - Structure describing multiview
-- limits that can be supported by an implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceMultiviewProperties' structure
-- describe the following implementation-dependent limits:
--
-- = Description
--
-- If the 'PhysicalDeviceMultiviewProperties' structure is included in the
-- @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2',
-- it is filled with the implementation-dependent limits.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceMultiviewProperties = PhysicalDeviceMultiviewProperties
  { -- | @maxMultiviewViewCount@ is one greater than the maximum view index that
    -- /can/ be used in a subpass.
    PhysicalDeviceMultiviewProperties -> Word32
maxMultiviewViewCount :: Word32
  , -- | @maxMultiviewInstanceIndex@ is the maximum valid value of instance index
    -- allowed to be generated by a drawing command recorded within a subpass
    -- of a multiview render pass instance.
    PhysicalDeviceMultiviewProperties -> Word32
maxMultiviewInstanceIndex :: Word32
  }
  deriving (Typeable, PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> Bool
(PhysicalDeviceMultiviewProperties
 -> PhysicalDeviceMultiviewProperties -> Bool)
-> (PhysicalDeviceMultiviewProperties
    -> PhysicalDeviceMultiviewProperties -> Bool)
-> Eq PhysicalDeviceMultiviewProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> Bool
$c/= :: PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> Bool
== :: PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> Bool
$c== :: PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMultiviewProperties)
#endif
deriving instance Show PhysicalDeviceMultiviewProperties

instance ToCStruct PhysicalDeviceMultiviewProperties where
  withCStruct :: PhysicalDeviceMultiviewProperties
-> (Ptr PhysicalDeviceMultiviewProperties -> IO b) -> IO b
withCStruct x :: PhysicalDeviceMultiviewProperties
x f :: Ptr PhysicalDeviceMultiviewProperties -> IO b
f = Int
-> Int -> (Ptr PhysicalDeviceMultiviewProperties -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr PhysicalDeviceMultiviewProperties -> IO b) -> IO b)
-> (Ptr PhysicalDeviceMultiviewProperties -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceMultiviewProperties
p -> Ptr PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceMultiviewProperties
p PhysicalDeviceMultiviewProperties
x (Ptr PhysicalDeviceMultiviewProperties -> IO b
f Ptr PhysicalDeviceMultiviewProperties
p)
  pokeCStruct :: Ptr PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceMultiviewProperties
p PhysicalDeviceMultiviewProperties{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
maxMultiviewViewCount)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) (Word32
maxMultiviewInstanceIndex)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceMultiviewProperties -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceMultiviewProperties
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTIVIEW_PROPERTIES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceMultiviewProperties where
  peekCStruct :: Ptr PhysicalDeviceMultiviewProperties
-> IO PhysicalDeviceMultiviewProperties
peekCStruct p :: Ptr PhysicalDeviceMultiviewProperties
p = do
    Word32
maxMultiviewViewCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Word32
maxMultiviewInstanceIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceMultiviewProperties
p Ptr PhysicalDeviceMultiviewProperties -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32))
    PhysicalDeviceMultiviewProperties
-> IO PhysicalDeviceMultiviewProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMultiviewProperties
 -> IO PhysicalDeviceMultiviewProperties)
-> PhysicalDeviceMultiviewProperties
-> IO PhysicalDeviceMultiviewProperties
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> PhysicalDeviceMultiviewProperties
PhysicalDeviceMultiviewProperties
             Word32
maxMultiviewViewCount Word32
maxMultiviewInstanceIndex

instance Storable PhysicalDeviceMultiviewProperties where
  sizeOf :: PhysicalDeviceMultiviewProperties -> Int
sizeOf ~PhysicalDeviceMultiviewProperties
_ = 24
  alignment :: PhysicalDeviceMultiviewProperties -> Int
alignment ~PhysicalDeviceMultiviewProperties
_ = 8
  peek :: Ptr PhysicalDeviceMultiviewProperties
-> IO PhysicalDeviceMultiviewProperties
peek = Ptr PhysicalDeviceMultiviewProperties
-> IO PhysicalDeviceMultiviewProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> IO ()
poke ptr :: Ptr PhysicalDeviceMultiviewProperties
ptr poked :: PhysicalDeviceMultiviewProperties
poked = Ptr PhysicalDeviceMultiviewProperties
-> PhysicalDeviceMultiviewProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceMultiviewProperties
ptr PhysicalDeviceMultiviewProperties
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceMultiviewProperties where
  zero :: PhysicalDeviceMultiviewProperties
zero = Word32 -> Word32 -> PhysicalDeviceMultiviewProperties
PhysicalDeviceMultiviewProperties
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkRenderPassMultiviewCreateInfo - Structure containing multiview info
-- for all subpasses
--
-- = Description
--
-- When a subpass uses a non-zero view mask, /multiview/ functionality is
-- considered to be enabled. Multiview is all-or-nothing for a render pass
-- - that is, either all subpasses /must/ have a non-zero view mask (though
-- some subpasses /may/ have only one view) or all /must/ be zero.
-- Multiview causes all drawing and clear commands in the subpass to behave
-- as if they were broadcast to each view, where a view is represented by
-- one layer of the framebuffer attachments. All draws and clears are
-- broadcast to each /view index/ whose bit is set in the view mask. The
-- view index is provided in the @ViewIndex@ shader input variable, and
-- color, depth\/stencil, and input attachments all read\/write the layer
-- of the framebuffer corresponding to the view index.
--
-- If the view mask is zero for all subpasses, multiview is considered to
-- be disabled and all drawing commands execute normally, without this
-- additional broadcasting.
--
-- Some implementations /may/ not support multiview in conjunction with
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiview-gs geometry shaders>
-- or
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiview-tess tessellation shaders>.
--
-- When multiview is enabled, the
-- 'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT' bit
-- in a dependency /can/ be used to express a view-local dependency,
-- meaning that each view in the destination subpass depends on a single
-- view in the source subpass. Unlike pipeline barriers, a subpass
-- dependency /can/ potentially have a different view mask in the source
-- subpass and the destination subpass. If the dependency is view-local,
-- then each view (dstView) in the destination subpass depends on the view
-- dstView + @pViewOffsets@[dependency] in the source subpass. If there is
-- not such a view in the source subpass, then this dependency does not
-- affect that view in the destination subpass. If the dependency is not
-- view-local, then all views in the destination subpass depend on all
-- views in the source subpass, and the view offset is ignored. A non-zero
-- view offset is not allowed in a self-dependency.
--
-- The elements of @pCorrelationMasks@ are a set of masks of views
-- indicating that views in the same mask /may/ exhibit spatial coherency
-- between the views, making it more efficient to render them concurrently.
-- Correlation masks /must/ not have a functional effect on the results of
-- the multiview rendering.
--
-- When multiview is enabled, at the beginning of each subpass all
-- non-render pass state is undefined. In particular, each time
-- 'Vulkan.Core10.CommandBufferBuilding.cmdBeginRenderPass' or
-- 'Vulkan.Core10.CommandBufferBuilding.cmdNextSubpass' is called the
-- graphics pipeline /must/ be bound, any relevant descriptor sets or
-- vertex\/index buffers /must/ be bound, and any relevant dynamic state or
-- push constants /must/ be set before they are used.
--
-- A multiview subpass /can/ declare that its shaders will write per-view
-- attributes for all views in a single invocation, by setting the
-- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_ATTRIBUTES_BIT_NVX'
-- bit in the subpass description. The only supported per-view attributes
-- are position and viewport mask, and per-view position and viewport masks
-- are written to output array variables decorated with @PositionPerViewNV@
-- and @ViewportMaskPerViewNV@, respectively. If @VK_NV_viewport_array2@ is
-- not supported and enabled, @ViewportMaskPerViewNV@ /must/ not be used.
-- Values written to elements of @PositionPerViewNV@ and
-- @ViewportMaskPerViewNV@ /must/ not depend on the @ViewIndex@. The shader
-- /must/ also write to an output variable decorated with @Position@, and
-- the value written to @Position@ /must/ equal the value written to
-- @PositionPerViewNV@[@ViewIndex@]. Similarly, if @ViewportMaskPerViewNV@
-- is written to then the shader /must/ also write to an output variable
-- decorated with @ViewportMaskNV@, and the value written to
-- @ViewportMaskNV@ /must/ equal the value written to
-- @ViewportMaskPerViewNV@[@ViewIndex@]. Implementations will either use
-- values taken from @Position@ and @ViewportMaskNV@ and invoke the shader
-- once for each view, or will use values taken from @PositionPerViewNV@
-- and @ViewportMaskPerViewNV@ and invoke the shader fewer times. The
-- values written to @Position@ and @ViewportMaskNV@ /must/ not depend on
-- the values written to @PositionPerViewNV@ and @ViewportMaskPerViewNV@,
-- or vice versa (to allow compilers to eliminate the unused outputs). All
-- attributes that do not have @*PerViewNV@ counterparts /must/ not depend
-- on @ViewIndex@.
--
-- Per-view attributes are all-or-nothing for a subpass. That is, all
-- pipelines compiled against a subpass that includes the
-- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_ATTRIBUTES_BIT_NVX'
-- bit /must/ write per-view attributes to the @*PerViewNV[]@ shader
-- outputs, in addition to the non-per-view (e.g. @Position@) outputs.
-- Pipelines compiled against a subpass that does not include this bit
-- /must/ not include the @*PerViewNV[]@ outputs in their interfaces.
--
-- == Valid Usage
--
-- -   Each view index /must/ not be set in more than one element of
--     @pCorrelationMasks@
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDER_PASS_MULTIVIEW_CREATE_INFO'
--
-- -   If @subpassCount@ is not @0@, @pViewMasks@ /must/ be a valid pointer
--     to an array of @subpassCount@ @uint32_t@ values
--
-- -   If @dependencyCount@ is not @0@, @pViewOffsets@ /must/ be a valid
--     pointer to an array of @dependencyCount@ @int32_t@ values
--
-- -   If @correlationMaskCount@ is not @0@, @pCorrelationMasks@ /must/ be
--     a valid pointer to an array of @correlationMaskCount@ @uint32_t@
--     values
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderPassMultiviewCreateInfo = RenderPassMultiviewCreateInfo
  { -- | @pViewMasks@ is a pointer to an array of @subpassCount@ view masks,
    -- where each mask is a bitfield of view indices describing which views
    -- rendering is broadcast to in each subpass, when multiview is enabled. If
    -- @subpassCount@ is zero, each view mask is treated as zero.
    RenderPassMultiviewCreateInfo -> Vector Word32
viewMasks :: Vector Word32
  , -- | @pViewOffsets@ is a pointer to an array of @dependencyCount@ view
    -- offsets, one for each dependency. If @dependencyCount@ is zero, each
    -- dependency’s view offset is treated as zero. Each view offset controls
    -- which views in the source subpass the views in the destination subpass
    -- depend on.
    RenderPassMultiviewCreateInfo -> Vector Int32
viewOffsets :: Vector Int32
  , -- | @pCorrelationMasks@ is a pointer to an array of @correlationMaskCount@
    -- view masks indicating sets of views that /may/ be more efficient to
    -- render concurrently.
    RenderPassMultiviewCreateInfo -> Vector Word32
correlationMasks :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderPassMultiviewCreateInfo)
#endif
deriving instance Show RenderPassMultiviewCreateInfo

instance ToCStruct RenderPassMultiviewCreateInfo where
  withCStruct :: RenderPassMultiviewCreateInfo
-> (Ptr RenderPassMultiviewCreateInfo -> IO b) -> IO b
withCStruct x :: RenderPassMultiviewCreateInfo
x f :: Ptr RenderPassMultiviewCreateInfo -> IO b
f = Int -> Int -> (Ptr RenderPassMultiviewCreateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((Ptr RenderPassMultiviewCreateInfo -> IO b) -> IO b)
-> (Ptr RenderPassMultiviewCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr RenderPassMultiviewCreateInfo
p -> Ptr RenderPassMultiviewCreateInfo
-> RenderPassMultiviewCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderPassMultiviewCreateInfo
p RenderPassMultiviewCreateInfo
x (Ptr RenderPassMultiviewCreateInfo -> IO b
f Ptr RenderPassMultiviewCreateInfo
p)
  pokeCStruct :: Ptr RenderPassMultiviewCreateInfo
-> RenderPassMultiviewCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr RenderPassMultiviewCreateInfo
p RenderPassMultiviewCreateInfo{..} 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 RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_MULTIVIEW_CREATE_INFO)
    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 RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
viewMasks)) :: Word32))
    Ptr Word32
pPViewMasks' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
viewMasks)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPViewMasks' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
viewMasks)
    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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPViewMasks')
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Int32 -> Int) -> Vector Int32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Int32
viewOffsets)) :: Word32))
    Ptr Int32
pPViewOffsets' <- ((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32))
-> ((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Int32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Int32 ((Vector Int32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Int32
viewOffsets)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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
$ (Int -> Int32 -> IO ()) -> Vector Int32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Int32
e -> Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Int32
pPViewOffsets' Ptr Int32 -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Int32) (Int32
e)) (Vector Int32
viewOffsets)
    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 Int32) -> Ptr Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Int32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Int32))) (Ptr Int32
pPViewOffsets')
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
correlationMasks)) :: Word32))
    Ptr Word32
pPCorrelationMasks' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
correlationMasks)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPCorrelationMasks' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
correlationMasks)
    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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr Word32))) (Ptr Word32
pPCorrelationMasks')
    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 = 64
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr RenderPassMultiviewCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr RenderPassMultiviewCreateInfo
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 RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_MULTIVIEW_CREATE_INFO)
    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 RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32
pPViewMasks' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((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
* 4) 4
    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
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPViewMasks' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPViewMasks')
    Ptr Int32
pPViewOffsets' <- ((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32))
-> ((Ptr Int32 -> IO b) -> IO b) -> ContT b IO (Ptr Int32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Int32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Int32 ((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
* 4) 4
    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
$ (Int -> Int32 -> IO ()) -> Vector Int32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Int32
e -> Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Int32
pPViewOffsets' Ptr Int32 -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Int32) (Int32
e)) (Vector Int32
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 Int32) -> Ptr Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Int32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Int32))) (Ptr Int32
pPViewOffsets')
    Ptr Word32
pPCorrelationMasks' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((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
* 4) 4
    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
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPCorrelationMasks' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr Word32))) (Ptr Word32
pPCorrelationMasks')
    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 RenderPassMultiviewCreateInfo where
  peekCStruct :: Ptr RenderPassMultiviewCreateInfo
-> IO RenderPassMultiviewCreateInfo
peekCStruct p :: Ptr RenderPassMultiviewCreateInfo
p = do
    Word32
subpassCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr Word32
pViewMasks <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32)))
    Vector Word32
pViewMasks' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
subpassCount) (\i :: Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pViewMasks Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    Word32
dependencyCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
    Ptr Int32
pViewOffsets <- Ptr (Ptr Int32) -> IO (Ptr Int32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Int32) ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Int32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Int32)))
    Vector Int32
pViewOffsets' <- Int -> (Int -> IO Int32) -> IO (Vector Int32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dependencyCount) (\i :: Int
i -> Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr Int32
pViewOffsets Ptr Int32 -> Int -> Ptr Int32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Int32)))
    Word32
correlationMaskCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32))
    Ptr Word32
pCorrelationMasks <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr RenderPassMultiviewCreateInfo
p Ptr RenderPassMultiviewCreateInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr Word32)))
    Vector Word32
pCorrelationMasks' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
correlationMaskCount) (\i :: Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pCorrelationMasks Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    RenderPassMultiviewCreateInfo -> IO RenderPassMultiviewCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderPassMultiviewCreateInfo -> IO RenderPassMultiviewCreateInfo)
-> RenderPassMultiviewCreateInfo
-> IO RenderPassMultiviewCreateInfo
forall a b. (a -> b) -> a -> b
$ Vector Word32
-> Vector Int32 -> Vector Word32 -> RenderPassMultiviewCreateInfo
RenderPassMultiviewCreateInfo
             Vector Word32
pViewMasks' Vector Int32
pViewOffsets' Vector Word32
pCorrelationMasks'

instance Zero RenderPassMultiviewCreateInfo where
  zero :: RenderPassMultiviewCreateInfo
zero = Vector Word32
-> Vector Int32 -> Vector Word32 -> RenderPassMultiviewCreateInfo
RenderPassMultiviewCreateInfo
           Vector Word32
forall a. Monoid a => a
mempty
           Vector Int32
forall a. Monoid a => a
mempty
           Vector Word32
forall a. Monoid a => a
mempty