{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax ( PhysicalDeviceSamplerFilterMinmaxProperties(..)
, SamplerReductionModeCreateInfo(..)
, StructureType(..)
, FormatFeatureFlagBits(..)
, FormatFeatureFlags
, SamplerReductionMode(..)
) where
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core12.Enums.SamplerReductionMode (SamplerReductionMode)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLER_FILTER_MINMAX_PROPERTIES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SAMPLER_REDUCTION_MODE_CREATE_INFO))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlagBits(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core12.Enums.SamplerReductionMode (SamplerReductionMode(..))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
data PhysicalDeviceSamplerFilterMinmaxProperties = PhysicalDeviceSamplerFilterMinmaxProperties
{
PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
filterMinmaxSingleComponentFormats :: Bool
,
PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
filterMinmaxImageComponentMapping :: Bool
}
deriving (Typeable, PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
(PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool)
-> (PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool)
-> Eq PhysicalDeviceSamplerFilterMinmaxProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
$c/= :: PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
== :: PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
$c== :: PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSamplerFilterMinmaxProperties)
#endif
deriving instance Show PhysicalDeviceSamplerFilterMinmaxProperties
instance ToCStruct PhysicalDeviceSamplerFilterMinmaxProperties where
withCStruct :: PhysicalDeviceSamplerFilterMinmaxProperties
-> (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceSamplerFilterMinmaxProperties
x f :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b
f = Int
-> Int
-> (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b) -> IO b)
-> (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p -> Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p PhysicalDeviceSamplerFilterMinmaxProperties
x (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b
f Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p)
pokeCStruct :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p PhysicalDeviceSamplerFilterMinmaxProperties{..} f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLER_FILTER_MINMAX_PROPERTIES)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
filterMinmaxSingleComponentFormats))
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
filterMinmaxImageComponentMapping))
IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLER_FILTER_MINMAX_PROPERTIES)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceSamplerFilterMinmaxProperties where
peekCStruct :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties
peekCStruct p :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p = do
Bool32
filterMinmaxSingleComponentFormats <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
Bool32
filterMinmaxImageComponentMapping <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties)
-> PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PhysicalDeviceSamplerFilterMinmaxProperties
PhysicalDeviceSamplerFilterMinmaxProperties
(Bool32 -> Bool
bool32ToBool Bool32
filterMinmaxSingleComponentFormats) (Bool32 -> Bool
bool32ToBool Bool32
filterMinmaxImageComponentMapping)
instance Storable PhysicalDeviceSamplerFilterMinmaxProperties where
sizeOf :: PhysicalDeviceSamplerFilterMinmaxProperties -> Int
sizeOf ~PhysicalDeviceSamplerFilterMinmaxProperties
_ = 24
alignment :: PhysicalDeviceSamplerFilterMinmaxProperties -> Int
alignment ~PhysicalDeviceSamplerFilterMinmaxProperties
_ = 8
peek :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties
peek = Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> IO PhysicalDeviceSamplerFilterMinmaxProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> IO ()
poke ptr :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties
ptr poked :: PhysicalDeviceSamplerFilterMinmaxProperties
poked = Ptr PhysicalDeviceSamplerFilterMinmaxProperties
-> PhysicalDeviceSamplerFilterMinmaxProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSamplerFilterMinmaxProperties
ptr PhysicalDeviceSamplerFilterMinmaxProperties
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceSamplerFilterMinmaxProperties where
zero :: PhysicalDeviceSamplerFilterMinmaxProperties
zero = Bool -> Bool -> PhysicalDeviceSamplerFilterMinmaxProperties
PhysicalDeviceSamplerFilterMinmaxProperties
Bool
forall a. Zero a => a
zero
Bool
forall a. Zero a => a
zero
data SamplerReductionModeCreateInfo = SamplerReductionModeCreateInfo
{
SamplerReductionModeCreateInfo -> SamplerReductionMode
reductionMode :: SamplerReductionMode }
deriving (Typeable, SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool
(SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool)
-> (SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool)
-> Eq SamplerReductionModeCreateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool
$c/= :: SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool
== :: SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool
$c== :: SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SamplerReductionModeCreateInfo)
#endif
deriving instance Show SamplerReductionModeCreateInfo
instance ToCStruct SamplerReductionModeCreateInfo where
withCStruct :: SamplerReductionModeCreateInfo
-> (Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b
withCStruct x :: SamplerReductionModeCreateInfo
x f :: Ptr SamplerReductionModeCreateInfo -> IO b
f = Int -> Int -> (Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b)
-> (Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SamplerReductionModeCreateInfo
p -> Ptr SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SamplerReductionModeCreateInfo
p SamplerReductionModeCreateInfo
x (Ptr SamplerReductionModeCreateInfo -> IO b
f Ptr SamplerReductionModeCreateInfo
p)
pokeCStruct :: Ptr SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr SamplerReductionModeCreateInfo
p SamplerReductionModeCreateInfo{..} f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_REDUCTION_MODE_CREATE_INFO)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr SamplerReductionMode -> SamplerReductionMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo
-> Int -> Ptr SamplerReductionMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SamplerReductionMode)) (SamplerReductionMode
reductionMode)
IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr SamplerReductionModeCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SamplerReductionModeCreateInfo
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_REDUCTION_MODE_CREATE_INFO)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
Ptr SamplerReductionMode -> SamplerReductionMode -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo
-> Int -> Ptr SamplerReductionMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SamplerReductionMode)) (SamplerReductionMode
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct SamplerReductionModeCreateInfo where
peekCStruct :: Ptr SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo
peekCStruct p :: Ptr SamplerReductionModeCreateInfo
p = do
SamplerReductionMode
reductionMode <- Ptr SamplerReductionMode -> IO SamplerReductionMode
forall a. Storable a => Ptr a -> IO a
peek @SamplerReductionMode ((Ptr SamplerReductionModeCreateInfo
p Ptr SamplerReductionModeCreateInfo
-> Int -> Ptr SamplerReductionMode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr SamplerReductionMode))
SamplerReductionModeCreateInfo -> IO SamplerReductionModeCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo)
-> SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo
forall a b. (a -> b) -> a -> b
$ SamplerReductionMode -> SamplerReductionModeCreateInfo
SamplerReductionModeCreateInfo
SamplerReductionMode
reductionMode
instance Storable SamplerReductionModeCreateInfo where
sizeOf :: SamplerReductionModeCreateInfo -> Int
sizeOf ~SamplerReductionModeCreateInfo
_ = 24
alignment :: SamplerReductionModeCreateInfo -> Int
alignment ~SamplerReductionModeCreateInfo
_ = 8
peek :: Ptr SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo
peek = Ptr SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> IO ()
poke ptr :: Ptr SamplerReductionModeCreateInfo
ptr poked :: SamplerReductionModeCreateInfo
poked = Ptr SamplerReductionModeCreateInfo
-> SamplerReductionModeCreateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SamplerReductionModeCreateInfo
ptr SamplerReductionModeCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero SamplerReductionModeCreateInfo where
zero :: SamplerReductionModeCreateInfo
zero = SamplerReductionMode -> SamplerReductionModeCreateInfo
SamplerReductionModeCreateInfo
SamplerReductionMode
forall a. Zero a => a
zero