{-# language CPP #-}
module Vulkan.Core10.Buffer  ( createBuffer
                             , withBuffer
                             , destroyBuffer
                             , BufferCreateInfo(..)
                             , Buffer(..)
                             , SharingMode(..)
                             , BufferUsageFlagBits(..)
                             , BufferUsageFlags
                             , BufferCreateFlagBits(..)
                             , BufferCreateFlags
                             ) where

import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
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 Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
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 Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Handles (Buffer)
import Vulkan.Core10.Handles (Buffer(..))
import Vulkan.Core10.Enums.BufferCreateFlagBits (BufferCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_buffer_device_address (BufferDeviceAddressCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address (BufferOpaqueCaptureAddressCreateInfo)
import Vulkan.Core10.Enums.BufferUsageFlagBits (BufferUsageFlags)
import Vulkan.CStruct.Extends (Chain)
import {-# SOURCE #-} Vulkan.Extensions.VK_NV_dedicated_allocation (DedicatedAllocationBufferCreateInfoNV)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkCreateBuffer))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyBuffer))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_external_memory (ExternalMemoryBufferCreateInfo)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SharingMode (SharingMode)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BUFFER_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (Buffer(..))
import Vulkan.Core10.Enums.BufferCreateFlagBits (BufferCreateFlagBits(..))
import Vulkan.Core10.Enums.BufferCreateFlagBits (BufferCreateFlags)
import Vulkan.Core10.Enums.BufferUsageFlagBits (BufferUsageFlagBits(..))
import Vulkan.Core10.Enums.BufferUsageFlagBits (BufferUsageFlags)
import Vulkan.Core10.Enums.SharingMode (SharingMode(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateBuffer
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct BufferCreateInfo) -> Ptr AllocationCallbacks -> Ptr Buffer -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct BufferCreateInfo) -> Ptr AllocationCallbacks -> Ptr Buffer -> IO Result

-- | vkCreateBuffer - Create a new buffer object
--
-- == Valid Usage
--
-- -   If the @flags@ member of @pCreateInfo@ includes
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT',
--     creating this 'Vulkan.Core10.Handles.Buffer' /must/ not cause the
--     total required sparse memory for all currently valid sparse
--     resources on the device to exceed
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@sparseAddressSpaceSize@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'BufferCreateInfo' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pBuffer@ /must/ be a valid pointer to a
--     'Vulkan.Core10.Handles.Buffer' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Extensions.VK_KHR_buffer_device_address.ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS_KHR'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Buffer', 'BufferCreateInfo',
-- 'Vulkan.Core10.Handles.Device'
createBuffer :: forall a io
              . (Extendss BufferCreateInfo a, PokeChain a, MonadIO io)
             => -- | @device@ is the logical device that creates the buffer object.
                Device
             -> -- | @pCreateInfo@ is a pointer to a 'BufferCreateInfo' structure containing
                -- parameters affecting creation of the buffer.
                (BufferCreateInfo a)
             -> -- | @pAllocator@ controls host memory allocation as described in the
                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                -- chapter.
                ("allocator" ::: Maybe AllocationCallbacks)
             -> io (Buffer)
createBuffer :: Device
-> BufferCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Buffer
createBuffer device :: Device
device createInfo :: BufferCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Buffer -> io Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> io Buffer)
-> (ContT Buffer IO Buffer -> IO Buffer)
-> ContT Buffer IO Buffer
-> io Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Buffer IO Buffer -> IO Buffer
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Buffer IO Buffer -> io Buffer)
-> ContT Buffer IO Buffer -> io Buffer
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateBufferPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
vkCreateBufferPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pBuffer" ::: Ptr Buffer)
      -> IO Result)
pVkCreateBuffer (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Buffer IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Buffer IO ()) -> IO () -> ContT Buffer IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
vkCreateBufferPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pBuffer" ::: Ptr Buffer)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
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 vkCreateBuffer is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateBuffer' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pBuffer" ::: Ptr Buffer)
-> IO Result
vkCreateBuffer' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pBuffer" ::: Ptr Buffer)
-> IO Result
mkVkCreateBuffer FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pBuffer" ::: Ptr Buffer)
   -> IO Result)
vkCreateBufferPtr
  Ptr (BufferCreateInfo a)
pCreateInfo <- ((Ptr (BufferCreateInfo a) -> IO Buffer) -> IO Buffer)
-> ContT Buffer IO (Ptr (BufferCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (BufferCreateInfo a) -> IO Buffer) -> IO Buffer)
 -> ContT Buffer IO (Ptr (BufferCreateInfo a)))
-> ((Ptr (BufferCreateInfo a) -> IO Buffer) -> IO Buffer)
-> ContT Buffer IO (Ptr (BufferCreateInfo a))
forall a b. (a -> b) -> a -> b
$ BufferCreateInfo a
-> (Ptr (BufferCreateInfo a) -> IO Buffer) -> IO Buffer
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (BufferCreateInfo a
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Buffer IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Buffer)
 -> IO Buffer)
-> ContT Buffer IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Buffer)
  -> IO Buffer)
 -> ContT Buffer IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Buffer)
    -> IO Buffer)
-> ContT Buffer IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Buffer)
-> IO Buffer
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pBuffer" ::: Ptr Buffer
pPBuffer <- ((("pBuffer" ::: Ptr Buffer) -> IO Buffer) -> IO Buffer)
-> ContT Buffer IO ("pBuffer" ::: Ptr Buffer)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBuffer" ::: Ptr Buffer) -> IO Buffer) -> IO Buffer)
 -> ContT Buffer IO ("pBuffer" ::: Ptr Buffer))
-> ((("pBuffer" ::: Ptr Buffer) -> IO Buffer) -> IO Buffer)
-> ContT Buffer IO ("pBuffer" ::: Ptr Buffer)
forall a b. (a -> b) -> a -> b
$ IO ("pBuffer" ::: Ptr Buffer)
-> (("pBuffer" ::: Ptr Buffer) -> IO ())
-> (("pBuffer" ::: Ptr Buffer) -> IO Buffer)
-> IO Buffer
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pBuffer" ::: Ptr Buffer)
forall a. Int -> IO (Ptr a)
callocBytes @Buffer 8) ("pBuffer" ::: Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Buffer IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Buffer IO Result)
-> IO Result -> ContT Buffer IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pBuffer" ::: Ptr Buffer)
-> IO Result
vkCreateBuffer' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (BufferCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct BufferCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (BufferCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pBuffer" ::: Ptr Buffer
pPBuffer)
  IO () -> ContT Buffer IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Buffer IO ()) -> IO () -> ContT Buffer IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Buffer
pBuffer <- IO Buffer -> ContT Buffer IO Buffer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Buffer -> ContT Buffer IO Buffer)
-> IO Buffer -> ContT Buffer IO Buffer
forall a b. (a -> b) -> a -> b
$ ("pBuffer" ::: Ptr Buffer) -> IO Buffer
forall a. Storable a => Ptr a -> IO a
peek @Buffer "pBuffer" ::: Ptr Buffer
pPBuffer
  Buffer -> ContT Buffer IO Buffer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Buffer -> ContT Buffer IO Buffer)
-> Buffer -> ContT Buffer IO Buffer
forall a b. (a -> b) -> a -> b
$ (Buffer
pBuffer)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createBuffer' and 'destroyBuffer'
--
-- To ensure that 'destroyBuffer' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withBuffer :: forall a io r . (Extendss BufferCreateInfo a, PokeChain a, MonadIO io) => Device -> BufferCreateInfo a -> Maybe AllocationCallbacks -> (io (Buffer) -> ((Buffer) -> io ()) -> r) -> r
withBuffer :: Device
-> BufferCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Buffer -> (Buffer -> io ()) -> r)
-> r
withBuffer device :: Device
device pCreateInfo :: BufferCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Buffer -> (Buffer -> io ()) -> r
b =
  io Buffer -> (Buffer -> io ()) -> r
b (Device
-> BufferCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Buffer
forall (a :: [*]) (io :: * -> *).
(Extendss BufferCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> BufferCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io Buffer
createBuffer Device
device BufferCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(Buffer
o0) -> Device
-> Buffer -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> Buffer -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyBuffer Device
device Buffer
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDestroyBuffer
  :: FunPtr (Ptr Device_T -> Buffer -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> Buffer -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyBuffer - Destroy a buffer object
--
-- == Valid Usage
--
-- -   All submitted commands that refer to @buffer@, either directly or
--     via a 'Vulkan.Core10.Handles.BufferView', /must/ have completed
--     execution
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @buffer@ was created, a compatible set of callbacks
--     /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @buffer@ was created, @pAllocator@ /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @buffer@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @buffer@ /must/ be a valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @buffer@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @buffer@ /must/ be externally synchronized
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.Device'
destroyBuffer :: forall io
               . (MonadIO io)
              => -- | @device@ is the logical device that destroys the buffer.
                 Device
              -> -- | @buffer@ is the buffer to destroy.
                 Buffer
              -> -- | @pAllocator@ controls host memory allocation as described in the
                 -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                 -- chapter.
                 ("allocator" ::: Maybe AllocationCallbacks)
              -> io ()
destroyBuffer :: Device
-> Buffer -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyBuffer device :: Device
device buffer :: Buffer
buffer allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkDestroyBufferPtr :: FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyBufferPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyBuffer (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyBufferPtr FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
     (Ptr Device_T
      -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> 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 vkDestroyBuffer is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyBuffer' :: Ptr Device_T
-> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyBuffer' = FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Device_T
-> Buffer
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyBuffer FunPtr
  (Ptr Device_T
   -> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyBufferPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> Buffer -> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyBuffer' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Buffer
buffer) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkBufferCreateInfo - Structure specifying the parameters of a newly
-- created buffer object
--
-- == Valid Usage
--
-- -   @size@ /must/ be greater than @0@
--
-- -   If @sharingMode@ is
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @pQueueFamilyIndices@ /must/ be a valid pointer to an array of
--     @queueFamilyIndexCount@ @uint32_t@ values
--
-- -   If @sharingMode@ is
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @queueFamilyIndexCount@ /must/ be greater than @1@
--
-- -   If @sharingMode@ is
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT', each
--     element of @pQueueFamilyIndices@ /must/ be unique and /must/ be less
--     than @pQueueFamilyPropertyCount@ returned by either
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceQueueFamilyProperties'
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceQueueFamilyProperties2'
--     for the @physicalDevice@ that was used to create @device@
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseBinding sparse bindings>
--     feature is not enabled, @flags@ /must/ not contain
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT'
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseResidencyBuffer sparse buffer residency>
--     feature is not enabled, @flags@ /must/ not contain
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseResidencyAliased sparse aliased residency>
--     feature is not enabled, @flags@ /must/ not contain
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_ALIASED_BIT'
--
-- -   If @flags@ contains
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     or
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_ALIASED_BIT',
--     it /must/ also contain
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT'
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'
--     structure, its @handleTypes@ member /must/ only contain bits that
--     are also in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'::@externalMemoryProperties.compatibleHandleTypes@,
--     as returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.getPhysicalDeviceExternalBufferProperties'
--     with @pExternalBufferInfo->handleType@ equal to any one of the
--     handle types specified in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'::@handleTypes@
--
-- -   If the protected memory feature is not enabled, @flags@ /must/ not
--     contain
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_PROTECTED_BIT'
--
-- -   If any of the bits
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT',
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT',
--     or
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_ALIASED_BIT'
--     are set,
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_PROTECTED_BIT'
--     /must/ not also be set
--
-- -   If the @pNext@ chain includes a
--     'Vulkan.Extensions.VK_NV_dedicated_allocation.DedicatedAllocationBufferCreateInfoNV'
--     structure, and the @dedicatedAllocation@ member of the chained
--     structure is 'Vulkan.Core10.FundamentalTypes.TRUE', then @flags@
--     /must/ not include
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT',
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT',
--     or
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_ALIASED_BIT'
--
-- -   If
--     'Vulkan.Extensions.VK_EXT_buffer_device_address.BufferDeviceAddressCreateInfoEXT'::@deviceAddress@
--     is not zero, @flags@ /must/ include
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT'
--
-- -   If
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.BufferOpaqueCaptureAddressCreateInfo'::@opaqueCaptureAddress@
--     is not zero, @flags@ /must/ include
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT'
--
-- -   If @flags@ includes
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT',
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-bufferDeviceAddressCaptureReplay bufferDeviceAddressCaptureReplay>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-bufferDeviceAddressCaptureReplayEXT ::bufferDeviceAddressCaptureReplay>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BUFFER_CREATE_INFO'
--
-- -   Each @pNext@ member of any structure (including this one) in the
--     @pNext@ chain /must/ be either @NULL@ or a pointer to a valid
--     instance of
--     'Vulkan.Extensions.VK_EXT_buffer_device_address.BufferDeviceAddressCreateInfoEXT',
--     'Vulkan.Core12.Promoted_From_VK_KHR_buffer_device_address.BufferOpaqueCaptureAddressCreateInfo',
--     'Vulkan.Extensions.VK_NV_dedicated_allocation.DedicatedAllocationBufferCreateInfoNV',
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'
--
-- -   The @sType@ value of each struct in the @pNext@ chain /must/ be
--     unique
--
-- -   @flags@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BufferCreateFlagBits'
--     values
--
-- -   @usage@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlagBits' values
--
-- -   @usage@ /must/ not be @0@
--
-- -   @sharingMode@ /must/ be a valid
--     'Vulkan.Core10.Enums.SharingMode.SharingMode' value
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.BufferCreateFlagBits.BufferCreateFlags',
-- 'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlags',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.SharingMode.SharingMode',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'createBuffer'
data BufferCreateInfo (es :: [Type]) = BufferCreateInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    BufferCreateInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.BufferCreateFlagBits.BufferCreateFlagBits'
    -- specifying additional parameters of the buffer.
    BufferCreateInfo es -> BufferCreateFlags
flags :: BufferCreateFlags
  , -- | @size@ is the size in bytes of the buffer to be created.
    BufferCreateInfo es -> DeviceSize
size :: DeviceSize
  , -- | @usage@ is a bitmask of
    -- 'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlagBits' specifying
    -- allowed usages of the buffer.
    BufferCreateInfo es -> BufferUsageFlags
usage :: BufferUsageFlags
  , -- | @sharingMode@ is a 'Vulkan.Core10.Enums.SharingMode.SharingMode' value
    -- specifying the sharing mode of the buffer when it will be accessed by
    -- multiple queue families.
    BufferCreateInfo es -> SharingMode
sharingMode :: SharingMode
  , -- | @pQueueFamilyIndices@ is a list of queue families that will access this
    -- buffer (ignored if @sharingMode@ is not
    -- 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT').
    BufferCreateInfo es -> Vector Word32
queueFamilyIndices :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BufferCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (BufferCreateInfo es)

instance Extensible BufferCreateInfo where
  extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_BUFFER_CREATE_INFO
  setNext :: BufferCreateInfo ds -> Chain es -> BufferCreateInfo es
setNext x :: BufferCreateInfo ds
x next :: Chain es
next = BufferCreateInfo ds
x{$sel:next:BufferCreateInfo :: Chain es
next = Chain es
next}
  getNext :: BufferCreateInfo es -> Chain es
getNext BufferCreateInfo{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends BufferCreateInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends BufferCreateInfo e => b) -> Maybe b
extends _ f :: Extends BufferCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable BufferDeviceAddressCreateInfoEXT) =>
Maybe (e :~: BufferDeviceAddressCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @BufferDeviceAddressCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends BufferCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable BufferOpaqueCaptureAddressCreateInfo) =>
Maybe (e :~: BufferOpaqueCaptureAddressCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @BufferOpaqueCaptureAddressCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends BufferCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable ExternalMemoryBufferCreateInfo) =>
Maybe (e :~: ExternalMemoryBufferCreateInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExternalMemoryBufferCreateInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends BufferCreateInfo e => b
f
    | Just Refl <- (Typeable e, Typeable DedicatedAllocationBufferCreateInfoNV) =>
Maybe (e :~: DedicatedAllocationBufferCreateInfoNV)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DedicatedAllocationBufferCreateInfoNV = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends BufferCreateInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss BufferCreateInfo es, PokeChain es) => ToCStruct (BufferCreateInfo es) where
  withCStruct :: BufferCreateInfo es -> (Ptr (BufferCreateInfo es) -> IO b) -> IO b
withCStruct x :: BufferCreateInfo es
x f :: Ptr (BufferCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (BufferCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 56 8 ((Ptr (BufferCreateInfo es) -> IO b) -> IO b)
-> (Ptr (BufferCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (BufferCreateInfo es)
p -> Ptr (BufferCreateInfo es) -> BufferCreateInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (BufferCreateInfo es)
p BufferCreateInfo es
x (Ptr (BufferCreateInfo es) -> IO b
f Ptr (BufferCreateInfo es)
p)
  pokeCStruct :: Ptr (BufferCreateInfo es) -> BufferCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (BufferCreateInfo es)
p BufferCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_CREATE_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr BufferCreateFlags -> BufferCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr BufferCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr BufferCreateFlags)) (BufferCreateFlags
flags)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
size)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr BufferUsageFlags -> BufferUsageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr BufferUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr BufferUsageFlags)) (BufferUsageFlags
usage)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SharingMode -> SharingMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SharingMode)) (SharingMode
sharingMode)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
queueFamilyIndices)) :: Word32))
    Ptr Word32
pPQueueFamilyIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
queueFamilyIndices)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPQueueFamilyIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
queueFamilyIndices)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr (Ptr Word32))) (Ptr Word32
pPQueueFamilyIndices')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 56
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (BufferCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (BufferCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_CREATE_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr BufferUsageFlags -> BufferUsageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr BufferUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr BufferUsageFlags)) (BufferUsageFlags
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SharingMode -> SharingMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SharingMode)) (SharingMode
forall a. Zero a => a
zero)
    Ptr Word32
pPQueueFamilyIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPQueueFamilyIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr (Ptr Word32))) (Ptr Word32
pPQueueFamilyIndices')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss BufferCreateInfo es, PeekChain es) => FromCStruct (BufferCreateInfo es) where
  peekCStruct :: Ptr (BufferCreateInfo es) -> IO (BufferCreateInfo es)
peekCStruct p :: Ptr (BufferCreateInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    BufferCreateFlags
flags <- Ptr BufferCreateFlags -> IO BufferCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @BufferCreateFlags ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr BufferCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr BufferCreateFlags))
    DeviceSize
size <- Ptr DeviceSize -> IO DeviceSize
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize))
    BufferUsageFlags
usage <- Ptr BufferUsageFlags -> IO BufferUsageFlags
forall a. Storable a => Ptr a -> IO a
peek @BufferUsageFlags ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr BufferUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr BufferUsageFlags))
    SharingMode
sharingMode <- Ptr SharingMode -> IO SharingMode
forall a. Storable a => Ptr a -> IO a
peek @SharingMode ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 36 :: Ptr SharingMode))
    Word32
queueFamilyIndexCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32))
    Ptr Word32
pQueueFamilyIndices <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (BufferCreateInfo es)
p Ptr (BufferCreateInfo es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr (Ptr Word32)))
    Vector Word32
pQueueFamilyIndices' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
queueFamilyIndexCount) (\i :: Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pQueueFamilyIndices Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    BufferCreateInfo es -> IO (BufferCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferCreateInfo es -> IO (BufferCreateInfo es))
-> BufferCreateInfo es -> IO (BufferCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> BufferCreateFlags
-> DeviceSize
-> BufferUsageFlags
-> SharingMode
-> Vector Word32
-> BufferCreateInfo es
forall (es :: [*]).
Chain es
-> BufferCreateFlags
-> DeviceSize
-> BufferUsageFlags
-> SharingMode
-> Vector Word32
-> BufferCreateInfo es
BufferCreateInfo
             Chain es
next BufferCreateFlags
flags DeviceSize
size BufferUsageFlags
usage SharingMode
sharingMode Vector Word32
pQueueFamilyIndices'

instance es ~ '[] => Zero (BufferCreateInfo es) where
  zero :: BufferCreateInfo es
zero = Chain es
-> BufferCreateFlags
-> DeviceSize
-> BufferUsageFlags
-> SharingMode
-> Vector Word32
-> BufferCreateInfo es
forall (es :: [*]).
Chain es
-> BufferCreateFlags
-> DeviceSize
-> BufferUsageFlags
-> SharingMode
-> Vector Word32
-> BufferCreateInfo es
BufferCreateInfo
           ()
           BufferCreateFlags
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           BufferUsageFlags
forall a. Zero a => a
zero
           SharingMode
forall a. Zero a => a
zero
           Vector Word32
forall a. Monoid a => a
mempty