{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_KHR_vulkan_memory_model  ( PhysicalDeviceVulkanMemoryModelFeatures(..)
                                                               , 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_VULKAN_MEMORY_MODEL_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceVulkanMemoryModelFeatures - Structure describing
-- features supported by the memory model
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceVulkanMemoryModelFeatures = PhysicalDeviceVulkanMemoryModelFeatures
  { -- | @vulkanMemoryModel@ indicates whether the Vulkan Memory Model is
    -- supported, as defined in
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-model Vulkan Memory Model>.
    -- This also indicates whether shader modules /can/ declare the
    -- @VulkanMemoryModel@ capability.
    PhysicalDeviceVulkanMemoryModelFeatures -> Bool
vulkanMemoryModel :: Bool
  , -- | @vulkanMemoryModelDeviceScope@ indicates whether the Vulkan Memory Model
    -- can use 'Vulkan.Core10.Handles.Device' scope synchronization. This also
    -- indicates whether shader modules /can/ declare the
    -- @VulkanMemoryModelDeviceScope@ capability.
    PhysicalDeviceVulkanMemoryModelFeatures -> Bool
vulkanMemoryModelDeviceScope :: Bool
  , -- | @vulkanMemoryModelAvailabilityVisibilityChains@ indicates whether the
    -- Vulkan Memory Model can use
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-model-availability-visibility availability and visibility chains>
    -- with more than one element.
    PhysicalDeviceVulkanMemoryModelFeatures -> Bool
vulkanMemoryModelAvailabilityVisibilityChains :: Bool
  }
  deriving (Typeable, PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> Bool
(PhysicalDeviceVulkanMemoryModelFeatures
 -> PhysicalDeviceVulkanMemoryModelFeatures -> Bool)
-> (PhysicalDeviceVulkanMemoryModelFeatures
    -> PhysicalDeviceVulkanMemoryModelFeatures -> Bool)
-> Eq PhysicalDeviceVulkanMemoryModelFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> Bool
$c/= :: PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> Bool
== :: PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> Bool
$c== :: PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceVulkanMemoryModelFeatures)
#endif
deriving instance Show PhysicalDeviceVulkanMemoryModelFeatures

instance ToCStruct PhysicalDeviceVulkanMemoryModelFeatures where
  withCStruct :: PhysicalDeviceVulkanMemoryModelFeatures
-> (Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b) -> IO b
withCStruct x :: PhysicalDeviceVulkanMemoryModelFeatures
x f :: Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceVulkanMemoryModelFeatures
p -> Ptr PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceVulkanMemoryModelFeatures
p PhysicalDeviceVulkanMemoryModelFeatures
x (Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b
f Ptr PhysicalDeviceVulkanMemoryModelFeatures
p)
  pokeCStruct :: Ptr PhysicalDeviceVulkanMemoryModelFeatures
-> PhysicalDeviceVulkanMemoryModelFeatures -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceVulkanMemoryModelFeatures
p PhysicalDeviceVulkanMemoryModelFeatures{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_VULKAN_MEMORY_MODEL_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> 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 PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vulkanMemoryModel))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vulkanMemoryModelDeviceScope))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vulkanMemoryModelAvailabilityVisibilityChains))
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDeviceVulkanMemoryModelFeatures -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceVulkanMemoryModelFeatures
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_VULKAN_MEMORY_MODEL_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> 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 PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 PhysicalDeviceVulkanMemoryModelFeatures
p Ptr PhysicalDeviceVulkanMemoryModelFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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