{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_shader_demote_to_helper_invocation"
module Vulkan.Core13.Promoted_From_VK_EXT_shader_demote_to_helper_invocation  ( PhysicalDeviceShaderDemoteToHelperInvocationFeatures(..)
                                                                              , StructureType(..)
                                                                              ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_DEMOTE_TO_HELPER_INVOCATION_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceShaderDemoteToHelperInvocationFeatures - Structure
-- describing the shader demote to helper invocations features that can be
-- supported by an implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceShaderDemoteToHelperInvocationFeatures' structure
-- is included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceShaderDemoteToHelperInvocationFeatures' /can/
-- also be used in the @pNext@ chain of
-- 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively enable these
-- features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_shader_demote_to_helper_invocation VK_EXT_shader_demote_to_helper_invocation>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceShaderDemoteToHelperInvocationFeatures = PhysicalDeviceShaderDemoteToHelperInvocationFeatures
  { -- | #extension-features-shaderDemoteToHelperInvocation#
    -- @shaderDemoteToHelperInvocation@ indicates whether the implementation
    -- supports the SPIR-V @DemoteToHelperInvocationEXT@ capability.
    PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
shaderDemoteToHelperInvocation :: Bool }
  deriving (Typeable, PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
(PhysicalDeviceShaderDemoteToHelperInvocationFeatures
 -> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool)
-> (PhysicalDeviceShaderDemoteToHelperInvocationFeatures
    -> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool)
-> Eq PhysicalDeviceShaderDemoteToHelperInvocationFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
$c/= :: PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
== :: PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
$c== :: PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderDemoteToHelperInvocationFeatures)
#endif
deriving instance Show PhysicalDeviceShaderDemoteToHelperInvocationFeatures

instance ToCStruct PhysicalDeviceShaderDemoteToHelperInvocationFeatures where
  withCStruct :: forall b.
PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> (Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
    -> IO b)
-> IO b
withCStruct PhysicalDeviceShaderDemoteToHelperInvocationFeatures
x Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> IO b
f = Int
-> (Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p -> Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p PhysicalDeviceShaderDemoteToHelperInvocationFeatures
x (Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> IO b
f Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p PhysicalDeviceShaderDemoteToHelperInvocationFeatures{Bool
shaderDemoteToHelperInvocation :: Bool
$sel:shaderDemoteToHelperInvocation:PhysicalDeviceShaderDemoteToHelperInvocationFeatures :: PhysicalDeviceShaderDemoteToHelperInvocationFeatures -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_DEMOTE_TO_HELPER_INVOCATION_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderDemoteToHelperInvocation))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_DEMOTE_TO_HELPER_INVOCATION_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
p Ptr PhysicalDeviceShaderDemoteToHelperInvocationFeatures
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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