{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_8bit_storage"
module Vulkan.Core12.Promoted_From_VK_KHR_8bit_storage  ( PhysicalDevice8BitStorageFeatures(..)
                                                        , 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_8BIT_STORAGE_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDevice8BitStorageFeatures - Structure describing features
-- supported by VK_KHR_8bit_storage
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDevice8BitStorageFeatures' 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. 'PhysicalDevice8BitStorageFeatures' /can/ also be used in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively
-- enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevice8BitStorageFeatures = PhysicalDevice8BitStorageFeatures
  { -- | #extension-features-storageBuffer8BitAccess# @storageBuffer8BitAccess@
    -- indicates whether objects in the @StorageBuffer@,
    -- @ShaderRecordBufferKHR@, or @PhysicalStorageBuffer@ storage class with
    -- the @Block@ decoration /can/ have 8-bit integer members. If this feature
    -- is not enabled, 8-bit integer members /must/ not be used in such
    -- objects. This also indicates whether shader modules /can/ declare the
    -- @StorageBuffer8BitAccess@ capability.
    PhysicalDevice8BitStorageFeatures -> Bool
storageBuffer8BitAccess :: Bool
  , -- | #extension-features-uniformAndStorageBuffer8BitAccess#
    -- @uniformAndStorageBuffer8BitAccess@ indicates whether objects in the
    -- @Uniform@ storage class with the @Block@ decoration /can/ have 8-bit
    -- integer members. If this feature is not enabled, 8-bit integer members
    -- /must/ not be used in such objects. This also indicates whether shader
    -- modules /can/ declare the @UniformAndStorageBuffer8BitAccess@
    -- capability.
    PhysicalDevice8BitStorageFeatures -> Bool
uniformAndStorageBuffer8BitAccess :: Bool
  , -- | #extension-features-storagePushConstant8# @storagePushConstant8@
    -- indicates whether objects in the @PushConstant@ storage class /can/ have
    -- 8-bit integer members. If this feature is not enabled, 8-bit integer
    -- members /must/ not be used in such objects. This also indicates whether
    -- shader modules /can/ declare the @StoragePushConstant8@ capability.
    PhysicalDevice8BitStorageFeatures -> Bool
storagePushConstant8 :: Bool
  }
  deriving (Typeable, PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> Bool
(PhysicalDevice8BitStorageFeatures
 -> PhysicalDevice8BitStorageFeatures -> Bool)
-> (PhysicalDevice8BitStorageFeatures
    -> PhysicalDevice8BitStorageFeatures -> Bool)
-> Eq PhysicalDevice8BitStorageFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> Bool
$c/= :: PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> Bool
== :: PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> Bool
$c== :: PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevice8BitStorageFeatures)
#endif
deriving instance Show PhysicalDevice8BitStorageFeatures

instance ToCStruct PhysicalDevice8BitStorageFeatures where
  withCStruct :: PhysicalDevice8BitStorageFeatures
-> (Ptr PhysicalDevice8BitStorageFeatures -> IO b) -> IO b
withCStruct PhysicalDevice8BitStorageFeatures
x Ptr PhysicalDevice8BitStorageFeatures -> IO b
f = Int -> (Ptr PhysicalDevice8BitStorageFeatures -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr PhysicalDevice8BitStorageFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDevice8BitStorageFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevice8BitStorageFeatures
p -> Ptr PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevice8BitStorageFeatures
p PhysicalDevice8BitStorageFeatures
x (Ptr PhysicalDevice8BitStorageFeatures -> IO b
f Ptr PhysicalDevice8BitStorageFeatures
p)
  pokeCStruct :: Ptr PhysicalDevice8BitStorageFeatures
-> PhysicalDevice8BitStorageFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDevice8BitStorageFeatures
p PhysicalDevice8BitStorageFeatures{Bool
storagePushConstant8 :: Bool
uniformAndStorageBuffer8BitAccess :: Bool
storageBuffer8BitAccess :: Bool
$sel:storagePushConstant8:PhysicalDevice8BitStorageFeatures :: PhysicalDevice8BitStorageFeatures -> Bool
$sel:uniformAndStorageBuffer8BitAccess:PhysicalDevice8BitStorageFeatures :: PhysicalDevice8BitStorageFeatures -> Bool
$sel:storageBuffer8BitAccess:PhysicalDevice8BitStorageFeatures :: PhysicalDevice8BitStorageFeatures -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_8BIT_STORAGE_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> 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 PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
storageBuffer8BitAccess))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
uniformAndStorageBuffer8BitAccess))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
storagePushConstant8))
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDevice8BitStorageFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevice8BitStorageFeatures
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_8BIT_STORAGE_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> 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 PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 PhysicalDevice8BitStorageFeatures
p Ptr PhysicalDevice8BitStorageFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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