{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_image_drm_format_modifier ( getImageDrmFormatModifierPropertiesEXT
, DrmFormatModifierPropertiesListEXT(..)
, DrmFormatModifierPropertiesEXT(..)
, PhysicalDeviceImageDrmFormatModifierInfoEXT(..)
, ImageDrmFormatModifierListCreateInfoEXT(..)
, ImageDrmFormatModifierExplicitCreateInfoEXT(..)
, ImageDrmFormatModifierPropertiesEXT(..)
, EXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION
, pattern EXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION
, EXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME
, pattern EXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.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 Data.Word (Word32)
import Data.Word (Word64)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Dynamic (DeviceCmds(pVkGetImageDrmFormatModifierPropertiesEXT))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Handles (Image(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SharingMode (SharingMode)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Image (SubresourceLayout)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DRM_FORMAT_MODIFIER_PROPERTIES_LIST_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_EXPLICIT_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_LIST_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_DRM_FORMAT_MODIFIER_INFO_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetImageDrmFormatModifierPropertiesEXT
:: FunPtr (Ptr Device_T -> Image -> Ptr ImageDrmFormatModifierPropertiesEXT -> IO Result) -> Ptr Device_T -> Image -> Ptr ImageDrmFormatModifierPropertiesEXT -> IO Result
getImageDrmFormatModifierPropertiesEXT :: forall io
. (MonadIO io)
=>
Device
->
Image
-> io (ImageDrmFormatModifierPropertiesEXT)
getImageDrmFormatModifierPropertiesEXT :: Device -> Image -> io ImageDrmFormatModifierPropertiesEXT
getImageDrmFormatModifierPropertiesEXT device :: Device
device image :: Image
image = IO ImageDrmFormatModifierPropertiesEXT
-> io ImageDrmFormatModifierPropertiesEXT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageDrmFormatModifierPropertiesEXT
-> io ImageDrmFormatModifierPropertiesEXT)
-> (ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
-> IO ImageDrmFormatModifierPropertiesEXT)
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
-> io ImageDrmFormatModifierPropertiesEXT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
-> IO ImageDrmFormatModifierPropertiesEXT
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
-> io ImageDrmFormatModifierPropertiesEXT)
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
-> io ImageDrmFormatModifierPropertiesEXT
forall a b. (a -> b) -> a -> b
$ do
let vkGetImageDrmFormatModifierPropertiesEXTPtr :: FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
vkGetImageDrmFormatModifierPropertiesEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
pVkGetImageDrmFormatModifierPropertiesEXT (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ())
-> IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
vkGetImageDrmFormatModifierPropertiesEXTPtr FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
-> FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetImageDrmFormatModifierPropertiesEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkGetImageDrmFormatModifierPropertiesEXT' :: Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result
vkGetImageDrmFormatModifierPropertiesEXT' = FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
-> Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result
mkVkGetImageDrmFormatModifierPropertiesEXT FunPtr
(Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result)
vkGetImageDrmFormatModifierPropertiesEXTPtr
"pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
pPProperties <- ((("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT)
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ImageDrmFormatModifierPropertiesEXT =>
(("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ImageDrmFormatModifierPropertiesEXT)
Result
r <- IO Result -> ContT ImageDrmFormatModifierPropertiesEXT IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ImageDrmFormatModifierPropertiesEXT IO Result)
-> IO Result -> ContT ImageDrmFormatModifierPropertiesEXT IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "vkGetImageDrmFormatModifierPropertiesEXT" (Ptr Device_T
-> Image
-> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO Result
vkGetImageDrmFormatModifierPropertiesEXT' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Image
image) ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
pPProperties))
IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ())
-> IO () -> ContT ImageDrmFormatModifierPropertiesEXT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
ImageDrmFormatModifierPropertiesEXT
pProperties <- IO ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageDrmFormatModifierPropertiesEXT "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
pPProperties
ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT
-> ContT
ImageDrmFormatModifierPropertiesEXT
IO
ImageDrmFormatModifierPropertiesEXT
forall a b. (a -> b) -> a -> b
$ (ImageDrmFormatModifierPropertiesEXT
pProperties)
data DrmFormatModifierPropertiesListEXT = DrmFormatModifierPropertiesListEXT
{
DrmFormatModifierPropertiesListEXT -> Word32
drmFormatModifierCount :: Word32
,
DrmFormatModifierPropertiesListEXT
-> Ptr DrmFormatModifierPropertiesEXT
drmFormatModifierProperties :: Ptr DrmFormatModifierPropertiesEXT
}
deriving (Typeable, DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool
(DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool)
-> (DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool)
-> Eq DrmFormatModifierPropertiesListEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool
$c/= :: DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool
== :: DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool
$c== :: DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DrmFormatModifierPropertiesListEXT)
#endif
deriving instance Show DrmFormatModifierPropertiesListEXT
instance ToCStruct DrmFormatModifierPropertiesListEXT where
withCStruct :: DrmFormatModifierPropertiesListEXT
-> (Ptr DrmFormatModifierPropertiesListEXT -> IO b) -> IO b
withCStruct x :: DrmFormatModifierPropertiesListEXT
x f :: Ptr DrmFormatModifierPropertiesListEXT -> IO b
f = Int
-> Int -> (Ptr DrmFormatModifierPropertiesListEXT -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr DrmFormatModifierPropertiesListEXT -> IO b) -> IO b)
-> (Ptr DrmFormatModifierPropertiesListEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr DrmFormatModifierPropertiesListEXT
p -> Ptr DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrmFormatModifierPropertiesListEXT
p DrmFormatModifierPropertiesListEXT
x (Ptr DrmFormatModifierPropertiesListEXT -> IO b
f Ptr DrmFormatModifierPropertiesListEXT
p)
pokeCStruct :: Ptr DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> IO b -> IO b
pokeCStruct p :: Ptr DrmFormatModifierPropertiesListEXT
p DrmFormatModifierPropertiesListEXT{..} f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DRM_FORMAT_MODIFIER_PROPERTIES_LIST_EXT)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
drmFormatModifierCount)
Ptr (Ptr DrmFormatModifierPropertiesEXT)
-> Ptr DrmFormatModifierPropertiesEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT
-> Int -> Ptr (Ptr DrmFormatModifierPropertiesEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr DrmFormatModifierPropertiesEXT))) (Ptr DrmFormatModifierPropertiesEXT
drmFormatModifierProperties)
IO b
f
cStructSize :: Int
cStructSize = 32
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr DrmFormatModifierPropertiesListEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr DrmFormatModifierPropertiesListEXT
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DRM_FORMAT_MODIFIER_PROPERTIES_LIST_EXT)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO b
f
instance FromCStruct DrmFormatModifierPropertiesListEXT where
peekCStruct :: Ptr DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT
peekCStruct p :: Ptr DrmFormatModifierPropertiesListEXT
p = do
Word32
drmFormatModifierCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
Ptr DrmFormatModifierPropertiesEXT
pDrmFormatModifierProperties <- Ptr (Ptr DrmFormatModifierPropertiesEXT)
-> IO (Ptr DrmFormatModifierPropertiesEXT)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr DrmFormatModifierPropertiesEXT) ((Ptr DrmFormatModifierPropertiesListEXT
p Ptr DrmFormatModifierPropertiesListEXT
-> Int -> Ptr (Ptr DrmFormatModifierPropertiesEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr DrmFormatModifierPropertiesEXT)))
DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT)
-> DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT
forall a b. (a -> b) -> a -> b
$ Word32
-> Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesListEXT
DrmFormatModifierPropertiesListEXT
Word32
drmFormatModifierCount Ptr DrmFormatModifierPropertiesEXT
pDrmFormatModifierProperties
instance Storable DrmFormatModifierPropertiesListEXT where
sizeOf :: DrmFormatModifierPropertiesListEXT -> Int
sizeOf ~DrmFormatModifierPropertiesListEXT
_ = 32
alignment :: DrmFormatModifierPropertiesListEXT -> Int
alignment ~DrmFormatModifierPropertiesListEXT
_ = 8
peek :: Ptr DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT
peek = Ptr DrmFormatModifierPropertiesListEXT
-> IO DrmFormatModifierPropertiesListEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> IO ()
poke ptr :: Ptr DrmFormatModifierPropertiesListEXT
ptr poked :: DrmFormatModifierPropertiesListEXT
poked = Ptr DrmFormatModifierPropertiesListEXT
-> DrmFormatModifierPropertiesListEXT -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrmFormatModifierPropertiesListEXT
ptr DrmFormatModifierPropertiesListEXT
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero DrmFormatModifierPropertiesListEXT where
zero :: DrmFormatModifierPropertiesListEXT
zero = Word32
-> Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesListEXT
DrmFormatModifierPropertiesListEXT
Word32
forall a. Zero a => a
zero
Ptr DrmFormatModifierPropertiesEXT
forall a. Zero a => a
zero
data DrmFormatModifierPropertiesEXT = DrmFormatModifierPropertiesEXT
{
DrmFormatModifierPropertiesEXT -> Word64
drmFormatModifier :: Word64
,
DrmFormatModifierPropertiesEXT -> Word32
drmFormatModifierPlaneCount :: Word32
,
DrmFormatModifierPropertiesEXT -> FormatFeatureFlags
drmFormatModifierTilingFeatures :: FormatFeatureFlags
}
deriving (Typeable, DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool
(DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool)
-> (DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool)
-> Eq DrmFormatModifierPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool
$c/= :: DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool
== :: DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool
$c== :: DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DrmFormatModifierPropertiesEXT)
#endif
deriving instance Show DrmFormatModifierPropertiesEXT
instance ToCStruct DrmFormatModifierPropertiesEXT where
withCStruct :: DrmFormatModifierPropertiesEXT
-> (Ptr DrmFormatModifierPropertiesEXT -> IO b) -> IO b
withCStruct x :: DrmFormatModifierPropertiesEXT
x f :: Ptr DrmFormatModifierPropertiesEXT -> IO b
f = Int -> Int -> (Ptr DrmFormatModifierPropertiesEXT -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr DrmFormatModifierPropertiesEXT -> IO b) -> IO b)
-> (Ptr DrmFormatModifierPropertiesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr DrmFormatModifierPropertiesEXT
p -> Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrmFormatModifierPropertiesEXT
p DrmFormatModifierPropertiesEXT
x (Ptr DrmFormatModifierPropertiesEXT -> IO b
f Ptr DrmFormatModifierPropertiesEXT
p)
pokeCStruct :: Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> IO b -> IO b
pokeCStruct p :: Ptr DrmFormatModifierPropertiesEXT
p DrmFormatModifierPropertiesEXT{..} f :: IO b
f = do
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word64)) (Word64
drmFormatModifier)
Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
drmFormatModifierPlaneCount)
Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
drmFormatModifierTilingFeatures)
IO b
f
cStructSize :: Int
cStructSize = 16
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr DrmFormatModifierPropertiesEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr DrmFormatModifierPropertiesEXT
p f :: IO b
f = do
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct DrmFormatModifierPropertiesEXT where
peekCStruct :: Ptr DrmFormatModifierPropertiesEXT
-> IO DrmFormatModifierPropertiesEXT
peekCStruct p :: Ptr DrmFormatModifierPropertiesEXT
p = do
Word64
drmFormatModifier <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word64))
Word32
drmFormatModifierPlaneCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
FormatFeatureFlags
drmFormatModifierTilingFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags ((Ptr DrmFormatModifierPropertiesEXT
p Ptr DrmFormatModifierPropertiesEXT -> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr FormatFeatureFlags))
DrmFormatModifierPropertiesEXT -> IO DrmFormatModifierPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DrmFormatModifierPropertiesEXT
-> IO DrmFormatModifierPropertiesEXT)
-> DrmFormatModifierPropertiesEXT
-> IO DrmFormatModifierPropertiesEXT
forall a b. (a -> b) -> a -> b
$ Word64
-> Word32 -> FormatFeatureFlags -> DrmFormatModifierPropertiesEXT
DrmFormatModifierPropertiesEXT
Word64
drmFormatModifier Word32
drmFormatModifierPlaneCount FormatFeatureFlags
drmFormatModifierTilingFeatures
instance Storable DrmFormatModifierPropertiesEXT where
sizeOf :: DrmFormatModifierPropertiesEXT -> Int
sizeOf ~DrmFormatModifierPropertiesEXT
_ = 16
alignment :: DrmFormatModifierPropertiesEXT -> Int
alignment ~DrmFormatModifierPropertiesEXT
_ = 8
peek :: Ptr DrmFormatModifierPropertiesEXT
-> IO DrmFormatModifierPropertiesEXT
peek = Ptr DrmFormatModifierPropertiesEXT
-> IO DrmFormatModifierPropertiesEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> IO ()
poke ptr :: Ptr DrmFormatModifierPropertiesEXT
ptr poked :: DrmFormatModifierPropertiesEXT
poked = Ptr DrmFormatModifierPropertiesEXT
-> DrmFormatModifierPropertiesEXT -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrmFormatModifierPropertiesEXT
ptr DrmFormatModifierPropertiesEXT
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero DrmFormatModifierPropertiesEXT where
zero :: DrmFormatModifierPropertiesEXT
zero = Word64
-> Word32 -> FormatFeatureFlags -> DrmFormatModifierPropertiesEXT
DrmFormatModifierPropertiesEXT
Word64
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
FormatFeatureFlags
forall a. Zero a => a
zero
data PhysicalDeviceImageDrmFormatModifierInfoEXT = PhysicalDeviceImageDrmFormatModifierInfoEXT
{
PhysicalDeviceImageDrmFormatModifierInfoEXT -> Word64
drmFormatModifier :: Word64
,
PhysicalDeviceImageDrmFormatModifierInfoEXT -> SharingMode
sharingMode :: SharingMode
,
PhysicalDeviceImageDrmFormatModifierInfoEXT -> Vector Word32
queueFamilyIndices :: Vector Word32
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceImageDrmFormatModifierInfoEXT)
#endif
deriving instance Show PhysicalDeviceImageDrmFormatModifierInfoEXT
instance ToCStruct PhysicalDeviceImageDrmFormatModifierInfoEXT where
withCStruct :: PhysicalDeviceImageDrmFormatModifierInfoEXT
-> (Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceImageDrmFormatModifierInfoEXT
x f :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p -> Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p PhysicalDeviceImageDrmFormatModifierInfoEXT
x (Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b
f Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p)
pokeCStruct :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p PhysicalDeviceImageDrmFormatModifierInfoEXT{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_DRM_FORMAT_MODIFIER_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
drmFormatModifier)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SharingMode -> SharingMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SharingMode)) (SharingMode
sharingMode)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
queueFamilyIndices)) :: Word32))
Ptr Word32
pPQueueFamilyIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
queueFamilyIndices)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPQueueFamilyIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
queueFamilyIndices)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Word32))) (Ptr Word32
pPQueueFamilyIndices')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 40
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_DRM_FORMAT_MODIFIER_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SharingMode -> SharingMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SharingMode)) (SharingMode
forall a. Zero a => a
zero)
Ptr Word32
pPQueueFamilyIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPQueueFamilyIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Word32))) (Ptr Word32
pPQueueFamilyIndices')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct PhysicalDeviceImageDrmFormatModifierInfoEXT where
peekCStruct :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> IO PhysicalDeviceImageDrmFormatModifierInfoEXT
peekCStruct p :: Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p = do
Word64
drmFormatModifier <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64))
SharingMode
sharingMode <- Ptr SharingMode -> IO SharingMode
forall a. Storable a => Ptr a -> IO a
peek @SharingMode ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr SharingMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr SharingMode))
Word32
queueFamilyIndexCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28 :: Ptr Word32))
Ptr Word32
pQueueFamilyIndices <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
p Ptr PhysicalDeviceImageDrmFormatModifierInfoEXT
-> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr Word32)))
Vector Word32
pQueueFamilyIndices' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
queueFamilyIndexCount) (\i :: Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pQueueFamilyIndices Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
PhysicalDeviceImageDrmFormatModifierInfoEXT
-> IO PhysicalDeviceImageDrmFormatModifierInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceImageDrmFormatModifierInfoEXT
-> IO PhysicalDeviceImageDrmFormatModifierInfoEXT)
-> PhysicalDeviceImageDrmFormatModifierInfoEXT
-> IO PhysicalDeviceImageDrmFormatModifierInfoEXT
forall a b. (a -> b) -> a -> b
$ Word64
-> SharingMode
-> Vector Word32
-> PhysicalDeviceImageDrmFormatModifierInfoEXT
PhysicalDeviceImageDrmFormatModifierInfoEXT
Word64
drmFormatModifier SharingMode
sharingMode Vector Word32
pQueueFamilyIndices'
instance Zero PhysicalDeviceImageDrmFormatModifierInfoEXT where
zero :: PhysicalDeviceImageDrmFormatModifierInfoEXT
zero = Word64
-> SharingMode
-> Vector Word32
-> PhysicalDeviceImageDrmFormatModifierInfoEXT
PhysicalDeviceImageDrmFormatModifierInfoEXT
Word64
forall a. Zero a => a
zero
SharingMode
forall a. Zero a => a
zero
Vector Word32
forall a. Monoid a => a
mempty
data ImageDrmFormatModifierListCreateInfoEXT = ImageDrmFormatModifierListCreateInfoEXT
{
ImageDrmFormatModifierListCreateInfoEXT -> Vector Word64
drmFormatModifiers :: Vector Word64 }
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageDrmFormatModifierListCreateInfoEXT)
#endif
deriving instance Show ImageDrmFormatModifierListCreateInfoEXT
instance ToCStruct ImageDrmFormatModifierListCreateInfoEXT where
withCStruct :: ImageDrmFormatModifierListCreateInfoEXT
-> (Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b) -> IO b
withCStruct x :: ImageDrmFormatModifierListCreateInfoEXT
x f :: Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b
f = Int
-> Int
-> (Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b) -> IO b)
-> (Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ImageDrmFormatModifierListCreateInfoEXT
p -> Ptr ImageDrmFormatModifierListCreateInfoEXT
-> ImageDrmFormatModifierListCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageDrmFormatModifierListCreateInfoEXT
p ImageDrmFormatModifierListCreateInfoEXT
x (Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b
f Ptr ImageDrmFormatModifierListCreateInfoEXT
p)
pokeCStruct :: Ptr ImageDrmFormatModifierListCreateInfoEXT
-> ImageDrmFormatModifierListCreateInfoEXT -> IO b -> IO b
pokeCStruct p :: Ptr ImageDrmFormatModifierListCreateInfoEXT
p ImageDrmFormatModifierListCreateInfoEXT{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_LIST_CREATE_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word64 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word64 -> Int) -> Vector Word64 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word64
drmFormatModifiers)) :: Word32))
Ptr Word64
pPDrmFormatModifiers' <- ((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64))
-> ((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word64 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word64 ((Vector Word64 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word64
drmFormatModifiers)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word64 -> IO ()) -> Vector Word64 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word64
e -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word64
pPDrmFormatModifiers' Ptr Word64 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) (Word64
e)) (Vector Word64
drmFormatModifiers)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word64) -> Ptr Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT
-> Int -> Ptr (Ptr Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word64))) (Ptr Word64
pPDrmFormatModifiers')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 32
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr ImageDrmFormatModifierListCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr ImageDrmFormatModifierListCreateInfoEXT
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_LIST_CREATE_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Word64
pPDrmFormatModifiers' <- ((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64))
-> ((Ptr Word64 -> IO b) -> IO b) -> ContT b IO (Ptr Word64)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word64 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word64 ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word64 -> IO ()) -> Vector Word64 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word64
e -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word64
pPDrmFormatModifiers' Ptr Word64 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64) (Word64
e)) (Vector Word64
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word64) -> Ptr Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT
-> Int -> Ptr (Ptr Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word64))) (Ptr Word64
pPDrmFormatModifiers')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct ImageDrmFormatModifierListCreateInfoEXT where
peekCStruct :: Ptr ImageDrmFormatModifierListCreateInfoEXT
-> IO ImageDrmFormatModifierListCreateInfoEXT
peekCStruct p :: Ptr ImageDrmFormatModifierListCreateInfoEXT
p = do
Word32
drmFormatModifierCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
Ptr Word64
pDrmFormatModifiers <- Ptr (Ptr Word64) -> IO (Ptr Word64)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word64) ((Ptr ImageDrmFormatModifierListCreateInfoEXT
p Ptr ImageDrmFormatModifierListCreateInfoEXT
-> Int -> Ptr (Ptr Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word64)))
Vector Word64
pDrmFormatModifiers' <- Int -> (Int -> IO Word64) -> IO (Vector Word64)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
drmFormatModifierCount) (\i :: Int
i -> Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr Word64
pDrmFormatModifiers Ptr Word64 -> Int -> Ptr Word64
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word64)))
ImageDrmFormatModifierListCreateInfoEXT
-> IO ImageDrmFormatModifierListCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageDrmFormatModifierListCreateInfoEXT
-> IO ImageDrmFormatModifierListCreateInfoEXT)
-> ImageDrmFormatModifierListCreateInfoEXT
-> IO ImageDrmFormatModifierListCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> ImageDrmFormatModifierListCreateInfoEXT
ImageDrmFormatModifierListCreateInfoEXT
Vector Word64
pDrmFormatModifiers'
instance Zero ImageDrmFormatModifierListCreateInfoEXT where
zero :: ImageDrmFormatModifierListCreateInfoEXT
zero = Vector Word64 -> ImageDrmFormatModifierListCreateInfoEXT
ImageDrmFormatModifierListCreateInfoEXT
Vector Word64
forall a. Monoid a => a
mempty
data ImageDrmFormatModifierExplicitCreateInfoEXT = ImageDrmFormatModifierExplicitCreateInfoEXT
{
ImageDrmFormatModifierExplicitCreateInfoEXT -> Word64
drmFormatModifier :: Word64
,
ImageDrmFormatModifierExplicitCreateInfoEXT
-> Vector SubresourceLayout
planeLayouts :: Vector SubresourceLayout
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageDrmFormatModifierExplicitCreateInfoEXT)
#endif
deriving instance Show ImageDrmFormatModifierExplicitCreateInfoEXT
instance ToCStruct ImageDrmFormatModifierExplicitCreateInfoEXT where
withCStruct :: ImageDrmFormatModifierExplicitCreateInfoEXT
-> (Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b)
-> IO b
withCStruct x :: ImageDrmFormatModifierExplicitCreateInfoEXT
x f :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b
f = Int
-> Int
-> (Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b) -> IO b)
-> (Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p -> Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p ImageDrmFormatModifierExplicitCreateInfoEXT
x (Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b
f Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p)
pokeCStruct :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b -> IO b
pokeCStruct p :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p ImageDrmFormatModifierExplicitCreateInfoEXT{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_EXPLICIT_CREATE_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
drmFormatModifier)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SubresourceLayout -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SubresourceLayout -> Int)
-> Vector SubresourceLayout -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SubresourceLayout
planeLayouts)) :: Word32))
Ptr SubresourceLayout
pPPlaneLayouts' <- ((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout))
-> ((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr SubresourceLayout -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SubresourceLayout ((Vector SubresourceLayout -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SubresourceLayout
planeLayouts)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> SubresourceLayout -> IO ())
-> Vector SubresourceLayout -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SubresourceLayout
e -> Ptr SubresourceLayout -> SubresourceLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SubresourceLayout
pPPlaneLayouts' Ptr SubresourceLayout -> Int -> Ptr SubresourceLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SubresourceLayout) (SubresourceLayout
e)) (Vector SubresourceLayout
planeLayouts)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr SubresourceLayout) -> Ptr SubresourceLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr (Ptr SubresourceLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr SubresourceLayout))) (Ptr SubresourceLayout
pPPlaneLayouts')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 40
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct p :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_EXPLICIT_CREATE_INFO_EXT)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
Ptr SubresourceLayout
pPPlaneLayouts' <- ((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout))
-> ((Ptr SubresourceLayout -> IO b) -> IO b)
-> ContT b IO (Ptr SubresourceLayout)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr SubresourceLayout -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @SubresourceLayout ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> SubresourceLayout -> IO ())
-> Vector SubresourceLayout -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SubresourceLayout
e -> Ptr SubresourceLayout -> SubresourceLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SubresourceLayout
pPPlaneLayouts' Ptr SubresourceLayout -> Int -> Ptr SubresourceLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SubresourceLayout) (SubresourceLayout
e)) (Vector SubresourceLayout
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr SubresourceLayout) -> Ptr SubresourceLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr (Ptr SubresourceLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr SubresourceLayout))) (Ptr SubresourceLayout
pPPlaneLayouts')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct ImageDrmFormatModifierExplicitCreateInfoEXT where
peekCStruct :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> IO ImageDrmFormatModifierExplicitCreateInfoEXT
peekCStruct p :: Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p = do
Word64
drmFormatModifier <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64))
Word32
drmFormatModifierPlaneCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
Ptr SubresourceLayout
pPlaneLayouts <- Ptr (Ptr SubresourceLayout) -> IO (Ptr SubresourceLayout)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SubresourceLayout) ((Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
p Ptr ImageDrmFormatModifierExplicitCreateInfoEXT
-> Int -> Ptr (Ptr SubresourceLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr SubresourceLayout)))
Vector SubresourceLayout
pPlaneLayouts' <- Int
-> (Int -> IO SubresourceLayout) -> IO (Vector SubresourceLayout)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
drmFormatModifierPlaneCount) (\i :: Int
i -> Ptr SubresourceLayout -> IO SubresourceLayout
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SubresourceLayout ((Ptr SubresourceLayout
pPlaneLayouts Ptr SubresourceLayout -> Int -> Ptr SubresourceLayout
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SubresourceLayout)))
ImageDrmFormatModifierExplicitCreateInfoEXT
-> IO ImageDrmFormatModifierExplicitCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageDrmFormatModifierExplicitCreateInfoEXT
-> IO ImageDrmFormatModifierExplicitCreateInfoEXT)
-> ImageDrmFormatModifierExplicitCreateInfoEXT
-> IO ImageDrmFormatModifierExplicitCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ Word64
-> Vector SubresourceLayout
-> ImageDrmFormatModifierExplicitCreateInfoEXT
ImageDrmFormatModifierExplicitCreateInfoEXT
Word64
drmFormatModifier Vector SubresourceLayout
pPlaneLayouts'
instance Zero ImageDrmFormatModifierExplicitCreateInfoEXT where
zero :: ImageDrmFormatModifierExplicitCreateInfoEXT
zero = Word64
-> Vector SubresourceLayout
-> ImageDrmFormatModifierExplicitCreateInfoEXT
ImageDrmFormatModifierExplicitCreateInfoEXT
Word64
forall a. Zero a => a
zero
Vector SubresourceLayout
forall a. Monoid a => a
mempty
data ImageDrmFormatModifierPropertiesEXT = ImageDrmFormatModifierPropertiesEXT
{
ImageDrmFormatModifierPropertiesEXT -> Word64
drmFormatModifier :: Word64 }
deriving (Typeable, ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool
(ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool)
-> (ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool)
-> Eq ImageDrmFormatModifierPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool
$c/= :: ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool
== :: ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool
$c== :: ImageDrmFormatModifierPropertiesEXT
-> ImageDrmFormatModifierPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageDrmFormatModifierPropertiesEXT)
#endif
deriving instance Show ImageDrmFormatModifierPropertiesEXT
instance ToCStruct ImageDrmFormatModifierPropertiesEXT where
withCStruct :: ImageDrmFormatModifierPropertiesEXT
-> (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b)
-> IO b
withCStruct x :: ImageDrmFormatModifierPropertiesEXT
x f :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT) -> IO b
f = Int
-> Int
-> (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b)
-> IO b)
-> (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p -> ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ImageDrmFormatModifierPropertiesEXT
x (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT) -> IO b
f "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p)
pokeCStruct :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT -> IO b -> IO b
pokeCStruct p :: "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ImageDrmFormatModifierPropertiesEXT{..} f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_PROPERTIES_EXT)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
drmFormatModifier)
IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO b -> IO b
pokeZeroCStruct p :: "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_DRM_FORMAT_MODIFIER_PROPERTIES_EXT)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64)) (Word64
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ImageDrmFormatModifierPropertiesEXT where
peekCStruct :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT
peekCStruct p :: "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p = do
Word64
drmFormatModifier <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek @Word64 (("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
p ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word64))
ImageDrmFormatModifierPropertiesEXT
-> IO ImageDrmFormatModifierPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageDrmFormatModifierPropertiesEXT
-> IO ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT
-> IO ImageDrmFormatModifierPropertiesEXT
forall a b. (a -> b) -> a -> b
$ Word64 -> ImageDrmFormatModifierPropertiesEXT
ImageDrmFormatModifierPropertiesEXT
Word64
drmFormatModifier
instance Storable ImageDrmFormatModifierPropertiesEXT where
sizeOf :: ImageDrmFormatModifierPropertiesEXT -> Int
sizeOf ~ImageDrmFormatModifierPropertiesEXT
_ = 24
alignment :: ImageDrmFormatModifierPropertiesEXT -> Int
alignment ~ImageDrmFormatModifierPropertiesEXT
_ = 8
peek :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT
peek = ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> IO ImageDrmFormatModifierPropertiesEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT -> IO ()
poke ptr :: "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
ptr poked :: ImageDrmFormatModifierPropertiesEXT
poked = ("pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT)
-> ImageDrmFormatModifierPropertiesEXT -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr ImageDrmFormatModifierPropertiesEXT
ptr ImageDrmFormatModifierPropertiesEXT
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ImageDrmFormatModifierPropertiesEXT where
zero :: ImageDrmFormatModifierPropertiesEXT
zero = Word64 -> ImageDrmFormatModifierPropertiesEXT
ImageDrmFormatModifierPropertiesEXT
Word64
forall a. Zero a => a
zero
type EXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION = 1
pattern EXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION :: a
$mEXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_IMAGE_DRM_FORMAT_MODIFIER_SPEC_VERSION = 1
type EXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME = "VK_EXT_image_drm_format_modifier"
pattern EXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME :: a
$mEXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_IMAGE_DRM_FORMAT_MODIFIER_EXTENSION_NAME = "VK_EXT_image_drm_format_modifier"