{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_zero_initialize_workgroup_memory"
module Vulkan.Core13.Promoted_From_VK_KHR_zero_initialize_workgroup_memory  ( PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures(..)
                                                                            , 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_ZERO_INITIALIZE_WORKGROUP_MEMORY_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceZeroInitializeWorkgroupMemoryFeatures - Structure
-- describing support for zero initialization of workgroup memory by an
-- implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures' 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. 'PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures' /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_KHR_zero_initialize_workgroup_memory VK_KHR_zero_initialize_workgroup_memory>,
-- <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 PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures = PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
  { -- | #extension-features-shaderZeroInitializeWorkgroupMemory#
    -- @shaderZeroInitializeWorkgroupMemory@ specifies whether the
    -- implementation supports initializing a variable in Workgroup storage
    -- class.
    PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
shaderZeroInitializeWorkgroupMemory :: Bool }
  deriving (Typeable, PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
-> PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
-> PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
$c/= :: PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
-> PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
== :: PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
-> PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
$c== :: PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures
-> PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures)
#endif
deriving instance Show PhysicalDeviceZeroInitializeWorkgroupMemoryFeatures

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

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

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