{-# language CPP #-}
module Vulkan.Core11.Originally_Based_On_VK_KHR_protected_memory  ( getDeviceQueue2
                                                                  , ProtectedSubmitInfo(..)
                                                                  , PhysicalDeviceProtectedMemoryFeatures(..)
                                                                  , PhysicalDeviceProtectedMemoryProperties(..)
                                                                  , DeviceQueueInfo2(..)
                                                                  , StructureType(..)
                                                                  , QueueFlagBits(..)
                                                                  , QueueFlags
                                                                  , DeviceQueueCreateFlagBits(..)
                                                                  , DeviceQueueCreateFlags
                                                                  , MemoryPropertyFlagBits(..)
                                                                  , MemoryPropertyFlags
                                                                  , BufferCreateFlagBits(..)
                                                                  , BufferCreateFlags
                                                                  , ImageCreateFlagBits(..)
                                                                  , ImageCreateFlags
                                                                  , CommandPoolCreateFlagBits(..)
                                                                  , CommandPoolCreateFlags
                                                                  ) where

import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.IO.Class (MonadIO)
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 GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceQueue2))
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlags)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Handles (Queue)
import Vulkan.Core10.Handles (Queue(Queue))
import Vulkan.Core10.Handles (Queue_T)
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_DEVICE_QUEUE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PROTECTED_MEMORY_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PROTECTED_MEMORY_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PROTECTED_SUBMIT_INFO))
import Vulkan.Core10.Enums.BufferCreateFlagBits (BufferCreateFlagBits(..))
import Vulkan.Core10.Enums.BufferCreateFlagBits (BufferCreateFlags)
import Vulkan.Core10.Enums.CommandPoolCreateFlagBits (CommandPoolCreateFlagBits(..))
import Vulkan.Core10.Enums.CommandPoolCreateFlagBits (CommandPoolCreateFlags)
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlagBits(..))
import Vulkan.Core10.Enums.DeviceQueueCreateFlagBits (DeviceQueueCreateFlags)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlagBits(..))
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlags)
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlagBits(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDeviceQueue2
  :: FunPtr (Ptr Device_T -> Ptr DeviceQueueInfo2 -> Ptr (Ptr Queue_T) -> IO ()) -> Ptr Device_T -> Ptr DeviceQueueInfo2 -> Ptr (Ptr Queue_T) -> IO ()

-- | vkGetDeviceQueue2 - Get a queue handle from a device
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'DeviceQueueInfo2',
-- 'Vulkan.Core10.Handles.Queue'
getDeviceQueue2 :: forall io
                 . (MonadIO io)
                => -- | @device@ is the logical device that owns the queue.
                   --
                   -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                   Device
                -> -- | @pQueueInfo@ is a pointer to a 'DeviceQueueInfo2' structure, describing
                   -- the parameters used to create the device queue.
                   --
                   -- @pQueueInfo@ /must/ be a valid pointer to a valid 'DeviceQueueInfo2'
                   -- structure
                   DeviceQueueInfo2
                -> io (Queue)
getDeviceQueue2 :: Device -> DeviceQueueInfo2 -> io Queue
getDeviceQueue2 device :: Device
device queueInfo :: DeviceQueueInfo2
queueInfo = IO Queue -> io Queue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Queue -> io Queue)
-> (ContT Queue IO Queue -> IO Queue)
-> ContT Queue IO Queue
-> io Queue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Queue IO Queue -> IO Queue
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Queue IO Queue -> io Queue)
-> ContT Queue IO Queue -> io Queue
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: DeviceCmds
cmds = Device -> DeviceCmds
deviceCmds (Device
device :: Device)
  let vkGetDeviceQueue2Ptr :: FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
vkGetDeviceQueue2Ptr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
      -> ("pQueue" ::: Ptr (Ptr Queue_T))
      -> IO ())
pVkGetDeviceQueue2 DeviceCmds
cmds
  IO () -> ContT Queue IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Queue IO ()) -> IO () -> ContT Queue IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
vkGetDeviceQueue2Ptr FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
      -> ("pQueue" ::: Ptr (Ptr Queue_T))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetDeviceQueue2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDeviceQueue2' :: Ptr Device_T
-> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> ("pQueue" ::: Ptr (Ptr Queue_T))
-> IO ()
vkGetDeviceQueue2' = FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
-> Ptr Device_T
-> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> ("pQueue" ::: Ptr (Ptr Queue_T))
-> IO ()
mkVkGetDeviceQueue2 FunPtr
  (Ptr Device_T
   -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
   -> ("pQueue" ::: Ptr (Ptr Queue_T))
   -> IO ())
vkGetDeviceQueue2Ptr
  "pQueueInfo" ::: Ptr DeviceQueueInfo2
pQueueInfo <- ((("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO Queue) -> IO Queue)
-> ContT Queue IO ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO Queue)
  -> IO Queue)
 -> ContT Queue IO ("pQueueInfo" ::: Ptr DeviceQueueInfo2))
-> ((("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO Queue)
    -> IO Queue)
-> ContT Queue IO ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
forall a b. (a -> b) -> a -> b
$ DeviceQueueInfo2
-> (("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO Queue)
-> IO Queue
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DeviceQueueInfo2
queueInfo)
  "pQueue" ::: Ptr (Ptr Queue_T)
pPQueue <- ((("pQueue" ::: Ptr (Ptr Queue_T)) -> IO Queue) -> IO Queue)
-> ContT Queue IO ("pQueue" ::: Ptr (Ptr Queue_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pQueue" ::: Ptr (Ptr Queue_T)) -> IO Queue) -> IO Queue)
 -> ContT Queue IO ("pQueue" ::: Ptr (Ptr Queue_T)))
-> ((("pQueue" ::: Ptr (Ptr Queue_T)) -> IO Queue) -> IO Queue)
-> ContT Queue IO ("pQueue" ::: Ptr (Ptr Queue_T))
forall a b. (a -> b) -> a -> b
$ IO ("pQueue" ::: Ptr (Ptr Queue_T))
-> (("pQueue" ::: Ptr (Ptr Queue_T)) -> IO ())
-> (("pQueue" ::: Ptr (Ptr Queue_T)) -> IO Queue)
-> IO Queue
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pQueue" ::: Ptr (Ptr Queue_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Queue_T) 8) ("pQueue" ::: Ptr (Ptr Queue_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  IO () -> ContT Queue IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Queue IO ()) -> IO () -> ContT Queue IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> ("pQueue" ::: Ptr (Ptr Queue_T))
-> IO ()
vkGetDeviceQueue2' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pQueueInfo" ::: Ptr DeviceQueueInfo2
pQueueInfo ("pQueue" ::: Ptr (Ptr Queue_T)
pPQueue)
  Ptr Queue_T
pQueue <- IO (Ptr Queue_T) -> ContT Queue IO (Ptr Queue_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Queue_T) -> ContT Queue IO (Ptr Queue_T))
-> IO (Ptr Queue_T) -> ContT Queue IO (Ptr Queue_T)
forall a b. (a -> b) -> a -> b
$ ("pQueue" ::: Ptr (Ptr Queue_T)) -> IO (Ptr Queue_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Queue_T) "pQueue" ::: Ptr (Ptr Queue_T)
pPQueue
  Queue -> ContT Queue IO Queue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Queue -> ContT Queue IO Queue) -> Queue -> ContT Queue IO Queue
forall a b. (a -> b) -> a -> b
$ (((\h :: Ptr Queue_T
h -> Ptr Queue_T -> DeviceCmds -> Queue
Queue Ptr Queue_T
h DeviceCmds
cmds ) Ptr Queue_T
pQueue))


-- | VkProtectedSubmitInfo - Structure indicating whether the submission is
-- protected
--
-- == Valid Usage
--
-- -   If the protected memory feature is not enabled, @protectedSubmit@
--     /must/ not be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PROTECTED_SUBMIT_INFO'
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ProtectedSubmitInfo = ProtectedSubmitInfo
  { -- | @protectedSubmit@ specifies whether the batch is protected. If
    -- @protectedSubmit@ is 'Vulkan.Core10.FundamentalTypes.TRUE', the batch is
    -- protected. If @protectedSubmit@ is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', the batch is unprotected. If the
    -- 'Vulkan.Core10.Queue.SubmitInfo'::@pNext@ chain does not include this
    -- structure, the batch is unprotected.
    ProtectedSubmitInfo -> Bool
protectedSubmit :: Bool }
  deriving (Typeable, ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool
(ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool)
-> (ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool)
-> Eq ProtectedSubmitInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool
$c/= :: ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool
== :: ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool
$c== :: ProtectedSubmitInfo -> ProtectedSubmitInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ProtectedSubmitInfo)
#endif
deriving instance Show ProtectedSubmitInfo

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

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

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


-- | VkPhysicalDeviceProtectedMemoryFeatures - Structure describing protected
-- memory features that can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceProtectedMemoryFeatures' structure is included in
-- the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
-- it is filled with a value indicating whether the feature is supported.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceProtectedMemoryFeatures = PhysicalDeviceProtectedMemoryFeatures
  { -- | @protectedMemory@ specifies whether protected memory is supported.
    PhysicalDeviceProtectedMemoryFeatures -> Bool
protectedMemory :: Bool }
  deriving (Typeable, PhysicalDeviceProtectedMemoryFeatures
-> PhysicalDeviceProtectedMemoryFeatures -> Bool
(PhysicalDeviceProtectedMemoryFeatures
 -> PhysicalDeviceProtectedMemoryFeatures -> Bool)
-> (PhysicalDeviceProtectedMemoryFeatures
    -> PhysicalDeviceProtectedMemoryFeatures -> Bool)
-> Eq PhysicalDeviceProtectedMemoryFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceProtectedMemoryFeatures
-> PhysicalDeviceProtectedMemoryFeatures -> Bool
$c/= :: PhysicalDeviceProtectedMemoryFeatures
-> PhysicalDeviceProtectedMemoryFeatures -> Bool
== :: PhysicalDeviceProtectedMemoryFeatures
-> PhysicalDeviceProtectedMemoryFeatures -> Bool
$c== :: PhysicalDeviceProtectedMemoryFeatures
-> PhysicalDeviceProtectedMemoryFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceProtectedMemoryFeatures)
#endif
deriving instance Show PhysicalDeviceProtectedMemoryFeatures

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

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

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


-- | VkPhysicalDeviceProtectedMemoryProperties - Structure describing
-- protected memory properties that can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceProtectedMemoryProperties' structure is included
-- in the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2',
-- it is filled with a value indicating the implementation-dependent
-- behavior.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceProtectedMemoryProperties = PhysicalDeviceProtectedMemoryProperties
  { -- | @protectedNoFault@ specifies the behavior of the implementation when
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-protected-access-rules protected memory access rules>
    -- are broken. If @protectedNoFault@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE', breaking those rules will not
    -- result in process termination or device loss.
    PhysicalDeviceProtectedMemoryProperties -> Bool
protectedNoFault :: Bool }
  deriving (Typeable, PhysicalDeviceProtectedMemoryProperties
-> PhysicalDeviceProtectedMemoryProperties -> Bool
(PhysicalDeviceProtectedMemoryProperties
 -> PhysicalDeviceProtectedMemoryProperties -> Bool)
-> (PhysicalDeviceProtectedMemoryProperties
    -> PhysicalDeviceProtectedMemoryProperties -> Bool)
-> Eq PhysicalDeviceProtectedMemoryProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceProtectedMemoryProperties
-> PhysicalDeviceProtectedMemoryProperties -> Bool
$c/= :: PhysicalDeviceProtectedMemoryProperties
-> PhysicalDeviceProtectedMemoryProperties -> Bool
== :: PhysicalDeviceProtectedMemoryProperties
-> PhysicalDeviceProtectedMemoryProperties -> Bool
$c== :: PhysicalDeviceProtectedMemoryProperties
-> PhysicalDeviceProtectedMemoryProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceProtectedMemoryProperties)
#endif
deriving instance Show PhysicalDeviceProtectedMemoryProperties

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

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

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


-- | VkDeviceQueueInfo2 - Structure specifying the parameters used for device
-- queue creation
--
-- = Description
--
-- The queue returned by 'getDeviceQueue2' /must/ have the same @flags@
-- value from this structure as that used at device creation time in a
-- 'Vulkan.Core10.Device.DeviceQueueCreateInfo' instance. If no matching
-- @flags@ were specified at device creation time, then the handle returned
-- in @pQueue@ /must/ be @NULL@.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'getDeviceQueue2'
data DeviceQueueInfo2 = DeviceQueueInfo2
  { -- | @flags@ is a
    -- 'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlags'
    -- value indicating the flags used to create the device queue.
    --
    -- @flags@ /must/ be a valid combination of
    -- 'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlagBits'
    -- values
    DeviceQueueInfo2 -> DeviceQueueCreateFlags
flags :: DeviceQueueCreateFlags
  , -- | @queueFamilyIndex@ is the index of the queue family to which the queue
    -- belongs.
    --
    -- @queueFamilyIndex@ /must/ be one of the queue family indices specified
    -- when @device@ was created, via the
    -- 'Vulkan.Core10.Device.DeviceQueueCreateInfo' structure
    DeviceQueueInfo2 -> Word32
queueFamilyIndex :: Word32
  , -- | @queueIndex@ is the index within this queue family of the queue to
    -- retrieve.
    --
    -- @queueIndex@ /must/ be less than the number of queues created for the
    -- specified queue family index and
    -- 'Vulkan.Core10.Enums.DeviceQueueCreateFlagBits.DeviceQueueCreateFlags'
    -- member @flags@ equal to this @flags@ value when @device@ was created,
    -- via the @queueCount@ member of the
    -- 'Vulkan.Core10.Device.DeviceQueueCreateInfo' structure
    DeviceQueueInfo2 -> Word32
queueIndex :: Word32
  }
  deriving (Typeable, DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool
(DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool)
-> (DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool)
-> Eq DeviceQueueInfo2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool
$c/= :: DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool
== :: DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool
$c== :: DeviceQueueInfo2 -> DeviceQueueInfo2 -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DeviceQueueInfo2)
#endif
deriving instance Show DeviceQueueInfo2

instance ToCStruct DeviceQueueInfo2 where
  withCStruct :: DeviceQueueInfo2
-> (("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b) -> IO b
withCStruct x :: DeviceQueueInfo2
x f :: ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b
f = Int
-> Int -> (("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b) -> IO b)
-> (("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pQueueInfo" ::: Ptr DeviceQueueInfo2
p -> ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> DeviceQueueInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pQueueInfo" ::: Ptr DeviceQueueInfo2
p DeviceQueueInfo2
x (("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b
f "pQueueInfo" ::: Ptr DeviceQueueInfo2
p)
  pokeCStruct :: ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> DeviceQueueInfo2 -> IO b -> IO b
pokeCStruct p :: "pQueueInfo" ::: Ptr DeviceQueueInfo2
p DeviceQueueInfo2{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_QUEUE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceQueueCreateFlags -> DeviceQueueCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> Int -> Ptr DeviceQueueCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceQueueCreateFlags)) (DeviceQueueCreateFlags
flags)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) (Word32
queueFamilyIndex)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
queueIndex)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO b -> IO b
pokeZeroCStruct p :: "pQueueInfo" ::: Ptr DeviceQueueInfo2
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEVICE_QUEUE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DeviceQueueInfo2 where
  peekCStruct :: ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> IO DeviceQueueInfo2
peekCStruct p :: "pQueueInfo" ::: Ptr DeviceQueueInfo2
p = do
    DeviceQueueCreateFlags
flags <- Ptr DeviceQueueCreateFlags -> IO DeviceQueueCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @DeviceQueueCreateFlags (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2)
-> Int -> Ptr DeviceQueueCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr DeviceQueueCreateFlags))
    Word32
queueFamilyIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Word32))
    Word32
queueIndex <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueInfo" ::: Ptr DeviceQueueInfo2
p ("pQueueInfo" ::: Ptr DeviceQueueInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    DeviceQueueInfo2 -> IO DeviceQueueInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeviceQueueInfo2 -> IO DeviceQueueInfo2)
-> DeviceQueueInfo2 -> IO DeviceQueueInfo2
forall a b. (a -> b) -> a -> b
$ DeviceQueueCreateFlags -> Word32 -> Word32 -> DeviceQueueInfo2
DeviceQueueInfo2
             DeviceQueueCreateFlags
flags Word32
queueFamilyIndex Word32
queueIndex

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

instance Zero DeviceQueueInfo2 where
  zero :: DeviceQueueInfo2
zero = DeviceQueueCreateFlags -> Word32 -> Word32 -> DeviceQueueInfo2
DeviceQueueInfo2
           DeviceQueueCreateFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero