{-# language CPP #-}
module Vulkan.Core10.Buffer ( createBuffer
, withBuffer
, destroyBuffer
, BufferCreateInfo(..)
, Buffer(..)
, SharingMode(..)
, BufferUsageFlagBits(..)
, BufferUsageFlags
, BufferCreateFlagBits(..)
, BufferCreateFlags
) where
import Vulkan.Internal.Utils (traceAroundEvent)
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 Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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.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.Exception (VulkanException(..))
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
createBuffer :: forall a io
. (Extendss BufferCreateInfo a, PokeChain a, MonadIO io)
=>
Device
->
(BufferCreateInfo a)
->
("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
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkCreateBuffer" (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)
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 ()
destroyBuffer :: forall io
. (MonadIO io)
=>
Device
->
Buffer
->
("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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent "vkDestroyBuffer" (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
$ ()
data BufferCreateInfo (es :: [Type]) = BufferCreateInfo
{
BufferCreateInfo es -> Chain es
next :: Chain es
,
BufferCreateInfo es -> BufferCreateFlags
flags :: BufferCreateFlags
,
BufferCreateInfo es -> DeviceSize
size :: DeviceSize
,
BufferCreateInfo es -> BufferUsageFlags
usage :: BufferUsageFlags
,
BufferCreateInfo es -> SharingMode
sharingMode :: SharingMode
,
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
extensibleTypeName :: String
extensibleTypeName = "BufferCreateInfo"
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