{-# language CPP #-}
module Vulkan.Extensions.VK_NV_coverage_reduction_mode ( getPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV
, PhysicalDeviceCoverageReductionModeFeaturesNV(..)
, PipelineCoverageReductionStateCreateInfoNV(..)
, FramebufferMixedSamplesCombinationNV(..)
, PipelineCoverageReductionStateCreateFlagsNV(..)
, CoverageReductionModeNV( COVERAGE_REDUCTION_MODE_MERGE_NV
, COVERAGE_REDUCTION_MODE_TRUNCATE_NV
, ..
)
, NV_COVERAGE_REDUCTION_MODE_SPEC_VERSION
, pattern NV_COVERAGE_REDUCTION_MODE_SPEC_VERSION
, NV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME
, pattern NV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME
) where
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FRAMEBUFFER_MIXED_SAMPLES_COMBINATION_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_COVERAGE_REDUCTION_MODE_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_COVERAGE_REDUCTION_STATE_CREATE_INFO_NV))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV
:: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr FramebufferMixedSamplesCombinationNV -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr FramebufferMixedSamplesCombinationNV -> IO Result
getPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (Result, ("combinations" ::: Vector FramebufferMixedSamplesCombinationNV))
getPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io
(Result,
"combinations" ::: Vector FramebufferMixedSamplesCombinationNV)
getPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNVPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result)
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNVPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result)
pVkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result)
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV' :: Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV' = FunPtr
(Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result)
-> Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result
mkVkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV FunPtr
(Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result)
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNVPtr
let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
"pCombinationCount" ::: Ptr Word32
pPCombinationCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV" (Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV'
Ptr PhysicalDevice_T
physicalDevice'
("pCombinationCount" ::: Ptr Word32
pPCombinationCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pCombinationCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pCombinationCount" ::: Ptr Word32
pPCombinationCount
"pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
pPCombinations <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @FramebufferMixedSamplesCombinationNV ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pCombinationCount)) forall a. Num a => a -> a -> a
* Int
32)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
pPCombinations forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
32) :: Ptr FramebufferMixedSamplesCombinationNV) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pCombinationCount)) forall a. Num a => a -> a -> a
- Int
1]
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV" (Ptr PhysicalDevice_T
-> ("pCombinationCount" ::: Ptr Word32)
-> ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO Result
vkGetPhysicalDeviceSupportedFramebufferMixedSamplesCombinationsNV'
Ptr PhysicalDevice_T
physicalDevice'
("pCombinationCount" ::: Ptr Word32
pPCombinationCount)
(("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
pPCombinations)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pCombinationCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pCombinationCount" ::: Ptr Word32
pPCombinationCount
"combinations" ::: Vector FramebufferMixedSamplesCombinationNV
pCombinations' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pCombinationCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @FramebufferMixedSamplesCombinationNV ((("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
pPCombinations) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
32 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr FramebufferMixedSamplesCombinationNV)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "combinations" ::: Vector FramebufferMixedSamplesCombinationNV
pCombinations')
data PhysicalDeviceCoverageReductionModeFeaturesNV = PhysicalDeviceCoverageReductionModeFeaturesNV
{
PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
coverageReductionMode :: Bool }
deriving (Typeable, PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
$c/= :: PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
== :: PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
$c== :: PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCoverageReductionModeFeaturesNV)
#endif
deriving instance Show PhysicalDeviceCoverageReductionModeFeaturesNV
instance ToCStruct PhysicalDeviceCoverageReductionModeFeaturesNV where
withCStruct :: forall b.
PhysicalDeviceCoverageReductionModeFeaturesNV
-> (Ptr PhysicalDeviceCoverageReductionModeFeaturesNV -> IO b)
-> IO b
withCStruct PhysicalDeviceCoverageReductionModeFeaturesNV
x Ptr PhysicalDeviceCoverageReductionModeFeaturesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p PhysicalDeviceCoverageReductionModeFeaturesNV
x (Ptr PhysicalDeviceCoverageReductionModeFeaturesNV -> IO b
f Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p PhysicalDeviceCoverageReductionModeFeaturesNV{Bool
coverageReductionMode :: Bool
$sel:coverageReductionMode:PhysicalDeviceCoverageReductionModeFeaturesNV :: PhysicalDeviceCoverageReductionModeFeaturesNV -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COVERAGE_REDUCTION_MODE_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
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 PhysicalDeviceCoverageReductionModeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
coverageReductionMode))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCoverageReductionModeFeaturesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COVERAGE_REDUCTION_MODE_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
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 PhysicalDeviceCoverageReductionModeFeaturesNV
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 PhysicalDeviceCoverageReductionModeFeaturesNV where
peekCStruct :: Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
-> IO PhysicalDeviceCoverageReductionModeFeaturesNV
peekCStruct Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
p = do
Bool32
coverageReductionMode <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
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 -> PhysicalDeviceCoverageReductionModeFeaturesNV
PhysicalDeviceCoverageReductionModeFeaturesNV
(Bool32 -> Bool
bool32ToBool Bool32
coverageReductionMode)
instance Storable PhysicalDeviceCoverageReductionModeFeaturesNV where
sizeOf :: PhysicalDeviceCoverageReductionModeFeaturesNV -> Int
sizeOf ~PhysicalDeviceCoverageReductionModeFeaturesNV
_ = Int
24
alignment :: PhysicalDeviceCoverageReductionModeFeaturesNV -> Int
alignment ~PhysicalDeviceCoverageReductionModeFeaturesNV
_ = Int
8
peek :: Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
-> IO PhysicalDeviceCoverageReductionModeFeaturesNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
-> PhysicalDeviceCoverageReductionModeFeaturesNV -> IO ()
poke Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
ptr PhysicalDeviceCoverageReductionModeFeaturesNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCoverageReductionModeFeaturesNV
ptr PhysicalDeviceCoverageReductionModeFeaturesNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceCoverageReductionModeFeaturesNV where
zero :: PhysicalDeviceCoverageReductionModeFeaturesNV
zero = Bool -> PhysicalDeviceCoverageReductionModeFeaturesNV
PhysicalDeviceCoverageReductionModeFeaturesNV
forall a. Zero a => a
zero
data PipelineCoverageReductionStateCreateInfoNV = PipelineCoverageReductionStateCreateInfoNV
{
PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateFlagsNV
flags :: PipelineCoverageReductionStateCreateFlagsNV
,
PipelineCoverageReductionStateCreateInfoNV
-> CoverageReductionModeNV
coverageReductionMode :: CoverageReductionModeNV
}
deriving (Typeable, PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> Bool
$c/= :: PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> Bool
== :: PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> Bool
$c== :: PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineCoverageReductionStateCreateInfoNV)
#endif
deriving instance Show PipelineCoverageReductionStateCreateInfoNV
instance ToCStruct PipelineCoverageReductionStateCreateInfoNV where
withCStruct :: forall b.
PipelineCoverageReductionStateCreateInfoNV
-> (Ptr PipelineCoverageReductionStateCreateInfoNV -> IO b) -> IO b
withCStruct PipelineCoverageReductionStateCreateInfoNV
x Ptr PipelineCoverageReductionStateCreateInfoNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PipelineCoverageReductionStateCreateInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineCoverageReductionStateCreateInfoNV
p PipelineCoverageReductionStateCreateInfoNV
x (Ptr PipelineCoverageReductionStateCreateInfoNV -> IO b
f Ptr PipelineCoverageReductionStateCreateInfoNV
p)
pokeCStruct :: forall b.
Ptr PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> IO b -> IO b
pokeCStruct Ptr PipelineCoverageReductionStateCreateInfoNV
p PipelineCoverageReductionStateCreateInfoNV{CoverageReductionModeNV
PipelineCoverageReductionStateCreateFlagsNV
coverageReductionMode :: CoverageReductionModeNV
flags :: PipelineCoverageReductionStateCreateFlagsNV
$sel:coverageReductionMode:PipelineCoverageReductionStateCreateInfoNV :: PipelineCoverageReductionStateCreateInfoNV
-> CoverageReductionModeNV
$sel:flags:PipelineCoverageReductionStateCreateInfoNV :: PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateFlagsNV
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_COVERAGE_REDUCTION_STATE_CREATE_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCoverageReductionStateCreateInfoNV
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 PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineCoverageReductionStateCreateFlagsNV)) (PipelineCoverageReductionStateCreateFlagsNV
flags)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CoverageReductionModeNV)) (CoverageReductionModeNV
coverageReductionMode)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PipelineCoverageReductionStateCreateInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr PipelineCoverageReductionStateCreateInfoNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_COVERAGE_REDUCTION_STATE_CREATE_INFO_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCoverageReductionStateCreateInfoNV
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 PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CoverageReductionModeNV)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PipelineCoverageReductionStateCreateInfoNV where
peekCStruct :: Ptr PipelineCoverageReductionStateCreateInfoNV
-> IO PipelineCoverageReductionStateCreateInfoNV
peekCStruct Ptr PipelineCoverageReductionStateCreateInfoNV
p = do
PipelineCoverageReductionStateCreateFlagsNV
flags <- forall a. Storable a => Ptr a -> IO a
peek @PipelineCoverageReductionStateCreateFlagsNV ((Ptr PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineCoverageReductionStateCreateFlagsNV))
CoverageReductionModeNV
coverageReductionMode <- forall a. Storable a => Ptr a -> IO a
peek @CoverageReductionModeNV ((Ptr PipelineCoverageReductionStateCreateInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CoverageReductionModeNV))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PipelineCoverageReductionStateCreateFlagsNV
-> CoverageReductionModeNV
-> PipelineCoverageReductionStateCreateInfoNV
PipelineCoverageReductionStateCreateInfoNV
PipelineCoverageReductionStateCreateFlagsNV
flags CoverageReductionModeNV
coverageReductionMode
instance Storable PipelineCoverageReductionStateCreateInfoNV where
sizeOf :: PipelineCoverageReductionStateCreateInfoNV -> Int
sizeOf ~PipelineCoverageReductionStateCreateInfoNV
_ = Int
24
alignment :: PipelineCoverageReductionStateCreateInfoNV -> Int
alignment ~PipelineCoverageReductionStateCreateInfoNV
_ = Int
8
peek :: Ptr PipelineCoverageReductionStateCreateInfoNV
-> IO PipelineCoverageReductionStateCreateInfoNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PipelineCoverageReductionStateCreateInfoNV
-> PipelineCoverageReductionStateCreateInfoNV -> IO ()
poke Ptr PipelineCoverageReductionStateCreateInfoNV
ptr PipelineCoverageReductionStateCreateInfoNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineCoverageReductionStateCreateInfoNV
ptr PipelineCoverageReductionStateCreateInfoNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PipelineCoverageReductionStateCreateInfoNV where
zero :: PipelineCoverageReductionStateCreateInfoNV
zero = PipelineCoverageReductionStateCreateFlagsNV
-> CoverageReductionModeNV
-> PipelineCoverageReductionStateCreateInfoNV
PipelineCoverageReductionStateCreateInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data FramebufferMixedSamplesCombinationNV = FramebufferMixedSamplesCombinationNV
{
FramebufferMixedSamplesCombinationNV -> CoverageReductionModeNV
coverageReductionMode :: CoverageReductionModeNV
,
FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
rasterizationSamples :: SampleCountFlagBits
,
FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
depthStencilSamples :: SampleCountFlags
,
FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
colorSamples :: SampleCountFlags
}
deriving (Typeable, FramebufferMixedSamplesCombinationNV
-> FramebufferMixedSamplesCombinationNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FramebufferMixedSamplesCombinationNV
-> FramebufferMixedSamplesCombinationNV -> Bool
$c/= :: FramebufferMixedSamplesCombinationNV
-> FramebufferMixedSamplesCombinationNV -> Bool
== :: FramebufferMixedSamplesCombinationNV
-> FramebufferMixedSamplesCombinationNV -> Bool
$c== :: FramebufferMixedSamplesCombinationNV
-> FramebufferMixedSamplesCombinationNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FramebufferMixedSamplesCombinationNV)
#endif
deriving instance Show FramebufferMixedSamplesCombinationNV
instance ToCStruct FramebufferMixedSamplesCombinationNV where
withCStruct :: forall b.
FramebufferMixedSamplesCombinationNV
-> (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO b)
-> IO b
withCStruct FramebufferMixedSamplesCombinationNV
x ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p FramebufferMixedSamplesCombinationNV
x (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO b
f "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p)
pokeCStruct :: forall b.
("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> FramebufferMixedSamplesCombinationNV -> IO b -> IO b
pokeCStruct "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p FramebufferMixedSamplesCombinationNV{SampleCountFlagBits
CoverageReductionModeNV
colorSamples :: SampleCountFlagBits
depthStencilSamples :: SampleCountFlagBits
rasterizationSamples :: SampleCountFlagBits
coverageReductionMode :: CoverageReductionModeNV
$sel:colorSamples:FramebufferMixedSamplesCombinationNV :: FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
$sel:depthStencilSamples:FramebufferMixedSamplesCombinationNV :: FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
$sel:rasterizationSamples:FramebufferMixedSamplesCombinationNV :: FramebufferMixedSamplesCombinationNV -> SampleCountFlagBits
$sel:coverageReductionMode:FramebufferMixedSamplesCombinationNV :: FramebufferMixedSamplesCombinationNV -> CoverageReductionModeNV
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_MIXED_SAMPLES_COMBINATION_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
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 (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CoverageReductionModeNV)) (CoverageReductionModeNV
coverageReductionMode)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr SampleCountFlagBits)) (SampleCountFlagBits
rasterizationSamples)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlags)) (SampleCountFlagBits
depthStencilSamples)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr SampleCountFlags)) (SampleCountFlagBits
colorSamples)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO b -> IO b
pokeZeroCStruct "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_MIXED_SAMPLES_COMBINATION_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
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 (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CoverageReductionModeNV)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr SampleCountFlagBits)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlags)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr SampleCountFlags)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct FramebufferMixedSamplesCombinationNV where
peekCStruct :: ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO FramebufferMixedSamplesCombinationNV
peekCStruct "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p = do
CoverageReductionModeNV
coverageReductionMode <- forall a. Storable a => Ptr a -> IO a
peek @CoverageReductionModeNV (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CoverageReductionModeNV))
SampleCountFlagBits
rasterizationSamples <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr SampleCountFlagBits))
SampleCountFlagBits
depthStencilSamples <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlags))
SampleCountFlagBits
colorSamples <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags (("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr SampleCountFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CoverageReductionModeNV
-> SampleCountFlagBits
-> SampleCountFlagBits
-> SampleCountFlagBits
-> FramebufferMixedSamplesCombinationNV
FramebufferMixedSamplesCombinationNV
CoverageReductionModeNV
coverageReductionMode
SampleCountFlagBits
rasterizationSamples
SampleCountFlagBits
depthStencilSamples
SampleCountFlagBits
colorSamples
instance Storable FramebufferMixedSamplesCombinationNV where
sizeOf :: FramebufferMixedSamplesCombinationNV -> Int
sizeOf ~FramebufferMixedSamplesCombinationNV
_ = Int
32
alignment :: FramebufferMixedSamplesCombinationNV -> Int
alignment ~FramebufferMixedSamplesCombinationNV
_ = Int
8
peek :: ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> IO FramebufferMixedSamplesCombinationNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV)
-> FramebufferMixedSamplesCombinationNV -> IO ()
poke "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
ptr FramebufferMixedSamplesCombinationNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCombinations" ::: Ptr FramebufferMixedSamplesCombinationNV
ptr FramebufferMixedSamplesCombinationNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero FramebufferMixedSamplesCombinationNV where
zero :: FramebufferMixedSamplesCombinationNV
zero = CoverageReductionModeNV
-> SampleCountFlagBits
-> SampleCountFlagBits
-> SampleCountFlagBits
-> FramebufferMixedSamplesCombinationNV
FramebufferMixedSamplesCombinationNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
newtype PipelineCoverageReductionStateCreateFlagsNV = PipelineCoverageReductionStateCreateFlagsNV Flags
deriving newtype (PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c/= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
== :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c== :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
Eq, Eq PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Ordering
PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$cmin :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
max :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$cmax :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
>= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c>= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
> :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c> :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
<= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c<= :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
< :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
$c< :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Bool
compare :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Ordering
$ccompare :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> Ordering
Ord, Ptr PipelineCoverageReductionStateCreateFlagsNV
-> IO PipelineCoverageReductionStateCreateFlagsNV
Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
Ptr PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
PipelineCoverageReductionStateCreateFlagsNV -> Int
forall b.
Ptr b -> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
forall b.
Ptr b
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
$cpoke :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
peek :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> IO PipelineCoverageReductionStateCreateFlagsNV
$cpeek :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> IO PipelineCoverageReductionStateCreateFlagsNV
pokeByteOff :: forall b.
Ptr b
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
$cpokeByteOff :: forall b.
Ptr b
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
peekByteOff :: forall b.
Ptr b -> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
$cpeekByteOff :: forall b.
Ptr b -> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
pokeElemOff :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
$cpokeElemOff :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV -> IO ()
peekElemOff :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
$cpeekElemOff :: Ptr PipelineCoverageReductionStateCreateFlagsNV
-> Int -> IO PipelineCoverageReductionStateCreateFlagsNV
alignment :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$calignment :: PipelineCoverageReductionStateCreateFlagsNV -> Int
sizeOf :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$csizeOf :: PipelineCoverageReductionStateCreateFlagsNV -> Int
Storable, PipelineCoverageReductionStateCreateFlagsNV
forall a. a -> Zero a
zero :: PipelineCoverageReductionStateCreateFlagsNV
$czero :: PipelineCoverageReductionStateCreateFlagsNV
Zero, Eq PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV
Int -> PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV -> Bool
PipelineCoverageReductionStateCreateFlagsNV -> Int
PipelineCoverageReductionStateCreateFlagsNV -> Maybe Int
PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV -> Int -> Bool
PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$cpopCount :: PipelineCoverageReductionStateCreateFlagsNV -> Int
rotateR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$crotateR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
rotateL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$crotateL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
unsafeShiftR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cunsafeShiftR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
shiftR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cshiftR :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
unsafeShiftL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cunsafeShiftL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
shiftL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cshiftL :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
isSigned :: PipelineCoverageReductionStateCreateFlagsNV -> Bool
$cisSigned :: PipelineCoverageReductionStateCreateFlagsNV -> Bool
bitSize :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$cbitSize :: PipelineCoverageReductionStateCreateFlagsNV -> Int
bitSizeMaybe :: PipelineCoverageReductionStateCreateFlagsNV -> Maybe Int
$cbitSizeMaybe :: PipelineCoverageReductionStateCreateFlagsNV -> Maybe Int
testBit :: PipelineCoverageReductionStateCreateFlagsNV -> Int -> Bool
$ctestBit :: PipelineCoverageReductionStateCreateFlagsNV -> Int -> Bool
complementBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$ccomplementBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
clearBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cclearBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
setBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$csetBit :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
bit :: Int -> PipelineCoverageReductionStateCreateFlagsNV
$cbit :: Int -> PipelineCoverageReductionStateCreateFlagsNV
zeroBits :: PipelineCoverageReductionStateCreateFlagsNV
$czeroBits :: PipelineCoverageReductionStateCreateFlagsNV
rotate :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$crotate :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
shift :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
$cshift :: PipelineCoverageReductionStateCreateFlagsNV
-> Int -> PipelineCoverageReductionStateCreateFlagsNV
complement :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$ccomplement :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
xor :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$cxor :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
.|. :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$c.|. :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
.&. :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
$c.&. :: PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
-> PipelineCoverageReductionStateCreateFlagsNV
Bits, Bits PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$ccountTrailingZeros :: PipelineCoverageReductionStateCreateFlagsNV -> Int
countLeadingZeros :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$ccountLeadingZeros :: PipelineCoverageReductionStateCreateFlagsNV -> Int
finiteBitSize :: PipelineCoverageReductionStateCreateFlagsNV -> Int
$cfiniteBitSize :: PipelineCoverageReductionStateCreateFlagsNV -> Int
FiniteBits)
conNamePipelineCoverageReductionStateCreateFlagsNV :: String
conNamePipelineCoverageReductionStateCreateFlagsNV :: String
conNamePipelineCoverageReductionStateCreateFlagsNV = String
"PipelineCoverageReductionStateCreateFlagsNV"
enumPrefixPipelineCoverageReductionStateCreateFlagsNV :: String
enumPrefixPipelineCoverageReductionStateCreateFlagsNV :: String
enumPrefixPipelineCoverageReductionStateCreateFlagsNV = String
""
showTablePipelineCoverageReductionStateCreateFlagsNV :: [(PipelineCoverageReductionStateCreateFlagsNV, String)]
showTablePipelineCoverageReductionStateCreateFlagsNV :: [(PipelineCoverageReductionStateCreateFlagsNV, String)]
showTablePipelineCoverageReductionStateCreateFlagsNV = []
instance Show PipelineCoverageReductionStateCreateFlagsNV where
showsPrec :: Int -> PipelineCoverageReductionStateCreateFlagsNV -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixPipelineCoverageReductionStateCreateFlagsNV
[(PipelineCoverageReductionStateCreateFlagsNV, String)]
showTablePipelineCoverageReductionStateCreateFlagsNV
String
conNamePipelineCoverageReductionStateCreateFlagsNV
(\(PipelineCoverageReductionStateCreateFlagsNV Word32
x) -> Word32
x)
(\Word32
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)
instance Read PipelineCoverageReductionStateCreateFlagsNV where
readPrec :: ReadPrec PipelineCoverageReductionStateCreateFlagsNV
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixPipelineCoverageReductionStateCreateFlagsNV
[(PipelineCoverageReductionStateCreateFlagsNV, String)]
showTablePipelineCoverageReductionStateCreateFlagsNV
String
conNamePipelineCoverageReductionStateCreateFlagsNV
Word32 -> PipelineCoverageReductionStateCreateFlagsNV
PipelineCoverageReductionStateCreateFlagsNV
newtype CoverageReductionModeNV = CoverageReductionModeNV Int32
deriving newtype (CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c/= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
== :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c== :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
Eq, Eq CoverageReductionModeNV
CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
CoverageReductionModeNV -> CoverageReductionModeNV -> Ordering
CoverageReductionModeNV
-> CoverageReductionModeNV -> CoverageReductionModeNV
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CoverageReductionModeNV
-> CoverageReductionModeNV -> CoverageReductionModeNV
$cmin :: CoverageReductionModeNV
-> CoverageReductionModeNV -> CoverageReductionModeNV
max :: CoverageReductionModeNV
-> CoverageReductionModeNV -> CoverageReductionModeNV
$cmax :: CoverageReductionModeNV
-> CoverageReductionModeNV -> CoverageReductionModeNV
>= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c>= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
> :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c> :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
<= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c<= :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
< :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
$c< :: CoverageReductionModeNV -> CoverageReductionModeNV -> Bool
compare :: CoverageReductionModeNV -> CoverageReductionModeNV -> Ordering
$ccompare :: CoverageReductionModeNV -> CoverageReductionModeNV -> Ordering
Ord, Ptr CoverageReductionModeNV -> IO CoverageReductionModeNV
Ptr CoverageReductionModeNV -> Int -> IO CoverageReductionModeNV
Ptr CoverageReductionModeNV
-> Int -> CoverageReductionModeNV -> IO ()
Ptr CoverageReductionModeNV -> CoverageReductionModeNV -> IO ()
CoverageReductionModeNV -> Int
forall b. Ptr b -> Int -> IO CoverageReductionModeNV
forall b. Ptr b -> Int -> CoverageReductionModeNV -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr CoverageReductionModeNV -> CoverageReductionModeNV -> IO ()
$cpoke :: Ptr CoverageReductionModeNV -> CoverageReductionModeNV -> IO ()
peek :: Ptr CoverageReductionModeNV -> IO CoverageReductionModeNV
$cpeek :: Ptr CoverageReductionModeNV -> IO CoverageReductionModeNV
pokeByteOff :: forall b. Ptr b -> Int -> CoverageReductionModeNV -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CoverageReductionModeNV -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CoverageReductionModeNV
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CoverageReductionModeNV
pokeElemOff :: Ptr CoverageReductionModeNV
-> Int -> CoverageReductionModeNV -> IO ()
$cpokeElemOff :: Ptr CoverageReductionModeNV
-> Int -> CoverageReductionModeNV -> IO ()
peekElemOff :: Ptr CoverageReductionModeNV -> Int -> IO CoverageReductionModeNV
$cpeekElemOff :: Ptr CoverageReductionModeNV -> Int -> IO CoverageReductionModeNV
alignment :: CoverageReductionModeNV -> Int
$calignment :: CoverageReductionModeNV -> Int
sizeOf :: CoverageReductionModeNV -> Int
$csizeOf :: CoverageReductionModeNV -> Int
Storable, CoverageReductionModeNV
forall a. a -> Zero a
zero :: CoverageReductionModeNV
$czero :: CoverageReductionModeNV
Zero)
pattern $bCOVERAGE_REDUCTION_MODE_MERGE_NV :: CoverageReductionModeNV
$mCOVERAGE_REDUCTION_MODE_MERGE_NV :: forall {r}.
CoverageReductionModeNV -> ((# #) -> r) -> ((# #) -> r) -> r
COVERAGE_REDUCTION_MODE_MERGE_NV = CoverageReductionModeNV 0
pattern $bCOVERAGE_REDUCTION_MODE_TRUNCATE_NV :: CoverageReductionModeNV
$mCOVERAGE_REDUCTION_MODE_TRUNCATE_NV :: forall {r}.
CoverageReductionModeNV -> ((# #) -> r) -> ((# #) -> r) -> r
COVERAGE_REDUCTION_MODE_TRUNCATE_NV = CoverageReductionModeNV 1
{-# COMPLETE
COVERAGE_REDUCTION_MODE_MERGE_NV
, COVERAGE_REDUCTION_MODE_TRUNCATE_NV ::
CoverageReductionModeNV
#-}
conNameCoverageReductionModeNV :: String
conNameCoverageReductionModeNV :: String
conNameCoverageReductionModeNV = String
"CoverageReductionModeNV"
enumPrefixCoverageReductionModeNV :: String
enumPrefixCoverageReductionModeNV :: String
enumPrefixCoverageReductionModeNV = String
"COVERAGE_REDUCTION_MODE_"
showTableCoverageReductionModeNV :: [(CoverageReductionModeNV, String)]
showTableCoverageReductionModeNV :: [(CoverageReductionModeNV, String)]
showTableCoverageReductionModeNV =
[
( CoverageReductionModeNV
COVERAGE_REDUCTION_MODE_MERGE_NV
, String
"MERGE_NV"
)
,
( CoverageReductionModeNV
COVERAGE_REDUCTION_MODE_TRUNCATE_NV
, String
"TRUNCATE_NV"
)
]
instance Show CoverageReductionModeNV where
showsPrec :: Int -> CoverageReductionModeNV -> ShowS
showsPrec =
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
String
enumPrefixCoverageReductionModeNV
[(CoverageReductionModeNV, String)]
showTableCoverageReductionModeNV
String
conNameCoverageReductionModeNV
(\(CoverageReductionModeNV Int32
x) -> Int32
x)
(forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)
instance Read CoverageReductionModeNV where
readPrec :: ReadPrec CoverageReductionModeNV
readPrec =
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
String
enumPrefixCoverageReductionModeNV
[(CoverageReductionModeNV, String)]
showTableCoverageReductionModeNV
String
conNameCoverageReductionModeNV
Int32 -> CoverageReductionModeNV
CoverageReductionModeNV
type NV_COVERAGE_REDUCTION_MODE_SPEC_VERSION = 1
pattern NV_COVERAGE_REDUCTION_MODE_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_COVERAGE_REDUCTION_MODE_SPEC_VERSION :: forall a. Integral a => a
$mNV_COVERAGE_REDUCTION_MODE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_COVERAGE_REDUCTION_MODE_SPEC_VERSION = 1
type NV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME = "VK_NV_coverage_reduction_mode"
pattern NV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_COVERAGE_REDUCTION_MODE_EXTENSION_NAME = "VK_NV_coverage_reduction_mode"