{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_host_image_copy ( copyMemoryToImageEXT
, copyImageToMemoryEXT
, copyImageToImageEXT
, transitionImageLayoutEXT
, getImageSubresourceLayout2EXT
, PhysicalDeviceHostImageCopyFeaturesEXT(..)
, PhysicalDeviceHostImageCopyPropertiesEXT(..)
, MemoryToImageCopyEXT(..)
, ImageToMemoryCopyEXT(..)
, CopyMemoryToImageInfoEXT(..)
, CopyImageToMemoryInfoEXT(..)
, CopyImageToImageInfoEXT(..)
, HostImageLayoutTransitionInfoEXT(..)
, SubresourceHostMemcpySizeEXT(..)
, HostImageCopyDevicePerformanceQueryEXT(..)
, HostImageCopyFlagsEXT
, HostImageCopyFlagBitsEXT( HOST_IMAGE_COPY_MEMCPY_EXT
, ..
)
, ImageSubresource2EXT
, SubresourceLayout2EXT
, EXT_HOST_IMAGE_COPY_SPEC_VERSION
, pattern EXT_HOST_IMAGE_COPY_SPEC_VERSION
, EXT_HOST_IMAGE_COPY_EXTENSION_NAME
, pattern EXT_HOST_IMAGE_COPY_EXTENSION_NAME
, ImageSubresource2KHR(..)
, SubresourceLayout2KHR(..)
, getImageSubresourceLayout2KHR
) where
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import Numeric (showHex)
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 Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
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 GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Extensions.VK_KHR_maintenance5 (getImageSubresourceLayout2KHR)
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCopyImageToImageEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCopyImageToMemoryEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCopyMemoryToImageEXT))
import Vulkan.Dynamic (DeviceCmds(pVkTransitionImageLayoutEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2 (ImageCopy2)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Extensions.VK_KHR_maintenance5 (ImageSubresource2KHR)
import Vulkan.Core10.CommandBufferBuilding (ImageSubresourceLayers)
import Vulkan.Core10.ImageView (ImageSubresourceRange)
import Vulkan.Core10.FundamentalTypes (Offset3D)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.VK_KHR_maintenance5 (SubresourceLayout2KHR)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_KHR_maintenance5 (getImageSubresourceLayout2KHR)
import Vulkan.Extensions.VK_KHR_maintenance5 (ImageSubresource2KHR(..))
import Vulkan.Extensions.VK_KHR_maintenance5 (SubresourceLayout2KHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCopyMemoryToImageEXT
:: FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result
copyMemoryToImageEXT :: forall io
. (MonadIO io)
=>
Device
->
CopyMemoryToImageInfoEXT
-> io ()
copyMemoryToImageEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyMemoryToImageInfoEXT -> io ()
copyMemoryToImageEXT Device
device CopyMemoryToImageInfoEXT
copyMemoryToImageInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCopyMemoryToImageEXTPtr :: FunPtr
(Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result)
vkCopyMemoryToImageEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result)
pVkCopyMemoryToImageEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result)
vkCopyMemoryToImageEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyMemoryToImageEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCopyMemoryToImageEXT' :: Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
vkCopyMemoryToImageEXT' = FunPtr
(Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result)
-> Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
mkVkCopyMemoryToImageEXT FunPtr
(Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result)
vkCopyMemoryToImageEXTPtr
"pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyMemoryToImageInfoEXT
copyMemoryToImageInfo)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyMemoryToImageEXT" (Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
vkCopyMemoryToImageEXT'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCopyImageToMemoryEXT
:: FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result
copyImageToMemoryEXT :: forall io
. (MonadIO io)
=>
Device
->
CopyImageToMemoryInfoEXT
-> io ()
copyImageToMemoryEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyImageToMemoryInfoEXT -> io ()
copyImageToMemoryEXT Device
device CopyImageToMemoryInfoEXT
copyImageToMemoryInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCopyImageToMemoryEXTPtr :: FunPtr
(Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result)
vkCopyImageToMemoryEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result)
pVkCopyImageToMemoryEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result)
vkCopyImageToMemoryEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToMemoryEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCopyImageToMemoryEXT' :: Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
vkCopyImageToMemoryEXT' = FunPtr
(Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result)
-> Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
mkVkCopyImageToMemoryEXT FunPtr
(Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result)
vkCopyImageToMemoryEXTPtr
"pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageToMemoryInfoEXT
copyImageToMemoryInfo)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToMemoryEXT" (Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
vkCopyImageToMemoryEXT'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCopyImageToImageEXT
:: FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result
copyImageToImageEXT :: forall io
. (MonadIO io)
=>
Device
->
CopyImageToImageInfoEXT
-> io ()
copyImageToImageEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyImageToImageInfoEXT -> io ()
copyImageToImageEXT Device
device CopyImageToImageInfoEXT
copyImageToImageInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCopyImageToImageEXTPtr :: FunPtr
(Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result)
vkCopyImageToImageEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result)
pVkCopyImageToImageEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result)
vkCopyImageToImageEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToImageEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCopyImageToImageEXT' :: Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
vkCopyImageToImageEXT' = FunPtr
(Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result)
-> Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
mkVkCopyImageToImageEXT FunPtr
(Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result)
vkCopyImageToImageEXTPtr
"pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageToImageInfoEXT
copyImageToImageInfo)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToImageEXT" (Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
vkCopyImageToImageEXT'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkTransitionImageLayoutEXT
:: FunPtr (Ptr Device_T -> Word32 -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result) -> Ptr Device_T -> Word32 -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result
transitionImageLayoutEXT :: forall io
. (MonadIO io)
=>
Device
->
("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
-> io ()
transitionImageLayoutEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
-> io ()
transitionImageLayoutEXT Device
device "transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkTransitionImageLayoutEXTPtr :: FunPtr
(Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result)
vkTransitionImageLayoutEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result)
pVkTransitionImageLayoutEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result)
vkTransitionImageLayoutEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkTransitionImageLayoutEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkTransitionImageLayoutEXT' :: Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
vkTransitionImageLayoutEXT' = FunPtr
(Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result)
-> Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
mkVkTransitionImageLayoutEXT FunPtr
(Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result)
vkTransitionImageLayoutEXTPtr
"pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @HostImageLayoutTransitionInfoEXT ((forall a. Vector a -> Int
Data.Vector.length ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) forall a. Num a => a -> a -> a
* Int
56)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i HostImageLayoutTransitionInfoEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
56 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr HostImageLayoutTransitionInfoEXT) (HostImageLayoutTransitionInfoEXT
e)) ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkTransitionImageLayoutEXT" (Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
vkTransitionImageLayoutEXT'
(Device -> Ptr Device_T
deviceHandle (Device
device))
((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) :: Word32))
("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
getImageSubresourceLayout2EXT :: Device
-> Image -> ImageSubresource2KHR -> io (SubresourceLayout2KHR a)
getImageSubresourceLayout2EXT = forall (a :: [*]) (io :: * -> *).
(Extendss SubresourceLayout2KHR a, PokeChain a, PeekChain a,
MonadIO io) =>
Device
-> Image -> ImageSubresource2KHR -> io (SubresourceLayout2KHR a)
getImageSubresourceLayout2KHR
data PhysicalDeviceHostImageCopyFeaturesEXT = PhysicalDeviceHostImageCopyFeaturesEXT
{
PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
hostImageCopy :: Bool }
deriving (Typeable, PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
$c/= :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
$c== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceHostImageCopyFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceHostImageCopyFeaturesEXT
instance ToCStruct PhysicalDeviceHostImageCopyFeaturesEXT where
withCStruct :: forall b.
PhysicalDeviceHostImageCopyFeaturesEXT
-> (Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceHostImageCopyFeaturesEXT
x Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p PhysicalDeviceHostImageCopyFeaturesEXT
x (Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b
f Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p PhysicalDeviceHostImageCopyFeaturesEXT{Bool
hostImageCopy :: Bool
$sel:hostImageCopy:PhysicalDeviceHostImageCopyFeaturesEXT :: PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
hostImageCopy))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceHostImageCopyFeaturesEXT where
peekCStruct :: Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> IO PhysicalDeviceHostImageCopyFeaturesEXT
peekCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p = do
Bool32
hostImageCopy <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceHostImageCopyFeaturesEXT
PhysicalDeviceHostImageCopyFeaturesEXT
(Bool32 -> Bool
bool32ToBool Bool32
hostImageCopy)
instance Storable PhysicalDeviceHostImageCopyFeaturesEXT where
sizeOf :: PhysicalDeviceHostImageCopyFeaturesEXT -> Int
sizeOf ~PhysicalDeviceHostImageCopyFeaturesEXT
_ = Int
24
alignment :: PhysicalDeviceHostImageCopyFeaturesEXT -> Int
alignment ~PhysicalDeviceHostImageCopyFeaturesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> IO PhysicalDeviceHostImageCopyFeaturesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO ()
poke Ptr PhysicalDeviceHostImageCopyFeaturesEXT
ptr PhysicalDeviceHostImageCopyFeaturesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
ptr PhysicalDeviceHostImageCopyFeaturesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceHostImageCopyFeaturesEXT where
zero :: PhysicalDeviceHostImageCopyFeaturesEXT
zero = Bool -> PhysicalDeviceHostImageCopyFeaturesEXT
PhysicalDeviceHostImageCopyFeaturesEXT
forall a. Zero a => a
zero
data PhysicalDeviceHostImageCopyPropertiesEXT = PhysicalDeviceHostImageCopyPropertiesEXT
{
PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
copySrcLayoutCount :: Word32
,
PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
copySrcLayouts :: Ptr ImageLayout
,
PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
copyDstLayoutCount :: Word32
,
PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
copyDstLayouts :: Ptr ImageLayout
,
PhysicalDeviceHostImageCopyPropertiesEXT -> ByteString
optimalTilingLayoutUUID :: ByteString
,
PhysicalDeviceHostImageCopyPropertiesEXT -> Bool
identicalMemoryTypeRequirements :: Bool
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceHostImageCopyPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceHostImageCopyPropertiesEXT
instance ToCStruct PhysicalDeviceHostImageCopyPropertiesEXT where
withCStruct :: forall b.
PhysicalDeviceHostImageCopyPropertiesEXT
-> (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceHostImageCopyPropertiesEXT
x Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p PhysicalDeviceHostImageCopyPropertiesEXT
x (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b
f Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p PhysicalDeviceHostImageCopyPropertiesEXT{Bool
Flags
Ptr ImageLayout
ByteString
identicalMemoryTypeRequirements :: Bool
optimalTilingLayoutUUID :: ByteString
copyDstLayouts :: Ptr ImageLayout
copyDstLayoutCount :: Flags
copySrcLayouts :: Ptr ImageLayout
copySrcLayoutCount :: Flags
$sel:identicalMemoryTypeRequirements:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Bool
$sel:optimalTilingLayoutUUID:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> ByteString
$sel:copyDstLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:copyDstLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
$sel:copySrcLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:copySrcLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Flags
copySrcLayoutCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copySrcLayouts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Flags
copyDstLayoutCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copyDstLayouts)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
optimalTilingLayoutUUID)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
identicalMemoryTypeRequirements))
IO b
f
cStructSize :: Int
cStructSize = Int
72
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceHostImageCopyPropertiesEXT where
peekCStruct :: Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
peekCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p = do
Flags
copySrcLayoutCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Ptr ImageLayout
pCopySrcLayouts <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageLayout) ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageLayout)))
Flags
copyDstLayoutCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
Ptr ImageLayout
pCopyDstLayouts <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageLayout) ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout)))
ByteString
optimalTilingLayoutUUID <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (FixedArray UUID_SIZE Word8)))
Bool32
identicalMemoryTypeRequirements <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Flags
-> Ptr ImageLayout
-> Flags
-> Ptr ImageLayout
-> ByteString
-> Bool
-> PhysicalDeviceHostImageCopyPropertiesEXT
PhysicalDeviceHostImageCopyPropertiesEXT
Flags
copySrcLayoutCount
Ptr ImageLayout
pCopySrcLayouts
Flags
copyDstLayoutCount
Ptr ImageLayout
pCopyDstLayouts
ByteString
optimalTilingLayoutUUID
(Bool32 -> Bool
bool32ToBool Bool32
identicalMemoryTypeRequirements)
instance Storable PhysicalDeviceHostImageCopyPropertiesEXT where
sizeOf :: PhysicalDeviceHostImageCopyPropertiesEXT -> Int
sizeOf ~PhysicalDeviceHostImageCopyPropertiesEXT
_ = Int
72
alignment :: PhysicalDeviceHostImageCopyPropertiesEXT -> Int
alignment ~PhysicalDeviceHostImageCopyPropertiesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO ()
poke Ptr PhysicalDeviceHostImageCopyPropertiesEXT
ptr PhysicalDeviceHostImageCopyPropertiesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
ptr PhysicalDeviceHostImageCopyPropertiesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceHostImageCopyPropertiesEXT where
zero :: PhysicalDeviceHostImageCopyPropertiesEXT
zero = Flags
-> Ptr ImageLayout
-> Flags
-> Ptr ImageLayout
-> ByteString
-> Bool
-> PhysicalDeviceHostImageCopyPropertiesEXT
PhysicalDeviceHostImageCopyPropertiesEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
data MemoryToImageCopyEXT = MemoryToImageCopyEXT
{
MemoryToImageCopyEXT -> Ptr ()
hostPointer :: Ptr ()
,
MemoryToImageCopyEXT -> Flags
memoryRowLength :: Word32
,
MemoryToImageCopyEXT -> Flags
memoryImageHeight :: Word32
,
MemoryToImageCopyEXT -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
,
MemoryToImageCopyEXT -> Offset3D
imageOffset :: Offset3D
,
MemoryToImageCopyEXT -> Extent3D
imageExtent :: Extent3D
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryToImageCopyEXT)
#endif
deriving instance Show MemoryToImageCopyEXT
instance ToCStruct MemoryToImageCopyEXT where
withCStruct :: forall b.
MemoryToImageCopyEXT -> (Ptr MemoryToImageCopyEXT -> IO b) -> IO b
withCStruct MemoryToImageCopyEXT
x Ptr MemoryToImageCopyEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr MemoryToImageCopyEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
p MemoryToImageCopyEXT
x (Ptr MemoryToImageCopyEXT -> IO b
f Ptr MemoryToImageCopyEXT
p)
pokeCStruct :: forall b.
Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
p MemoryToImageCopyEXT{Flags
Ptr ()
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
memoryImageHeight :: Flags
memoryRowLength :: Flags
hostPointer :: Ptr ()
$sel:imageExtent:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Extent3D
$sel:imageOffset:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Offset3D
$sel:imageSubresource:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> ImageSubresourceLayers
$sel:memoryImageHeight:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:memoryRowLength:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:hostPointer:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Ptr ()
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
hostPointer)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
memoryRowLength)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
memoryImageHeight)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (Extent3D
imageExtent)
IO b
f
cStructSize :: Int
cStructSize = Int
72
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr MemoryToImageCopyEXT -> IO b -> IO b
pokeZeroCStruct Ptr MemoryToImageCopyEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct MemoryToImageCopyEXT where
peekCStruct :: Ptr MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
peekCStruct Ptr MemoryToImageCopyEXT
p = do
Ptr ()
pHostPointer <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ())))
Flags
memoryRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
Flags
memoryImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
ImageSubresourceLayers
imageSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers))
Offset3D
imageOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D))
Extent3D
imageExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> MemoryToImageCopyEXT
MemoryToImageCopyEXT
Ptr ()
pHostPointer
Flags
memoryRowLength
Flags
memoryImageHeight
ImageSubresourceLayers
imageSubresource
Offset3D
imageOffset
Extent3D
imageExtent
instance Storable MemoryToImageCopyEXT where
sizeOf :: MemoryToImageCopyEXT -> Int
sizeOf ~MemoryToImageCopyEXT
_ = Int
72
alignment :: MemoryToImageCopyEXT -> Int
alignment ~MemoryToImageCopyEXT
_ = Int
8
peek :: Ptr MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO ()
poke Ptr MemoryToImageCopyEXT
ptr MemoryToImageCopyEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
ptr MemoryToImageCopyEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryToImageCopyEXT where
zero :: MemoryToImageCopyEXT
zero = Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> MemoryToImageCopyEXT
MemoryToImageCopyEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data ImageToMemoryCopyEXT = ImageToMemoryCopyEXT
{
ImageToMemoryCopyEXT -> Ptr ()
hostPointer :: Ptr ()
,
ImageToMemoryCopyEXT -> Flags
memoryRowLength :: Word32
,
ImageToMemoryCopyEXT -> Flags
memoryImageHeight :: Word32
,
ImageToMemoryCopyEXT -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
,
ImageToMemoryCopyEXT -> Offset3D
imageOffset :: Offset3D
,
ImageToMemoryCopyEXT -> Extent3D
imageExtent :: Extent3D
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageToMemoryCopyEXT)
#endif
deriving instance Show ImageToMemoryCopyEXT
instance ToCStruct ImageToMemoryCopyEXT where
withCStruct :: forall b.
ImageToMemoryCopyEXT -> (Ptr ImageToMemoryCopyEXT -> IO b) -> IO b
withCStruct ImageToMemoryCopyEXT
x Ptr ImageToMemoryCopyEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr ImageToMemoryCopyEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageToMemoryCopyEXT
p ImageToMemoryCopyEXT
x (Ptr ImageToMemoryCopyEXT -> IO b
f Ptr ImageToMemoryCopyEXT
p)
pokeCStruct :: forall b.
Ptr ImageToMemoryCopyEXT -> ImageToMemoryCopyEXT -> IO b -> IO b
pokeCStruct Ptr ImageToMemoryCopyEXT
p ImageToMemoryCopyEXT{Flags
Ptr ()
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
memoryImageHeight :: Flags
memoryRowLength :: Flags
hostPointer :: Ptr ()
$sel:imageExtent:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Extent3D
$sel:imageOffset:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Offset3D
$sel:imageSubresource:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> ImageSubresourceLayers
$sel:memoryImageHeight:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Flags
$sel:memoryRowLength:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Flags
$sel:hostPointer:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Ptr ()
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
hostPointer)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
memoryRowLength)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
memoryImageHeight)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (Extent3D
imageExtent)
IO b
f
cStructSize :: Int
cStructSize = Int
72
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr ImageToMemoryCopyEXT -> IO b -> IO b
pokeZeroCStruct Ptr ImageToMemoryCopyEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ImageToMemoryCopyEXT where
peekCStruct :: Ptr ImageToMemoryCopyEXT -> IO ImageToMemoryCopyEXT
peekCStruct Ptr ImageToMemoryCopyEXT
p = do
Ptr ()
pHostPointer <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ())))
Flags
memoryRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
Flags
memoryImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
ImageSubresourceLayers
imageSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers))
Offset3D
imageOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D))
Extent3D
imageExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageToMemoryCopyEXT
ImageToMemoryCopyEXT
Ptr ()
pHostPointer
Flags
memoryRowLength
Flags
memoryImageHeight
ImageSubresourceLayers
imageSubresource
Offset3D
imageOffset
Extent3D
imageExtent
instance Storable ImageToMemoryCopyEXT where
sizeOf :: ImageToMemoryCopyEXT -> Int
sizeOf ~ImageToMemoryCopyEXT
_ = Int
72
alignment :: ImageToMemoryCopyEXT -> Int
alignment ~ImageToMemoryCopyEXT
_ = Int
8
peek :: Ptr ImageToMemoryCopyEXT -> IO ImageToMemoryCopyEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr ImageToMemoryCopyEXT -> ImageToMemoryCopyEXT -> IO ()
poke Ptr ImageToMemoryCopyEXT
ptr ImageToMemoryCopyEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageToMemoryCopyEXT
ptr ImageToMemoryCopyEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ImageToMemoryCopyEXT where
zero :: ImageToMemoryCopyEXT
zero = Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageToMemoryCopyEXT
ImageToMemoryCopyEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data CopyMemoryToImageInfoEXT = CopyMemoryToImageInfoEXT
{
CopyMemoryToImageInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
,
CopyMemoryToImageInfoEXT -> Image
dstImage :: Image
,
CopyMemoryToImageInfoEXT -> ImageLayout
dstImageLayout :: ImageLayout
,
CopyMemoryToImageInfoEXT -> Vector MemoryToImageCopyEXT
regions :: Vector MemoryToImageCopyEXT
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyMemoryToImageInfoEXT)
#endif
deriving instance Show CopyMemoryToImageInfoEXT
instance ToCStruct CopyMemoryToImageInfoEXT where
withCStruct :: forall b.
CopyMemoryToImageInfoEXT
-> (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO b)
-> IO b
withCStruct CopyMemoryToImageInfoEXT
x ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p CopyMemoryToImageInfoEXT
x (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT) -> IO b
f "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p)
pokeCStruct :: forall b.
("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> CopyMemoryToImageInfoEXT -> IO b -> IO b
pokeCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p CopyMemoryToImageInfoEXT{Vector MemoryToImageCopyEXT
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector MemoryToImageCopyEXT
dstImageLayout :: ImageLayout
dstImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> Vector MemoryToImageCopyEXT
$sel:dstImageLayout:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> ImageLayout
$sel:dstImage:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> Image
$sel:flags:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> HostImageCopyFlagBitsEXT
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
dstImage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector MemoryToImageCopyEXT
regions)) :: Word32))
Ptr MemoryToImageCopyEXT
pPRegions' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @MemoryToImageCopyEXT ((forall a. Vector a -> Int
Data.Vector.length (Vector MemoryToImageCopyEXT
regions)) forall a. Num a => a -> a -> a
* Int
72)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MemoryToImageCopyEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MemoryToImageCopyEXT
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryToImageCopyEXT) (MemoryToImageCopyEXT
e)) (Vector MemoryToImageCopyEXT
regions)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr MemoryToImageCopyEXT))) (Ptr MemoryToImageCopyEXT
pPRegions')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
48
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CopyMemoryToImageInfoEXT where
peekCStruct :: ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO CopyMemoryToImageInfoEXT
peekCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p = do
HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
Ptr MemoryToImageCopyEXT
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr MemoryToImageCopyEXT) (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr MemoryToImageCopyEXT)))
Vector MemoryToImageCopyEXT
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryToImageCopyEXT ((Ptr MemoryToImageCopyEXT
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryToImageCopyEXT)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector MemoryToImageCopyEXT
-> CopyMemoryToImageInfoEXT
CopyMemoryToImageInfoEXT
HostImageCopyFlagBitsEXT
flags Image
dstImage ImageLayout
dstImageLayout Vector MemoryToImageCopyEXT
pRegions'
instance Zero CopyMemoryToImageInfoEXT where
zero :: CopyMemoryToImageInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector MemoryToImageCopyEXT
-> CopyMemoryToImageInfoEXT
CopyMemoryToImageInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data CopyImageToMemoryInfoEXT = CopyImageToMemoryInfoEXT
{
CopyImageToMemoryInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
,
CopyImageToMemoryInfoEXT -> Image
srcImage :: Image
,
CopyImageToMemoryInfoEXT -> ImageLayout
srcImageLayout :: ImageLayout
,
CopyImageToMemoryInfoEXT -> Vector ImageToMemoryCopyEXT
regions :: Vector ImageToMemoryCopyEXT
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageToMemoryInfoEXT)
#endif
deriving instance Show CopyImageToMemoryInfoEXT
instance ToCStruct CopyImageToMemoryInfoEXT where
withCStruct :: forall b.
CopyImageToMemoryInfoEXT
-> (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO b)
-> IO b
withCStruct CopyImageToMemoryInfoEXT
x ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p CopyImageToMemoryInfoEXT
x (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT) -> IO b
f "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p)
pokeCStruct :: forall b.
("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> CopyImageToMemoryInfoEXT -> IO b -> IO b
pokeCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p CopyImageToMemoryInfoEXT{Vector ImageToMemoryCopyEXT
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector ImageToMemoryCopyEXT
srcImageLayout :: ImageLayout
srcImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> Vector ImageToMemoryCopyEXT
$sel:srcImageLayout:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> ImageLayout
$sel:srcImage:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> Image
$sel:flags:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> HostImageCopyFlagBitsEXT
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
srcImage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ImageToMemoryCopyEXT
regions)) :: Word32))
Ptr ImageToMemoryCopyEXT
pPRegions' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageToMemoryCopyEXT ((forall a. Vector a -> Int
Data.Vector.length (Vector ImageToMemoryCopyEXT
regions)) forall a. Num a => a -> a -> a
* Int
72)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageToMemoryCopyEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageToMemoryCopyEXT
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageToMemoryCopyEXT) (ImageToMemoryCopyEXT
e)) (Vector ImageToMemoryCopyEXT
regions)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageToMemoryCopyEXT))) (Ptr ImageToMemoryCopyEXT
pPRegions')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
48
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CopyImageToMemoryInfoEXT where
peekCStruct :: ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO CopyImageToMemoryInfoEXT
peekCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p = do
HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
Ptr ImageToMemoryCopyEXT
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageToMemoryCopyEXT) (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageToMemoryCopyEXT)))
Vector ImageToMemoryCopyEXT
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageToMemoryCopyEXT ((Ptr ImageToMemoryCopyEXT
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageToMemoryCopyEXT)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector ImageToMemoryCopyEXT
-> CopyImageToMemoryInfoEXT
CopyImageToMemoryInfoEXT
HostImageCopyFlagBitsEXT
flags Image
srcImage ImageLayout
srcImageLayout Vector ImageToMemoryCopyEXT
pRegions'
instance Zero CopyImageToMemoryInfoEXT where
zero :: CopyImageToMemoryInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector ImageToMemoryCopyEXT
-> CopyImageToMemoryInfoEXT
CopyImageToMemoryInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data CopyImageToImageInfoEXT = CopyImageToImageInfoEXT
{
CopyImageToImageInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
,
CopyImageToImageInfoEXT -> Image
srcImage :: Image
,
CopyImageToImageInfoEXT -> ImageLayout
srcImageLayout :: ImageLayout
,
CopyImageToImageInfoEXT -> Image
dstImage :: Image
,
CopyImageToImageInfoEXT -> ImageLayout
dstImageLayout :: ImageLayout
,
CopyImageToImageInfoEXT -> Vector ImageCopy2
regions :: Vector ImageCopy2
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageToImageInfoEXT)
#endif
deriving instance Show CopyImageToImageInfoEXT
instance ToCStruct CopyImageToImageInfoEXT where
withCStruct :: forall b.
CopyImageToImageInfoEXT
-> (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO b)
-> IO b
withCStruct CopyImageToImageInfoEXT
x ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \"pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p CopyImageToImageInfoEXT
x (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT) -> IO b
f "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p)
pokeCStruct :: forall b.
("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> CopyImageToImageInfoEXT -> IO b -> IO b
pokeCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p CopyImageToImageInfoEXT{Vector ImageCopy2
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector ImageCopy2
dstImageLayout :: ImageLayout
dstImage :: Image
srcImageLayout :: ImageLayout
srcImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Vector ImageCopy2
$sel:dstImageLayout:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> ImageLayout
$sel:dstImage:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Image
$sel:srcImageLayout:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> ImageLayout
$sel:srcImage:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Image
$sel:flags:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> HostImageCopyFlagBitsEXT
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
srcImage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (Image
dstImage)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ImageCopy2
regions)) :: Word32))
Ptr ImageCopy2
pPRegions' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageCopy2 ((forall a. Vector a -> Int
Data.Vector.length (Vector ImageCopy2
regions)) forall a. Num a => a -> a -> a
* Int
88)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageCopy2
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageCopy2
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
88 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageCopy2) (ImageCopy2
e)) (Vector ImageCopy2
regions)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr ImageCopy2))) (Ptr ImageCopy2
pPRegions')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
64
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct CopyImageToImageInfoEXT where
peekCStruct :: ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO CopyImageToImageInfoEXT
peekCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p = do
HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image))
ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout))
Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Word32))
Ptr ImageCopy2
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageCopy2) (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr ImageCopy2)))
Vector ImageCopy2
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageCopy2 ((Ptr ImageCopy2
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
88 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageCopy2)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageToImageInfoEXT
CopyImageToImageInfoEXT
HostImageCopyFlagBitsEXT
flags Image
srcImage ImageLayout
srcImageLayout Image
dstImage ImageLayout
dstImageLayout Vector ImageCopy2
pRegions'
instance Zero CopyImageToImageInfoEXT where
zero :: CopyImageToImageInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageToImageInfoEXT
CopyImageToImageInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data HostImageLayoutTransitionInfoEXT = HostImageLayoutTransitionInfoEXT
{
HostImageLayoutTransitionInfoEXT -> Image
image :: Image
,
HostImageLayoutTransitionInfoEXT -> ImageLayout
oldLayout :: ImageLayout
,
HostImageLayoutTransitionInfoEXT -> ImageLayout
newLayout :: ImageLayout
,
HostImageLayoutTransitionInfoEXT -> ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HostImageLayoutTransitionInfoEXT)
#endif
deriving instance Show HostImageLayoutTransitionInfoEXT
instance ToCStruct HostImageLayoutTransitionInfoEXT where
withCStruct :: forall b.
HostImageLayoutTransitionInfoEXT
-> (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO b)
-> IO b
withCStruct HostImageLayoutTransitionInfoEXT
x ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \"pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p HostImageLayoutTransitionInfoEXT
x (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT) -> IO b
f "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p)
pokeCStruct :: forall b.
("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> HostImageLayoutTransitionInfoEXT -> IO b -> IO b
pokeCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p HostImageLayoutTransitionInfoEXT{ImageLayout
Image
ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
newLayout :: ImageLayout
oldLayout :: ImageLayout
image :: Image
$sel:subresourceRange:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageSubresourceRange
$sel:newLayout:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageLayout
$sel:oldLayout:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageLayout
$sel:image:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> Image
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
image)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
oldLayout)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (ImageLayout
newLayout)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange)) (ImageSubresourceRange
subresourceRange)
IO b
f
cStructSize :: Int
cStructSize = Int
56
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct HostImageLayoutTransitionInfoEXT where
peekCStruct :: ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO HostImageLayoutTransitionInfoEXT
peekCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p = do
Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
ImageLayout
oldLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
ImageLayout
newLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout))
ImageSubresourceRange
subresourceRange <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceRange (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Image
-> ImageLayout
-> ImageLayout
-> ImageSubresourceRange
-> HostImageLayoutTransitionInfoEXT
HostImageLayoutTransitionInfoEXT
Image
image ImageLayout
oldLayout ImageLayout
newLayout ImageSubresourceRange
subresourceRange
instance Storable HostImageLayoutTransitionInfoEXT where
sizeOf :: HostImageLayoutTransitionInfoEXT -> Int
sizeOf ~HostImageLayoutTransitionInfoEXT
_ = Int
56
alignment :: HostImageLayoutTransitionInfoEXT -> Int
alignment ~HostImageLayoutTransitionInfoEXT
_ = Int
8
peek :: ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO HostImageLayoutTransitionInfoEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> HostImageLayoutTransitionInfoEXT -> IO ()
poke "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
ptr HostImageLayoutTransitionInfoEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
ptr HostImageLayoutTransitionInfoEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero HostImageLayoutTransitionInfoEXT where
zero :: HostImageLayoutTransitionInfoEXT
zero = Image
-> ImageLayout
-> ImageLayout
-> ImageSubresourceRange
-> HostImageLayoutTransitionInfoEXT
HostImageLayoutTransitionInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data SubresourceHostMemcpySizeEXT = SubresourceHostMemcpySizeEXT
{
SubresourceHostMemcpySizeEXT -> DeviceSize
size :: DeviceSize }
deriving (Typeable, SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
$c/= :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
$c== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubresourceHostMemcpySizeEXT)
#endif
deriving instance Show SubresourceHostMemcpySizeEXT
instance ToCStruct SubresourceHostMemcpySizeEXT where
withCStruct :: forall b.
SubresourceHostMemcpySizeEXT
-> (Ptr SubresourceHostMemcpySizeEXT -> IO b) -> IO b
withCStruct SubresourceHostMemcpySizeEXT
x Ptr SubresourceHostMemcpySizeEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr SubresourceHostMemcpySizeEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SubresourceHostMemcpySizeEXT
p SubresourceHostMemcpySizeEXT
x (Ptr SubresourceHostMemcpySizeEXT -> IO b
f Ptr SubresourceHostMemcpySizeEXT
p)
pokeCStruct :: forall b.
Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO b -> IO b
pokeCStruct Ptr SubresourceHostMemcpySizeEXT
p SubresourceHostMemcpySizeEXT{DeviceSize
size :: DeviceSize
$sel:size:SubresourceHostMemcpySizeEXT :: SubresourceHostMemcpySizeEXT -> DeviceSize
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceSize
size)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr SubresourceHostMemcpySizeEXT -> IO b -> IO b
pokeZeroCStruct Ptr SubresourceHostMemcpySizeEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct SubresourceHostMemcpySizeEXT where
peekCStruct :: Ptr SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
peekCStruct Ptr SubresourceHostMemcpySizeEXT
p = do
DeviceSize
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize -> SubresourceHostMemcpySizeEXT
SubresourceHostMemcpySizeEXT
DeviceSize
size
instance Storable SubresourceHostMemcpySizeEXT where
sizeOf :: SubresourceHostMemcpySizeEXT -> Int
sizeOf ~SubresourceHostMemcpySizeEXT
_ = Int
24
alignment :: SubresourceHostMemcpySizeEXT -> Int
alignment ~SubresourceHostMemcpySizeEXT
_ = Int
8
peek :: Ptr SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO ()
poke Ptr SubresourceHostMemcpySizeEXT
ptr SubresourceHostMemcpySizeEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SubresourceHostMemcpySizeEXT
ptr SubresourceHostMemcpySizeEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero SubresourceHostMemcpySizeEXT where
zero :: SubresourceHostMemcpySizeEXT
zero = DeviceSize -> SubresourceHostMemcpySizeEXT
SubresourceHostMemcpySizeEXT
forall a. Zero a => a
zero
data HostImageCopyDevicePerformanceQueryEXT = HostImageCopyDevicePerformanceQueryEXT
{
HostImageCopyDevicePerformanceQueryEXT -> Bool
optimalDeviceAccess :: Bool
,
HostImageCopyDevicePerformanceQueryEXT -> Bool
identicalMemoryLayout :: Bool
}
deriving (Typeable, HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
$c/= :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
$c== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HostImageCopyDevicePerformanceQueryEXT)
#endif
deriving instance Show HostImageCopyDevicePerformanceQueryEXT
instance ToCStruct HostImageCopyDevicePerformanceQueryEXT where
withCStruct :: forall b.
HostImageCopyDevicePerformanceQueryEXT
-> (Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b) -> IO b
withCStruct HostImageCopyDevicePerformanceQueryEXT
x Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr HostImageCopyDevicePerformanceQueryEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
p HostImageCopyDevicePerformanceQueryEXT
x (Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b
f Ptr HostImageCopyDevicePerformanceQueryEXT
p)
pokeCStruct :: forall b.
Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO b -> IO b
pokeCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
p HostImageCopyDevicePerformanceQueryEXT{Bool
identicalMemoryLayout :: Bool
optimalDeviceAccess :: Bool
$sel:identicalMemoryLayout:HostImageCopyDevicePerformanceQueryEXT :: HostImageCopyDevicePerformanceQueryEXT -> Bool
$sel:optimalDeviceAccess:HostImageCopyDevicePerformanceQueryEXT :: HostImageCopyDevicePerformanceQueryEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
optimalDeviceAccess))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
identicalMemoryLayout))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b -> IO b
pokeZeroCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct HostImageCopyDevicePerformanceQueryEXT where
peekCStruct :: Ptr HostImageCopyDevicePerformanceQueryEXT
-> IO HostImageCopyDevicePerformanceQueryEXT
peekCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
p = do
Bool32
optimalDeviceAccess <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
identicalMemoryLayout <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr HostImageCopyDevicePerformanceQueryEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> HostImageCopyDevicePerformanceQueryEXT
HostImageCopyDevicePerformanceQueryEXT
(Bool32 -> Bool
bool32ToBool Bool32
optimalDeviceAccess)
(Bool32 -> Bool
bool32ToBool Bool32
identicalMemoryLayout)
instance Storable HostImageCopyDevicePerformanceQueryEXT where
sizeOf :: HostImageCopyDevicePerformanceQueryEXT -> Int
sizeOf ~HostImageCopyDevicePerformanceQueryEXT
_ = Int
24
alignment :: HostImageCopyDevicePerformanceQueryEXT -> Int
alignment ~HostImageCopyDevicePerformanceQueryEXT
_ = Int
8
peek :: Ptr HostImageCopyDevicePerformanceQueryEXT
-> IO HostImageCopyDevicePerformanceQueryEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO ()
poke Ptr HostImageCopyDevicePerformanceQueryEXT
ptr HostImageCopyDevicePerformanceQueryEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
ptr HostImageCopyDevicePerformanceQueryEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero HostImageCopyDevicePerformanceQueryEXT where
zero :: HostImageCopyDevicePerformanceQueryEXT
zero = Bool -> Bool -> HostImageCopyDevicePerformanceQueryEXT
HostImageCopyDevicePerformanceQueryEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type HostImageCopyFlagsEXT = HostImageCopyFlagBitsEXT
newtype HostImageCopyFlagBitsEXT = HostImageCopyFlagBitsEXT Flags
deriving newtype (HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c/= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
== :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c== :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
Eq, Eq HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cmin :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
max :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cmax :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
>= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c>= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
> :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c> :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
<= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c<= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
< :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c< :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
compare :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
$ccompare :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
Ord, Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
HostImageCopyFlagBitsEXT -> Int
forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
$cpoke :: Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
peek :: Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
$cpeek :: Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
pokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
pokeElemOff :: Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
$cpokeElemOff :: Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
peekElemOff :: Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
$cpeekElemOff :: Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
alignment :: HostImageCopyFlagBitsEXT -> Int
$calignment :: HostImageCopyFlagBitsEXT -> Int
sizeOf :: HostImageCopyFlagBitsEXT -> Int
$csizeOf :: HostImageCopyFlagBitsEXT -> Int
Storable, HostImageCopyFlagBitsEXT
forall a. a -> Zero a
zero :: HostImageCopyFlagBitsEXT
$czero :: HostImageCopyFlagBitsEXT
Zero, Eq HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT
Int -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Bool
HostImageCopyFlagBitsEXT -> Int
HostImageCopyFlagBitsEXT -> Maybe Int
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Int -> Bool
HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: HostImageCopyFlagBitsEXT -> Int
$cpopCount :: HostImageCopyFlagBitsEXT -> Int
rotateR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotateR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
rotateL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotateL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
unsafeShiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cunsafeShiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
unsafeShiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cunsafeShiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
isSigned :: HostImageCopyFlagBitsEXT -> Bool
$cisSigned :: HostImageCopyFlagBitsEXT -> Bool
bitSize :: HostImageCopyFlagBitsEXT -> Int
$cbitSize :: HostImageCopyFlagBitsEXT -> Int
bitSizeMaybe :: HostImageCopyFlagBitsEXT -> Maybe Int
$cbitSizeMaybe :: HostImageCopyFlagBitsEXT -> Maybe Int
testBit :: HostImageCopyFlagBitsEXT -> Int -> Bool
$ctestBit :: HostImageCopyFlagBitsEXT -> Int -> Bool
complementBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$ccomplementBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
clearBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cclearBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
setBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$csetBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
bit :: Int -> HostImageCopyFlagBitsEXT
$cbit :: Int -> HostImageCopyFlagBitsEXT
zeroBits :: HostImageCopyFlagBitsEXT
$czeroBits :: HostImageCopyFlagBitsEXT
rotate :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotate :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shift :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshift :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
complement :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$ccomplement :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
xor :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cxor :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
.|. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$c.|. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
.&. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$c.&. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
Bits, Bits HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: HostImageCopyFlagBitsEXT -> Int
$ccountTrailingZeros :: HostImageCopyFlagBitsEXT -> Int
countLeadingZeros :: HostImageCopyFlagBitsEXT -> Int
$ccountLeadingZeros :: HostImageCopyFlagBitsEXT -> Int
finiteBitSize :: HostImageCopyFlagBitsEXT -> Int
$cfiniteBitSize :: HostImageCopyFlagBitsEXT -> Int
FiniteBits)
pattern $bHOST_IMAGE_COPY_MEMCPY_EXT :: HostImageCopyFlagBitsEXT
$mHOST_IMAGE_COPY_MEMCPY_EXT :: forall {r}.
HostImageCopyFlagBitsEXT -> ((# #) -> r) -> ((# #) -> r) -> r
HOST_IMAGE_COPY_MEMCPY_EXT = HostImageCopyFlagBitsEXT 0x00000001
conNameHostImageCopyFlagBitsEXT :: String
conNameHostImageCopyFlagBitsEXT :: String
conNameHostImageCopyFlagBitsEXT = String
"HostImageCopyFlagBitsEXT"
enumPrefixHostImageCopyFlagBitsEXT :: String
enumPrefixHostImageCopyFlagBitsEXT :: String
enumPrefixHostImageCopyFlagBitsEXT = String
"HOST_IMAGE_COPY_MEMCPY_EXT"
showTableHostImageCopyFlagBitsEXT :: [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT :: [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT = [(HostImageCopyFlagBitsEXT
HOST_IMAGE_COPY_MEMCPY_EXT, String
"")]
instance Show HostImageCopyFlagBitsEXT where
showsPrec :: Int -> HostImageCopyFlagBitsEXT -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixHostImageCopyFlagBitsEXT
[(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT
String
conNameHostImageCopyFlagBitsEXT
(\(HostImageCopyFlagBitsEXT Flags
x) -> Flags
x)
(\Flags
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)
instance Read HostImageCopyFlagBitsEXT where
readPrec :: ReadPrec HostImageCopyFlagBitsEXT
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixHostImageCopyFlagBitsEXT
[(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT
String
conNameHostImageCopyFlagBitsEXT
Flags -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT
type ImageSubresource2EXT = ImageSubresource2KHR
type SubresourceLayout2EXT = SubresourceLayout2KHR
type EXT_HOST_IMAGE_COPY_SPEC_VERSION = 1
pattern EXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall a. Integral a => a
$mEXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_HOST_IMAGE_COPY_SPEC_VERSION = 1
type EXT_HOST_IMAGE_COPY_EXTENSION_NAME = "VK_EXT_host_image_copy"
pattern EXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_HOST_IMAGE_COPY_EXTENSION_NAME = "VK_EXT_host_image_copy"