{-# language CPP #-}
module Vulkan.Core13.Promoted_From_VK_KHR_shader_terminate_invocation ( PhysicalDeviceShaderTerminateInvocationFeatures(..)
, 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_TERMINATE_INVOCATION_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
data PhysicalDeviceShaderTerminateInvocationFeatures = PhysicalDeviceShaderTerminateInvocationFeatures
{
PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
shaderTerminateInvocation :: Bool }
deriving (Typeable, PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
$c/= :: PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
== :: PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
$c== :: PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceShaderTerminateInvocationFeatures)
#endif
deriving instance Show PhysicalDeviceShaderTerminateInvocationFeatures
instance ToCStruct PhysicalDeviceShaderTerminateInvocationFeatures where
withCStruct :: forall b.
PhysicalDeviceShaderTerminateInvocationFeatures
-> (Ptr PhysicalDeviceShaderTerminateInvocationFeatures -> IO b)
-> IO b
withCStruct PhysicalDeviceShaderTerminateInvocationFeatures
x Ptr PhysicalDeviceShaderTerminateInvocationFeatures -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p PhysicalDeviceShaderTerminateInvocationFeatures
x (Ptr PhysicalDeviceShaderTerminateInvocationFeatures -> IO b
f Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p PhysicalDeviceShaderTerminateInvocationFeatures{Bool
shaderTerminateInvocation :: Bool
$sel:shaderTerminateInvocation:PhysicalDeviceShaderTerminateInvocationFeatures :: PhysicalDeviceShaderTerminateInvocationFeatures -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_TERMINATE_INVOCATION_FEATURES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderTerminateInvocation))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceShaderTerminateInvocationFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_TERMINATE_INVOCATION_FEATURES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceShaderTerminateInvocationFeatures where
peekCStruct :: Ptr PhysicalDeviceShaderTerminateInvocationFeatures
-> IO PhysicalDeviceShaderTerminateInvocationFeatures
peekCStruct Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p = do
Bool32
shaderTerminateInvocation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceShaderTerminateInvocationFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceShaderTerminateInvocationFeatures
PhysicalDeviceShaderTerminateInvocationFeatures
(Bool32 -> Bool
bool32ToBool Bool32
shaderTerminateInvocation)
instance Storable PhysicalDeviceShaderTerminateInvocationFeatures where
sizeOf :: PhysicalDeviceShaderTerminateInvocationFeatures -> Int
sizeOf ~PhysicalDeviceShaderTerminateInvocationFeatures
_ = Int
24
alignment :: PhysicalDeviceShaderTerminateInvocationFeatures -> Int
alignment ~PhysicalDeviceShaderTerminateInvocationFeatures
_ = Int
8
peek :: Ptr PhysicalDeviceShaderTerminateInvocationFeatures
-> IO PhysicalDeviceShaderTerminateInvocationFeatures
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceShaderTerminateInvocationFeatures
-> PhysicalDeviceShaderTerminateInvocationFeatures -> IO ()
poke Ptr PhysicalDeviceShaderTerminateInvocationFeatures
ptr PhysicalDeviceShaderTerminateInvocationFeatures
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceShaderTerminateInvocationFeatures
ptr PhysicalDeviceShaderTerminateInvocationFeatures
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceShaderTerminateInvocationFeatures where
zero :: PhysicalDeviceShaderTerminateInvocationFeatures
zero = Bool -> PhysicalDeviceShaderTerminateInvocationFeatures
PhysicalDeviceShaderTerminateInvocationFeatures
forall a. Zero a => a
zero