{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_EXT_scalar_block_layout  ( PhysicalDeviceScalarBlockLayoutFeatures(..)
                                                               , StructureType(..)
                                                               ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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.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.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SCALAR_BLOCK_LAYOUT_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceScalarBlockLayoutFeatures - Structure indicating support
-- for scalar block layouts
--
-- = Members
--
-- The members of the 'PhysicalDeviceScalarBlockLayoutFeatures' structure
-- describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceScalarBlockLayoutFeatures' 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 the feature is supported.
-- 'PhysicalDeviceScalarBlockLayoutFeatures' /can/ also be included in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to enable this
-- feature.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceScalarBlockLayoutFeatures = PhysicalDeviceScalarBlockLayoutFeatures
  { -- | @scalarBlockLayout@ indicates that the implementation supports the
    -- layout of resource blocks in shaders using
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#interfaces-alignment-requirements scalar alignment>.
    PhysicalDeviceScalarBlockLayoutFeatures -> Bool
scalarBlockLayout :: Bool }
  deriving (Typeable, PhysicalDeviceScalarBlockLayoutFeatures
-> PhysicalDeviceScalarBlockLayoutFeatures -> Bool
(PhysicalDeviceScalarBlockLayoutFeatures
 -> PhysicalDeviceScalarBlockLayoutFeatures -> Bool)
-> (PhysicalDeviceScalarBlockLayoutFeatures
    -> PhysicalDeviceScalarBlockLayoutFeatures -> Bool)
-> Eq PhysicalDeviceScalarBlockLayoutFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceScalarBlockLayoutFeatures
-> PhysicalDeviceScalarBlockLayoutFeatures -> Bool
$c/= :: PhysicalDeviceScalarBlockLayoutFeatures
-> PhysicalDeviceScalarBlockLayoutFeatures -> Bool
== :: PhysicalDeviceScalarBlockLayoutFeatures
-> PhysicalDeviceScalarBlockLayoutFeatures -> Bool
$c== :: PhysicalDeviceScalarBlockLayoutFeatures
-> PhysicalDeviceScalarBlockLayoutFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceScalarBlockLayoutFeatures)
#endif
deriving instance Show PhysicalDeviceScalarBlockLayoutFeatures

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

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

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