{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_pipeline_creation_cache_control"
module Vulkan.Core13.Promoted_From_VK_EXT_pipeline_creation_cache_control  ( PhysicalDevicePipelineCreationCacheControlFeatures(..)
                                                                           , PipelineCacheCreateFlagBits(..)
                                                                           , PipelineCacheCreateFlags
                                                                           , StructureType(..)
                                                                           , Result(..)
                                                                           , PipelineCreateFlagBits(..)
                                                                           , PipelineCreateFlags
                                                                           ) 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_PIPELINE_CREATION_CACHE_CONTROL_FEATURES))
import Vulkan.Core10.Enums.PipelineCacheCreateFlagBits (PipelineCacheCreateFlagBits(..))
import Vulkan.Core10.Enums.PipelineCacheCreateFlagBits (PipelineCacheCreateFlags)
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlagBits(..))
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDevicePipelineCreationCacheControlFeatures - Structure
-- describing whether pipeline cache control can be supported by an
-- implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDevicePipelineCreationCacheControlFeatures' 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. 'PhysicalDevicePipelineCreationCacheControlFeatures' /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_EXT_pipeline_creation_cache_control VK_EXT_pipeline_creation_cache_control>,
-- <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 PhysicalDevicePipelineCreationCacheControlFeatures = PhysicalDevicePipelineCreationCacheControlFeatures
  { -- | #extension-features-pipelineCreationCacheControl#
    -- @pipelineCreationCacheControl@ indicates that the implementation
    -- supports:
    --
    -- -   The following /can/ be used in @Vk*PipelineCreateInfo@::@flags@:
    --
    --     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_FAIL_ON_PIPELINE_COMPILE_REQUIRED_BIT'
    --
    --     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_EARLY_RETURN_ON_FAILURE_BIT'
    --
    -- -   The following /can/ be used in
    --     'Vulkan.Core10.PipelineCache.PipelineCacheCreateInfo'::@flags@:
    --
    --     -   'Vulkan.Core10.Enums.PipelineCacheCreateFlagBits.PIPELINE_CACHE_CREATE_EXTERNALLY_SYNCHRONIZED_BIT'
    PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
pipelineCreationCacheControl :: Bool }
  deriving (Typeable, PhysicalDevicePipelineCreationCacheControlFeatures
-> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
(PhysicalDevicePipelineCreationCacheControlFeatures
 -> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool)
-> (PhysicalDevicePipelineCreationCacheControlFeatures
    -> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool)
-> Eq PhysicalDevicePipelineCreationCacheControlFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePipelineCreationCacheControlFeatures
-> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
$c/= :: PhysicalDevicePipelineCreationCacheControlFeatures
-> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
== :: PhysicalDevicePipelineCreationCacheControlFeatures
-> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
$c== :: PhysicalDevicePipelineCreationCacheControlFeatures
-> PhysicalDevicePipelineCreationCacheControlFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePipelineCreationCacheControlFeatures)
#endif
deriving instance Show PhysicalDevicePipelineCreationCacheControlFeatures

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

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

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

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