{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts  ( PhysicalDeviceSeparateDepthStencilLayoutsFeatures(..)
                                                                          , AttachmentReferenceStencilLayout(..)
                                                                          , AttachmentDescriptionStencilLayout(..)
                                                                          , ImageLayout(..)
                                                                          , StructureType(..)
                                                                          ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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 Foreign.Ptr (Ptr)
import Data.Kind (Type)
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.ImageLayout (ImageLayout)
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_ATTACHMENT_DESCRIPTION_STENCIL_LAYOUT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ATTACHMENT_REFERENCE_STENCIL_LAYOUT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SEPARATE_DEPTH_STENCIL_LAYOUTS_FEATURES))
import Vulkan.Core10.Enums.ImageLayout (ImageLayout(..))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceSeparateDepthStencilLayoutsFeatures - Structure
-- describing whether the implementation can do depth and stencil image
-- barriers separately
--
-- = Members
--
-- The members of the 'PhysicalDeviceSeparateDepthStencilLayoutsFeatures'
-- structure describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceSeparateDepthStencilLayoutsFeatures' 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 the feature is supported.
-- 'PhysicalDeviceSeparateDepthStencilLayoutsFeatures' /can/ also be
-- included in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo'
-- to enable the feature.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSeparateDepthStencilLayoutsFeatures = PhysicalDeviceSeparateDepthStencilLayoutsFeatures
  { -- | @separateDepthStencilLayouts@ indicates whether the implementation
    -- supports a 'Vulkan.Core10.OtherTypes.ImageMemoryBarrier' for a
    -- depth\/stencil image with only one of
    -- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT' or
    -- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT' set,
    -- and whether
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL',
    -- or
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
    -- can be used.
    PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
separateDepthStencilLayouts :: Bool }
  deriving (Typeable, PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
(PhysicalDeviceSeparateDepthStencilLayoutsFeatures
 -> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool)
-> (PhysicalDeviceSeparateDepthStencilLayoutsFeatures
    -> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool)
-> Eq PhysicalDeviceSeparateDepthStencilLayoutsFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
$c/= :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
== :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
$c== :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSeparateDepthStencilLayoutsFeatures)
#endif
deriving instance Show PhysicalDeviceSeparateDepthStencilLayoutsFeatures

instance ToCStruct PhysicalDeviceSeparateDepthStencilLayoutsFeatures where
  withCStruct :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> (Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceSeparateDepthStencilLayoutsFeatures
x f :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p -> Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p PhysicalDeviceSeparateDepthStencilLayoutsFeatures
x (Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures -> IO b
f Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p)
  pokeCStruct :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO b
-> IO b
pokeCStruct p :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p PhysicalDeviceSeparateDepthStencilLayoutsFeatures{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SEPARATE_DEPTH_STENCIL_LAYOUTS_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> 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 PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
separateDepthStencilLayouts))
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SEPARATE_DEPTH_STENCIL_LAYOUTS_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> 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 PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> 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))
    IO b
f

instance FromCStruct PhysicalDeviceSeparateDepthStencilLayoutsFeatures where
  peekCStruct :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO PhysicalDeviceSeparateDepthStencilLayoutsFeatures
peekCStruct p :: Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p = do
    Bool32
separateDepthStencilLayouts <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
p Ptr PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
    PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO PhysicalDeviceSeparateDepthStencilLayoutsFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSeparateDepthStencilLayoutsFeatures
 -> IO PhysicalDeviceSeparateDepthStencilLayoutsFeatures)
-> PhysicalDeviceSeparateDepthStencilLayoutsFeatures
-> IO PhysicalDeviceSeparateDepthStencilLayoutsFeatures
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceSeparateDepthStencilLayoutsFeatures
PhysicalDeviceSeparateDepthStencilLayoutsFeatures
             (Bool32 -> Bool
bool32ToBool Bool32
separateDepthStencilLayouts)

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

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


-- | VkAttachmentReferenceStencilLayout - Structure specifying an attachment
-- description
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data AttachmentReferenceStencilLayout = AttachmentReferenceStencilLayout
  { -- | @stencilLayout@ is a 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
    -- specifying the layout the stencil aspect of the attachment uses during
    -- the subpass.
    --
    -- @stencilLayout@ /must/ not be
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL',
    -- or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PRESENT_SRC_KHR'
    --
    -- @stencilLayout@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
    AttachmentReferenceStencilLayout -> ImageLayout
stencilLayout :: ImageLayout }
  deriving (Typeable, AttachmentReferenceStencilLayout
-> AttachmentReferenceStencilLayout -> Bool
(AttachmentReferenceStencilLayout
 -> AttachmentReferenceStencilLayout -> Bool)
-> (AttachmentReferenceStencilLayout
    -> AttachmentReferenceStencilLayout -> Bool)
-> Eq AttachmentReferenceStencilLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentReferenceStencilLayout
-> AttachmentReferenceStencilLayout -> Bool
$c/= :: AttachmentReferenceStencilLayout
-> AttachmentReferenceStencilLayout -> Bool
== :: AttachmentReferenceStencilLayout
-> AttachmentReferenceStencilLayout -> Bool
$c== :: AttachmentReferenceStencilLayout
-> AttachmentReferenceStencilLayout -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentReferenceStencilLayout)
#endif
deriving instance Show AttachmentReferenceStencilLayout

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

instance FromCStruct AttachmentReferenceStencilLayout where
  peekCStruct :: Ptr AttachmentReferenceStencilLayout
-> IO AttachmentReferenceStencilLayout
peekCStruct p :: Ptr AttachmentReferenceStencilLayout
p = do
    ImageLayout
stencilLayout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr AttachmentReferenceStencilLayout
p Ptr AttachmentReferenceStencilLayout -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr ImageLayout))
    AttachmentReferenceStencilLayout
-> IO AttachmentReferenceStencilLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttachmentReferenceStencilLayout
 -> IO AttachmentReferenceStencilLayout)
-> AttachmentReferenceStencilLayout
-> IO AttachmentReferenceStencilLayout
forall a b. (a -> b) -> a -> b
$ ImageLayout -> AttachmentReferenceStencilLayout
AttachmentReferenceStencilLayout
             ImageLayout
stencilLayout

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

instance Zero AttachmentReferenceStencilLayout where
  zero :: AttachmentReferenceStencilLayout
zero = ImageLayout -> AttachmentReferenceStencilLayout
AttachmentReferenceStencilLayout
           ImageLayout
forall a. Zero a => a
zero


-- | VkAttachmentDescriptionStencilLayout - Structure specifying an
-- attachment description
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data AttachmentDescriptionStencilLayout = AttachmentDescriptionStencilLayout
  { -- | @stencilInitialLayout@ is the layout the stencil aspect of the
    -- attachment image subresource will be in when a render pass instance
    -- begins.
    --
    -- @stencilInitialLayout@ /must/ not be
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
    -- or
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
    --
    -- @stencilInitialLayout@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
    AttachmentDescriptionStencilLayout -> ImageLayout
stencilInitialLayout :: ImageLayout
  , -- | @stencilFinalLayout@ is the layout the stencil aspect of the attachment
    -- image subresource will be transitioned to when a render pass instance
    -- ends.
    --
    -- @stencilFinalLayout@ /must/ not be
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
    -- or
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
    --
    -- @stencilFinalLayout@ /must/ not be
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or
    -- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED'
    --
    -- @stencilFinalLayout@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
    AttachmentDescriptionStencilLayout -> ImageLayout
stencilFinalLayout :: ImageLayout
  }
  deriving (Typeable, AttachmentDescriptionStencilLayout
-> AttachmentDescriptionStencilLayout -> Bool
(AttachmentDescriptionStencilLayout
 -> AttachmentDescriptionStencilLayout -> Bool)
-> (AttachmentDescriptionStencilLayout
    -> AttachmentDescriptionStencilLayout -> Bool)
-> Eq AttachmentDescriptionStencilLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentDescriptionStencilLayout
-> AttachmentDescriptionStencilLayout -> Bool
$c/= :: AttachmentDescriptionStencilLayout
-> AttachmentDescriptionStencilLayout -> Bool
== :: AttachmentDescriptionStencilLayout
-> AttachmentDescriptionStencilLayout -> Bool
$c== :: AttachmentDescriptionStencilLayout
-> AttachmentDescriptionStencilLayout -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentDescriptionStencilLayout)
#endif
deriving instance Show AttachmentDescriptionStencilLayout

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

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

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

instance Zero AttachmentDescriptionStencilLayout where
  zero :: AttachmentDescriptionStencilLayout
zero = ImageLayout -> ImageLayout -> AttachmentDescriptionStencilLayout
AttachmentDescriptionStencilLayout
           ImageLayout
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero