{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_filter_cubic ( PhysicalDeviceImageViewImageFormatInfoEXT(..)
, FilterCubicImageViewImageFormatPropertiesEXT(..)
, EXT_FILTER_CUBIC_SPEC_VERSION
, pattern EXT_FILTER_CUBIC_SPEC_VERSION
, EXT_FILTER_CUBIC_EXTENSION_NAME
, pattern EXT_FILTER_CUBIC_EXTENSION_NAME
) 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.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.ImageViewType (ImageViewType)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FILTER_CUBIC_IMAGE_VIEW_IMAGE_FORMAT_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_VIEW_IMAGE_FORMAT_INFO_EXT))
data PhysicalDeviceImageViewImageFormatInfoEXT = PhysicalDeviceImageViewImageFormatInfoEXT
{
PhysicalDeviceImageViewImageFormatInfoEXT -> ImageViewType
imageViewType :: ImageViewType }
deriving (Typeable, PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> Bool
$c/= :: PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> Bool
== :: PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> Bool
$c== :: PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceImageViewImageFormatInfoEXT)
#endif
deriving instance Show PhysicalDeviceImageViewImageFormatInfoEXT
instance ToCStruct PhysicalDeviceImageViewImageFormatInfoEXT where
withCStruct :: forall b.
PhysicalDeviceImageViewImageFormatInfoEXT
-> (Ptr PhysicalDeviceImageViewImageFormatInfoEXT -> IO b) -> IO b
withCStruct PhysicalDeviceImageViewImageFormatInfoEXT
x Ptr PhysicalDeviceImageViewImageFormatInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p PhysicalDeviceImageViewImageFormatInfoEXT
x (Ptr PhysicalDeviceImageViewImageFormatInfoEXT -> IO b
f Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p PhysicalDeviceImageViewImageFormatInfoEXT{ImageViewType
imageViewType :: ImageViewType
$sel:imageViewType:PhysicalDeviceImageViewImageFormatInfoEXT :: PhysicalDeviceImageViewImageFormatInfoEXT -> ImageViewType
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_VIEW_IMAGE_FORMAT_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageViewImageFormatInfoEXT
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 PhysicalDeviceImageViewImageFormatInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageViewType)) (ImageViewType
imageViewType)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceImageViewImageFormatInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGE_VIEW_IMAGE_FORMAT_INFO_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImageViewImageFormatInfoEXT
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 PhysicalDeviceImageViewImageFormatInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageViewType)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceImageViewImageFormatInfoEXT where
peekCStruct :: Ptr PhysicalDeviceImageViewImageFormatInfoEXT
-> IO PhysicalDeviceImageViewImageFormatInfoEXT
peekCStruct Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p = do
ImageViewType
imageViewType <- forall a. Storable a => Ptr a -> IO a
peek @ImageViewType ((Ptr PhysicalDeviceImageViewImageFormatInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageViewType))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageViewType -> PhysicalDeviceImageViewImageFormatInfoEXT
PhysicalDeviceImageViewImageFormatInfoEXT
ImageViewType
imageViewType
instance Storable PhysicalDeviceImageViewImageFormatInfoEXT where
sizeOf :: PhysicalDeviceImageViewImageFormatInfoEXT -> Int
sizeOf ~PhysicalDeviceImageViewImageFormatInfoEXT
_ = Int
24
alignment :: PhysicalDeviceImageViewImageFormatInfoEXT -> Int
alignment ~PhysicalDeviceImageViewImageFormatInfoEXT
_ = Int
8
peek :: Ptr PhysicalDeviceImageViewImageFormatInfoEXT
-> IO PhysicalDeviceImageViewImageFormatInfoEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceImageViewImageFormatInfoEXT
-> PhysicalDeviceImageViewImageFormatInfoEXT -> IO ()
poke Ptr PhysicalDeviceImageViewImageFormatInfoEXT
ptr PhysicalDeviceImageViewImageFormatInfoEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImageViewImageFormatInfoEXT
ptr PhysicalDeviceImageViewImageFormatInfoEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceImageViewImageFormatInfoEXT where
zero :: PhysicalDeviceImageViewImageFormatInfoEXT
zero = ImageViewType -> PhysicalDeviceImageViewImageFormatInfoEXT
PhysicalDeviceImageViewImageFormatInfoEXT
forall a. Zero a => a
zero
data FilterCubicImageViewImageFormatPropertiesEXT = FilterCubicImageViewImageFormatPropertiesEXT
{
FilterCubicImageViewImageFormatPropertiesEXT -> Bool
filterCubic :: Bool
,
FilterCubicImageViewImageFormatPropertiesEXT -> Bool
filterCubicMinmax :: Bool
}
deriving (Typeable, FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> Bool
$c/= :: FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> Bool
== :: FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> Bool
$c== :: FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FilterCubicImageViewImageFormatPropertiesEXT)
#endif
deriving instance Show FilterCubicImageViewImageFormatPropertiesEXT
instance ToCStruct FilterCubicImageViewImageFormatPropertiesEXT where
withCStruct :: forall b.
FilterCubicImageViewImageFormatPropertiesEXT
-> (Ptr FilterCubicImageViewImageFormatPropertiesEXT -> IO b)
-> IO b
withCStruct FilterCubicImageViewImageFormatPropertiesEXT
x Ptr FilterCubicImageViewImageFormatPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr FilterCubicImageViewImageFormatPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FilterCubicImageViewImageFormatPropertiesEXT
p FilterCubicImageViewImageFormatPropertiesEXT
x (Ptr FilterCubicImageViewImageFormatPropertiesEXT -> IO b
f Ptr FilterCubicImageViewImageFormatPropertiesEXT
p)
pokeCStruct :: forall b.
Ptr FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr FilterCubicImageViewImageFormatPropertiesEXT
p FilterCubicImageViewImageFormatPropertiesEXT{Bool
filterCubicMinmax :: Bool
filterCubic :: Bool
$sel:filterCubicMinmax:FilterCubicImageViewImageFormatPropertiesEXT :: FilterCubicImageViewImageFormatPropertiesEXT -> Bool
$sel:filterCubic:FilterCubicImageViewImageFormatPropertiesEXT :: FilterCubicImageViewImageFormatPropertiesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FILTER_CUBIC_IMAGE_VIEW_IMAGE_FORMAT_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
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 FilterCubicImageViewImageFormatPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
filterCubic))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
filterCubicMinmax))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr FilterCubicImageViewImageFormatPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr FilterCubicImageViewImageFormatPropertiesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FILTER_CUBIC_IMAGE_VIEW_IMAGE_FORMAT_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
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 FilterCubicImageViewImageFormatPropertiesEXT
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 FilterCubicImageViewImageFormatPropertiesEXT
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 FilterCubicImageViewImageFormatPropertiesEXT where
peekCStruct :: Ptr FilterCubicImageViewImageFormatPropertiesEXT
-> IO FilterCubicImageViewImageFormatPropertiesEXT
peekCStruct Ptr FilterCubicImageViewImageFormatPropertiesEXT
p = do
Bool32
filterCubic <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
filterCubicMinmax <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr FilterCubicImageViewImageFormatPropertiesEXT
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 -> FilterCubicImageViewImageFormatPropertiesEXT
FilterCubicImageViewImageFormatPropertiesEXT
(Bool32 -> Bool
bool32ToBool Bool32
filterCubic) (Bool32 -> Bool
bool32ToBool Bool32
filterCubicMinmax)
instance Storable FilterCubicImageViewImageFormatPropertiesEXT where
sizeOf :: FilterCubicImageViewImageFormatPropertiesEXT -> Int
sizeOf ~FilterCubicImageViewImageFormatPropertiesEXT
_ = Int
24
alignment :: FilterCubicImageViewImageFormatPropertiesEXT -> Int
alignment ~FilterCubicImageViewImageFormatPropertiesEXT
_ = Int
8
peek :: Ptr FilterCubicImageViewImageFormatPropertiesEXT
-> IO FilterCubicImageViewImageFormatPropertiesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr FilterCubicImageViewImageFormatPropertiesEXT
-> FilterCubicImageViewImageFormatPropertiesEXT -> IO ()
poke Ptr FilterCubicImageViewImageFormatPropertiesEXT
ptr FilterCubicImageViewImageFormatPropertiesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FilterCubicImageViewImageFormatPropertiesEXT
ptr FilterCubicImageViewImageFormatPropertiesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero FilterCubicImageViewImageFormatPropertiesEXT where
zero :: FilterCubicImageViewImageFormatPropertiesEXT
zero = Bool -> Bool -> FilterCubicImageViewImageFormatPropertiesEXT
FilterCubicImageViewImageFormatPropertiesEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type EXT_FILTER_CUBIC_SPEC_VERSION = 3
pattern EXT_FILTER_CUBIC_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_FILTER_CUBIC_SPEC_VERSION :: forall a. Integral a => a
$mEXT_FILTER_CUBIC_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_FILTER_CUBIC_SPEC_VERSION = 3
type EXT_FILTER_CUBIC_EXTENSION_NAME = "VK_EXT_filter_cubic"
pattern EXT_FILTER_CUBIC_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_FILTER_CUBIC_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_FILTER_CUBIC_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_FILTER_CUBIC_EXTENSION_NAME = "VK_EXT_filter_cubic"