{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_blend_operation_advanced  ( PhysicalDeviceBlendOperationAdvancedFeaturesEXT(..)
                                                          , PhysicalDeviceBlendOperationAdvancedPropertiesEXT(..)
                                                          , PipelineColorBlendAdvancedStateCreateInfoEXT(..)
                                                          , BlendOverlapEXT( BLEND_OVERLAP_UNCORRELATED_EXT
                                                                           , BLEND_OVERLAP_DISJOINT_EXT
                                                                           , BLEND_OVERLAP_CONJOINT_EXT
                                                                           , ..
                                                                           )
                                                          , EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION
                                                          , pattern EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION
                                                          , EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME
                                                          , pattern EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME
                                                          ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.String (IsString)
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 GHC.Read (Read(readPrec))
import Data.Word (Word32)
import Text.Read.Lex (Lexeme(Ident))
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.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_BLEND_OPERATION_ADVANCED_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_BLEND_OPERATION_ADVANCED_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_ADVANCED_STATE_CREATE_INFO_EXT))
-- | VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT - Structure describing
-- advanced blending features that can be supported by an implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceBlendOperationAdvancedFeaturesEXT'
-- structure describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceBlendOperationAdvancedFeaturesEXT' 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.
-- 'PhysicalDeviceBlendOperationAdvancedFeaturesEXT' /can/ also be included
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- enable the features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceBlendOperationAdvancedFeaturesEXT = PhysicalDeviceBlendOperationAdvancedFeaturesEXT
  { -- | @advancedBlendCoherentOperations@ specifies whether blending using
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#framebuffer-blend-advanced advanced blend operations>
    -- is guaranteed to execute atomically and in
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#drawing-primitive-order primitive order>.
    -- If this is 'Vulkan.Core10.FundamentalTypes.TRUE',
    -- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_COLOR_ATTACHMENT_READ_NONCOHERENT_BIT_EXT'
    -- is treated the same as
    -- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_COLOR_ATTACHMENT_READ_BIT',
    -- and advanced blending needs no additional synchronization over basic
    -- blending. If this is 'Vulkan.Core10.FundamentalTypes.FALSE', then memory
    -- dependencies are required to guarantee order between two advanced
    -- blending operations that occur on the same sample.
    PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
advancedBlendCoherentOperations :: Bool }
  deriving (Typeable, PhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
(PhysicalDeviceBlendOperationAdvancedFeaturesEXT
 -> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool)
-> (PhysicalDeviceBlendOperationAdvancedFeaturesEXT
    -> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool)
-> Eq PhysicalDeviceBlendOperationAdvancedFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
$c/= :: PhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
== :: PhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
$c== :: PhysicalDeviceBlendOperationAdvancedFeaturesEXT
-> PhysicalDeviceBlendOperationAdvancedFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceBlendOperationAdvancedFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceBlendOperationAdvancedFeaturesEXT

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

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

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


-- | VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT - Structure
-- describing advanced blending limits that can be supported by an
-- implementation
--
-- = Members
--
-- The members of the 'PhysicalDeviceBlendOperationAdvancedPropertiesEXT'
-- structure describe the following implementation-dependent limits:
--
-- = Description
--
-- If the 'PhysicalDeviceBlendOperationAdvancedPropertiesEXT' 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.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceBlendOperationAdvancedPropertiesEXT = PhysicalDeviceBlendOperationAdvancedPropertiesEXT
  { -- | @advancedBlendMaxColorAttachments@ is one greater than the highest color
    -- attachment index that /can/ be used in a subpass, for a pipeline that
    -- uses an
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#framebuffer-blend-advanced advanced blend operation>.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Word32
advancedBlendMaxColorAttachments :: Word32
  , -- | @advancedBlendIndependentBlend@ specifies whether advanced blend
    -- operations /can/ vary per-attachment.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
advancedBlendIndependentBlend :: Bool
  , -- | @advancedBlendNonPremultipliedSrcColor@ specifies whether the source
    -- color /can/ be treated as non-premultiplied. If this is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', then
    -- 'PipelineColorBlendAdvancedStateCreateInfoEXT'::@srcPremultiplied@
    -- /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
advancedBlendNonPremultipliedSrcColor :: Bool
  , -- | @advancedBlendNonPremultipliedDstColor@ specifies whether the
    -- destination color /can/ be treated as non-premultiplied. If this is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', then
    -- 'PipelineColorBlendAdvancedStateCreateInfoEXT'::@dstPremultiplied@
    -- /must/ be 'Vulkan.Core10.FundamentalTypes.TRUE'.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
advancedBlendNonPremultipliedDstColor :: Bool
  , -- | @advancedBlendCorrelatedOverlap@ specifies whether the overlap mode
    -- /can/ be treated as correlated. If this is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', then
    -- 'PipelineColorBlendAdvancedStateCreateInfoEXT'::@blendOverlap@ /must/ be
    -- 'BLEND_OVERLAP_UNCORRELATED_EXT'.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
advancedBlendCorrelatedOverlap :: Bool
  , -- | @advancedBlendAllOperations@ specifies whether all advanced blend
    -- operation enums are supported. See the valid usage of
    -- 'Vulkan.Core10.Pipeline.PipelineColorBlendAttachmentState'.
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
advancedBlendAllOperations :: Bool
  }
  deriving (Typeable, PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
(PhysicalDeviceBlendOperationAdvancedPropertiesEXT
 -> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool)
-> (PhysicalDeviceBlendOperationAdvancedPropertiesEXT
    -> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool)
-> Eq PhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
$c/= :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
== :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
$c== :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceBlendOperationAdvancedPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceBlendOperationAdvancedPropertiesEXT

instance ToCStruct PhysicalDeviceBlendOperationAdvancedPropertiesEXT where
  withCStruct :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> (Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceBlendOperationAdvancedPropertiesEXT
x f :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p -> Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p PhysicalDeviceBlendOperationAdvancedPropertiesEXT
x (Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT -> IO b
f Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p)
  pokeCStruct :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO b
-> IO b
pokeCStruct p :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p PhysicalDeviceBlendOperationAdvancedPropertiesEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_BLEND_OPERATION_ADVANCED_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> 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 PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
advancedBlendMaxColorAttachments)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
advancedBlendIndependentBlend))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
advancedBlendNonPremultipliedSrcColor))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
advancedBlendNonPremultipliedDstColor))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
advancedBlendCorrelatedOverlap))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
advancedBlendAllOperations))
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_BLEND_OPERATION_ADVANCED_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> 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 PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> 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 PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: 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 PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: 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 PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceBlendOperationAdvancedPropertiesEXT where
  peekCStruct :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO PhysicalDeviceBlendOperationAdvancedPropertiesEXT
peekCStruct p :: Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p = do
    Word32
advancedBlendMaxColorAttachments <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Bool32
advancedBlendIndependentBlend <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    Bool32
advancedBlendNonPremultipliedSrcColor <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32))
    Bool32
advancedBlendNonPremultipliedDstColor <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Bool32))
    Bool32
advancedBlendCorrelatedOverlap <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32))
    Bool32
advancedBlendAllOperations <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
p Ptr PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr Bool32))
    PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO PhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceBlendOperationAdvancedPropertiesEXT
 -> IO PhysicalDeviceBlendOperationAdvancedPropertiesEXT)
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT
-> IO PhysicalDeviceBlendOperationAdvancedPropertiesEXT
forall a b. (a -> b) -> a -> b
$ Word32
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceBlendOperationAdvancedPropertiesEXT
PhysicalDeviceBlendOperationAdvancedPropertiesEXT
             Word32
advancedBlendMaxColorAttachments (Bool32 -> Bool
bool32ToBool Bool32
advancedBlendIndependentBlend) (Bool32 -> Bool
bool32ToBool Bool32
advancedBlendNonPremultipliedSrcColor) (Bool32 -> Bool
bool32ToBool Bool32
advancedBlendNonPremultipliedDstColor) (Bool32 -> Bool
bool32ToBool Bool32
advancedBlendCorrelatedOverlap) (Bool32 -> Bool
bool32ToBool Bool32
advancedBlendAllOperations)

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

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


-- | VkPipelineColorBlendAdvancedStateCreateInfoEXT - Structure specifying
-- parameters that affect advanced blend operations
--
-- = Description
--
-- If this structure is not present, @srcPremultiplied@ and
-- @dstPremultiplied@ are both considered to be
-- 'Vulkan.Core10.FundamentalTypes.TRUE', and @blendOverlap@ is considered
-- to be 'BLEND_OVERLAP_UNCORRELATED_EXT'.
--
-- == Valid Usage
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-advancedBlendNonPremultipliedSrcColor non-premultiplied source color>
--     property is not supported, @srcPremultiplied@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-advancedBlendNonPremultipliedDstColor non-premultiplied destination color>
--     property is not supported, @dstPremultiplied@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-advancedBlendCorrelatedOverlap correlated overlap>
--     property is not supported, @blendOverlap@ /must/ be
--     'BLEND_OVERLAP_UNCORRELATED_EXT'
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_ADVANCED_STATE_CREATE_INFO_EXT'
--
-- -   @blendOverlap@ /must/ be a valid 'BlendOverlapEXT' value
--
-- = See Also
--
-- 'BlendOverlapEXT', 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineColorBlendAdvancedStateCreateInfoEXT = PipelineColorBlendAdvancedStateCreateInfoEXT
  { -- | @srcPremultiplied@ specifies whether the source color of the blend
    -- operation is treated as premultiplied.
    PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
srcPremultiplied :: Bool
  , -- | @dstPremultiplied@ specifies whether the destination color of the blend
    -- operation is treated as premultiplied.
    PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
dstPremultiplied :: Bool
  , -- | @blendOverlap@ is a 'BlendOverlapEXT' value specifying how the source
    -- and destination sample’s coverage is correlated.
    PipelineColorBlendAdvancedStateCreateInfoEXT -> BlendOverlapEXT
blendOverlap :: BlendOverlapEXT
  }
  deriving (Typeable, PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
(PipelineColorBlendAdvancedStateCreateInfoEXT
 -> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool)
-> (PipelineColorBlendAdvancedStateCreateInfoEXT
    -> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool)
-> Eq PipelineColorBlendAdvancedStateCreateInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
$c/= :: PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
== :: PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
$c== :: PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineColorBlendAdvancedStateCreateInfoEXT)
#endif
deriving instance Show PipelineColorBlendAdvancedStateCreateInfoEXT

instance ToCStruct PipelineColorBlendAdvancedStateCreateInfoEXT where
  withCStruct :: PipelineColorBlendAdvancedStateCreateInfoEXT
-> (Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b)
-> IO b
withCStruct x :: PipelineColorBlendAdvancedStateCreateInfoEXT
x f :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b
f = Int
-> Int
-> (Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b)
 -> IO b)
-> (Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p -> Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p PipelineColorBlendAdvancedStateCreateInfoEXT
x (Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b
f Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p)
  pokeCStruct :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b -> IO b
pokeCStruct p :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p PipelineColorBlendAdvancedStateCreateInfoEXT{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_ADVANCED_STATE_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> 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 PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
srcPremultiplied))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
dstPremultiplied))
    Ptr BlendOverlapEXT -> BlendOverlapEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr BlendOverlapEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr BlendOverlapEXT)) (BlendOverlapEXT
blendOverlap)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_ADVANCED_STATE_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> 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 PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> 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 PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> 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 BlendOverlapEXT -> BlendOverlapEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr BlendOverlapEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr BlendOverlapEXT)) (BlendOverlapEXT
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineColorBlendAdvancedStateCreateInfoEXT where
  peekCStruct :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> IO PipelineColorBlendAdvancedStateCreateInfoEXT
peekCStruct p :: Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p = do
    Bool32
srcPremultiplied <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
    Bool32
dstPremultiplied <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    BlendOverlapEXT
blendOverlap <- Ptr BlendOverlapEXT -> IO BlendOverlapEXT
forall a. Storable a => Ptr a -> IO a
peek @BlendOverlapEXT ((Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
p Ptr PipelineColorBlendAdvancedStateCreateInfoEXT
-> Int -> Ptr BlendOverlapEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr BlendOverlapEXT))
    PipelineColorBlendAdvancedStateCreateInfoEXT
-> IO PipelineColorBlendAdvancedStateCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineColorBlendAdvancedStateCreateInfoEXT
 -> IO PipelineColorBlendAdvancedStateCreateInfoEXT)
-> PipelineColorBlendAdvancedStateCreateInfoEXT
-> IO PipelineColorBlendAdvancedStateCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> BlendOverlapEXT
-> PipelineColorBlendAdvancedStateCreateInfoEXT
PipelineColorBlendAdvancedStateCreateInfoEXT
             (Bool32 -> Bool
bool32ToBool Bool32
srcPremultiplied) (Bool32 -> Bool
bool32ToBool Bool32
dstPremultiplied) BlendOverlapEXT
blendOverlap

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

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


-- | VkBlendOverlapEXT - Enumerant specifying the blend overlap parameter
--
-- = Description
--
-- \'
--
-- +-----------------------------------+--------------------------------------------------------------------------------------+
-- | Overlap Mode                      | Weighting Equations                                                                  |
-- +===================================+======================================================================================+
-- | 'BLEND_OVERLAP_UNCORRELATED_EXT'  | \[                                              \begin{aligned}                      |
-- |                                   |                                                 p_0(A_s,A_d) & = A_sA_d \\           |
-- |                                   |                                                 p_1(A_s,A_d) & = A_s(1-A_d) \\       |
-- |                                   |                                                 p_2(A_s,A_d) & = A_d(1-A_s) \\       |
-- |                                   |                                               \end{aligned}\]                        |
-- +-----------------------------------+--------------------------------------------------------------------------------------+
-- | 'BLEND_OVERLAP_CONJOINT_EXT'      | \[                                              \begin{aligned}                      |
-- |                                   |                                                 p_0(A_s,A_d) & = min(A_s,A_d) \\     |
-- |                                   |                                                 p_1(A_s,A_d) & = max(A_s-A_d,0) \\   |
-- |                                   |                                                 p_2(A_s,A_d) & = max(A_d-A_s,0) \\   |
-- |                                   |                                               \end{aligned}\]                        |
-- +-----------------------------------+--------------------------------------------------------------------------------------+
-- | 'BLEND_OVERLAP_DISJOINT_EXT'      | \[                                              \begin{aligned}                      |
-- |                                   |                                                 p_0(A_s,A_d) & = max(A_s+A_d-1,0) \\ |
-- |                                   |                                                 p_1(A_s,A_d) & = min(A_s,1-A_d) \\   |
-- |                                   |                                                 p_2(A_s,A_d) & = min(A_d,1-A_s) \\   |
-- |                                   |                                               \end{aligned}\]                        |
-- +-----------------------------------+--------------------------------------------------------------------------------------+
--
-- Advanced Blend Overlap Modes
--
-- = See Also
--
-- 'PipelineColorBlendAdvancedStateCreateInfoEXT'
newtype BlendOverlapEXT = BlendOverlapEXT Int32
  deriving newtype (BlendOverlapEXT -> BlendOverlapEXT -> Bool
(BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> (BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> Eq BlendOverlapEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c/= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
== :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c== :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
Eq, Eq BlendOverlapEXT
Eq BlendOverlapEXT =>
(BlendOverlapEXT -> BlendOverlapEXT -> Ordering)
-> (BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> (BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> (BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> (BlendOverlapEXT -> BlendOverlapEXT -> Bool)
-> (BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT)
-> (BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT)
-> Ord BlendOverlapEXT
BlendOverlapEXT -> BlendOverlapEXT -> Bool
BlendOverlapEXT -> BlendOverlapEXT -> Ordering
BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT
$cmin :: BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT
max :: BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT
$cmax :: BlendOverlapEXT -> BlendOverlapEXT -> BlendOverlapEXT
>= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c>= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
> :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c> :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
<= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c<= :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
< :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
$c< :: BlendOverlapEXT -> BlendOverlapEXT -> Bool
compare :: BlendOverlapEXT -> BlendOverlapEXT -> Ordering
$ccompare :: BlendOverlapEXT -> BlendOverlapEXT -> Ordering
$cp1Ord :: Eq BlendOverlapEXT
Ord, Ptr b -> Int -> IO BlendOverlapEXT
Ptr b -> Int -> BlendOverlapEXT -> IO ()
Ptr BlendOverlapEXT -> IO BlendOverlapEXT
Ptr BlendOverlapEXT -> Int -> IO BlendOverlapEXT
Ptr BlendOverlapEXT -> Int -> BlendOverlapEXT -> IO ()
Ptr BlendOverlapEXT -> BlendOverlapEXT -> IO ()
BlendOverlapEXT -> Int
(BlendOverlapEXT -> Int)
-> (BlendOverlapEXT -> Int)
-> (Ptr BlendOverlapEXT -> Int -> IO BlendOverlapEXT)
-> (Ptr BlendOverlapEXT -> Int -> BlendOverlapEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO BlendOverlapEXT)
-> (forall b. Ptr b -> Int -> BlendOverlapEXT -> IO ())
-> (Ptr BlendOverlapEXT -> IO BlendOverlapEXT)
-> (Ptr BlendOverlapEXT -> BlendOverlapEXT -> IO ())
-> Storable BlendOverlapEXT
forall b. Ptr b -> Int -> IO BlendOverlapEXT
forall b. Ptr b -> Int -> BlendOverlapEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr BlendOverlapEXT -> BlendOverlapEXT -> IO ()
$cpoke :: Ptr BlendOverlapEXT -> BlendOverlapEXT -> IO ()
peek :: Ptr BlendOverlapEXT -> IO BlendOverlapEXT
$cpeek :: Ptr BlendOverlapEXT -> IO BlendOverlapEXT
pokeByteOff :: Ptr b -> Int -> BlendOverlapEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> BlendOverlapEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO BlendOverlapEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BlendOverlapEXT
pokeElemOff :: Ptr BlendOverlapEXT -> Int -> BlendOverlapEXT -> IO ()
$cpokeElemOff :: Ptr BlendOverlapEXT -> Int -> BlendOverlapEXT -> IO ()
peekElemOff :: Ptr BlendOverlapEXT -> Int -> IO BlendOverlapEXT
$cpeekElemOff :: Ptr BlendOverlapEXT -> Int -> IO BlendOverlapEXT
alignment :: BlendOverlapEXT -> Int
$calignment :: BlendOverlapEXT -> Int
sizeOf :: BlendOverlapEXT -> Int
$csizeOf :: BlendOverlapEXT -> Int
Storable, BlendOverlapEXT
BlendOverlapEXT -> Zero BlendOverlapEXT
forall a. a -> Zero a
zero :: BlendOverlapEXT
$czero :: BlendOverlapEXT
Zero)

-- | 'BLEND_OVERLAP_UNCORRELATED_EXT' specifies that there is no correlation
-- between the source and destination coverage.
pattern $bBLEND_OVERLAP_UNCORRELATED_EXT :: BlendOverlapEXT
$mBLEND_OVERLAP_UNCORRELATED_EXT :: forall r. BlendOverlapEXT -> (Void# -> r) -> (Void# -> r) -> r
BLEND_OVERLAP_UNCORRELATED_EXT = BlendOverlapEXT 0
-- | 'BLEND_OVERLAP_DISJOINT_EXT' specifies that the source and destination
-- coverage are considered to have minimal overlap.
pattern $bBLEND_OVERLAP_DISJOINT_EXT :: BlendOverlapEXT
$mBLEND_OVERLAP_DISJOINT_EXT :: forall r. BlendOverlapEXT -> (Void# -> r) -> (Void# -> r) -> r
BLEND_OVERLAP_DISJOINT_EXT = BlendOverlapEXT 1
-- | 'BLEND_OVERLAP_CONJOINT_EXT' specifies that the source and destination
-- coverage are considered to have maximal overlap.
pattern $bBLEND_OVERLAP_CONJOINT_EXT :: BlendOverlapEXT
$mBLEND_OVERLAP_CONJOINT_EXT :: forall r. BlendOverlapEXT -> (Void# -> r) -> (Void# -> r) -> r
BLEND_OVERLAP_CONJOINT_EXT = BlendOverlapEXT 2
{-# complete BLEND_OVERLAP_UNCORRELATED_EXT,
             BLEND_OVERLAP_DISJOINT_EXT,
             BLEND_OVERLAP_CONJOINT_EXT :: BlendOverlapEXT #-}

instance Show BlendOverlapEXT where
  showsPrec :: Int -> BlendOverlapEXT -> ShowS
showsPrec p :: Int
p = \case
    BLEND_OVERLAP_UNCORRELATED_EXT -> String -> ShowS
showString "BLEND_OVERLAP_UNCORRELATED_EXT"
    BLEND_OVERLAP_DISJOINT_EXT -> String -> ShowS
showString "BLEND_OVERLAP_DISJOINT_EXT"
    BLEND_OVERLAP_CONJOINT_EXT -> String -> ShowS
showString "BLEND_OVERLAP_CONJOINT_EXT"
    BlendOverlapEXT x :: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "BlendOverlapEXT " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Int32
x)

instance Read BlendOverlapEXT where
  readPrec :: ReadPrec BlendOverlapEXT
readPrec = ReadPrec BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec BlendOverlapEXT)] -> ReadPrec BlendOverlapEXT
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("BLEND_OVERLAP_UNCORRELATED_EXT", BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendOverlapEXT
BLEND_OVERLAP_UNCORRELATED_EXT)
                            , ("BLEND_OVERLAP_DISJOINT_EXT", BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendOverlapEXT
BLEND_OVERLAP_DISJOINT_EXT)
                            , ("BLEND_OVERLAP_CONJOINT_EXT", BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendOverlapEXT
BLEND_OVERLAP_CONJOINT_EXT)]
                     ReadPrec BlendOverlapEXT
-> ReadPrec BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "BlendOverlapEXT")
                       Int32
v <- ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec
                       BlendOverlapEXT -> ReadPrec BlendOverlapEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> BlendOverlapEXT
BlendOverlapEXT Int32
v)))


type EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION"
pattern EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION :: a
$mEXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_BLEND_OPERATION_ADVANCED_SPEC_VERSION = 2


type EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME = "VK_EXT_blend_operation_advanced"

-- No documentation found for TopLevel "VK_EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME"
pattern EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME :: a
$mEXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_BLEND_OPERATION_ADVANCED_EXTENSION_NAME = "VK_EXT_blend_operation_advanced"