{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_image_sliced_view_of_3d ( ImageViewSlicedCreateInfoEXT(..)
, PhysicalDeviceImageSlicedViewOf3DFeaturesEXT(..)
, EXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION
, pattern EXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION
, EXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME
, pattern EXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME
, REMAINING_3D_SLICES_EXT
, pattern REMAINING_3D_SLICES_EXT
) where
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_VIEW_SLICED_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_SLICED_VIEW_OF_3D_FEATURES_EXT))
import Vulkan.Core10.APIConstants (REMAINING_3D_SLICES_EXT)
import Vulkan.Core10.APIConstants (pattern REMAINING_3D_SLICES_EXT)
data ImageViewSlicedCreateInfoEXT = ImageViewSlicedCreateInfoEXT
{
ImageViewSlicedCreateInfoEXT -> Word32
sliceOffset :: Word32
,
ImageViewSlicedCreateInfoEXT -> Word32
sliceCount :: Word32
}
deriving (Typeable, ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> Bool
$c/= :: ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> Bool
== :: ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> Bool
$c== :: ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageViewSlicedCreateInfoEXT)
#endif
deriving instance Show ImageViewSlicedCreateInfoEXT
instance ToCStruct ImageViewSlicedCreateInfoEXT where
withCStruct :: forall b.
ImageViewSlicedCreateInfoEXT
-> (Ptr ImageViewSlicedCreateInfoEXT -> IO b) -> IO b
withCStruct ImageViewSlicedCreateInfoEXT
x Ptr ImageViewSlicedCreateInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr ImageViewSlicedCreateInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageViewSlicedCreateInfoEXT
p ImageViewSlicedCreateInfoEXT
x (Ptr ImageViewSlicedCreateInfoEXT -> IO b
f Ptr ImageViewSlicedCreateInfoEXT
p)
pokeCStruct :: forall b.
Ptr ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr ImageViewSlicedCreateInfoEXT
p ImageViewSlicedCreateInfoEXT{Word32
sliceCount :: Word32
sliceOffset :: Word32
$sel:sliceCount:ImageViewSlicedCreateInfoEXT :: ImageViewSlicedCreateInfoEXT -> Word32
$sel:sliceOffset:ImageViewSlicedCreateInfoEXT :: ImageViewSlicedCreateInfoEXT -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_SLICED_CREATE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
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 ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
sliceOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
sliceCount)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr ImageViewSlicedCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr ImageViewSlicedCreateInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_VIEW_SLICED_CREATE_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
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 ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ImageViewSlicedCreateInfoEXT where
peekCStruct :: Ptr ImageViewSlicedCreateInfoEXT -> IO ImageViewSlicedCreateInfoEXT
peekCStruct Ptr ImageViewSlicedCreateInfoEXT
p = do
Word32
sliceOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Word32
sliceCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageViewSlicedCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> ImageViewSlicedCreateInfoEXT
ImageViewSlicedCreateInfoEXT
Word32
sliceOffset Word32
sliceCount
instance Storable ImageViewSlicedCreateInfoEXT where
sizeOf :: ImageViewSlicedCreateInfoEXT -> Int
sizeOf ~ImageViewSlicedCreateInfoEXT
_ = Int
24
alignment :: ImageViewSlicedCreateInfoEXT -> Int
alignment ~ImageViewSlicedCreateInfoEXT
_ = Int
8
peek :: Ptr ImageViewSlicedCreateInfoEXT -> IO ImageViewSlicedCreateInfoEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr ImageViewSlicedCreateInfoEXT
-> ImageViewSlicedCreateInfoEXT -> IO ()
poke Ptr ImageViewSlicedCreateInfoEXT
ptr ImageViewSlicedCreateInfoEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageViewSlicedCreateInfoEXT
ptr ImageViewSlicedCreateInfoEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ImageViewSlicedCreateInfoEXT where
zero :: ImageViewSlicedCreateInfoEXT
zero = Word32 -> Word32 -> ImageViewSlicedCreateInfoEXT
ImageViewSlicedCreateInfoEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceImageSlicedViewOf3DFeaturesEXT = PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
{
PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
imageSlicedViewOf3D :: Bool }
deriving (Typeable, PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
$c/= :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
== :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
$c== :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceImageSlicedViewOf3DFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
instance ToCStruct PhysicalDeviceImageSlicedViewOf3DFeaturesEXT where
withCStruct :: forall b.
PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> (Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
x Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
x (Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO b
f Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p PhysicalDeviceImageSlicedViewOf3DFeaturesEXT{Bool
imageSlicedViewOf3D :: Bool
$sel:imageSlicedViewOf3D:PhysicalDeviceImageSlicedViewOf3DFeaturesEXT :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_SLICED_VIEW_OF_3D_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
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 PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imageSlicedViewOf3D))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_SLICED_VIEW_OF_3D_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
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 PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
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 PhysicalDeviceImageSlicedViewOf3DFeaturesEXT where
peekCStruct :: Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> IO PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
peekCStruct Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
p = do
Bool32
imageSlicedViewOf3D <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
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 -> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
(Bool32 -> Bool
bool32ToBool Bool32
imageSlicedViewOf3D)
instance Storable PhysicalDeviceImageSlicedViewOf3DFeaturesEXT where
sizeOf :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Int
sizeOf ~PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
_ = Int
24
alignment :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> Int
alignment ~PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
_ = Int
8
peek :: Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> IO PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
-> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT -> IO ()
poke Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
ptr PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceImageSlicedViewOf3DFeaturesEXT where
zero :: PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
zero = Bool -> PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
PhysicalDeviceImageSlicedViewOf3DFeaturesEXT
forall a. Zero a => a
zero
type EXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION = 1
pattern EXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION :: forall a. Integral a => a
$mEXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_IMAGE_SLICED_VIEW_OF_3D_SPEC_VERSION = 1
type EXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME = "VK_EXT_image_sliced_view_of_3d"
pattern EXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_IMAGE_SLICED_VIEW_OF_3D_EXTENSION_NAME = "VK_EXT_image_sliced_view_of_3d"