{-# language CPP #-}
-- | = Name
--
-- VK_QCOM_filter_cubic_weights - device extension
--
-- == VK_QCOM_filter_cubic_weights
--
-- [__Name String__]
--     @VK_QCOM_filter_cubic_weights@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     520
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_filter_cubic VK_EXT_filter_cubic>
--
-- [__Contact__]
--
--     -   Jeff Leger
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_QCOM_filter_cubic_weights] @jackohound%0A*Here describe the issue or question you have about the VK_QCOM_filter_cubic_weights extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-06-23
--
-- [__Contributors__]
--
--     -   Jeff Leger, Qualcomm Technologies, Inc.
--
--     -   Jonathan Wicks, Qualcomm Technologies, Inc.
--
-- == Description
--
-- This extension extends cubic filtering by adding the ability to select a
-- set of weights. Without this extension, the weights used in cubic
-- filtering are limited to those corresponding to a Catmull-Rom spline.
-- This extension adds support for 3 additional spline weights.
--
-- This extension adds a new structure that /can/ be added to the @pNext@
-- chain of 'Vulkan.Core10.Sampler.SamplerCreateInfo' that /can/ be used to
-- specify which set of cubic weights are used in cubic filtering. A
-- similar structure can be added to the @pNext@ chain of
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.BlitImageInfo2' to
-- specify cubic weights used in a blit operation.
--
-- With this extension weights corresponding to the following additional
-- splines can be selected for cubic filtered sampling and blits:
--
-- -   Zero Tangent Cardinal
--
-- -   B-Spline
--
-- -   Mitchell-Netravali
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.BlitImageInfo2':
--
--     -   'BlitImageCubicWeightsInfoQCOM'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceCubicWeightsFeaturesQCOM'
--
-- -   Extending 'Vulkan.Core10.Sampler.SamplerCreateInfo':
--
--     -   'SamplerCubicWeightsCreateInfoQCOM'
--
-- == New Enums
--
-- -   'CubicFilterWeightsQCOM'
--
-- == New Enum Constants
--
-- -   'QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME'
--
-- -   'QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BLIT_IMAGE_CUBIC_WEIGHTS_INFO_QCOM'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_CUBIC_WEIGHTS_FEATURES_QCOM'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLER_CUBIC_WEIGHTS_CREATE_INFO_QCOM'
--
-- == Version History
--
-- -   Revision 1, 2023-06-23 (jleger)
--
--     -   Initial version
--
-- == See Also
--
-- 'BlitImageCubicWeightsInfoQCOM', 'CubicFilterWeightsQCOM',
-- 'PhysicalDeviceCubicWeightsFeaturesQCOM',
-- 'SamplerCubicWeightsCreateInfoQCOM'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_QCOM_filter_cubic_weights Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_QCOM_filter_cubic_weights  ( PhysicalDeviceCubicWeightsFeaturesQCOM(..)
                                                       , SamplerCubicWeightsCreateInfoQCOM(..)
                                                       , BlitImageCubicWeightsInfoQCOM(..)
                                                       , CubicFilterWeightsQCOM( CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM
                                                                               , CUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM
                                                                               , CUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM
                                                                               , CUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM
                                                                               , ..
                                                                               )
                                                       , QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION
                                                       , pattern QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION
                                                       , QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME
                                                       , pattern QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME
                                                       ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
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 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 Data.Int (Int32)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
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_BLIT_IMAGE_CUBIC_WEIGHTS_INFO_QCOM))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUBIC_WEIGHTS_FEATURES_QCOM))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SAMPLER_CUBIC_WEIGHTS_CREATE_INFO_QCOM))
-- | VkPhysicalDeviceCubicWeightsFeaturesQCOM - Structure describing cubic
-- weight selection features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceCubicWeightsFeaturesQCOM' structure is included in
-- the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceCubicWeightsFeaturesQCOM' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_filter_cubic_weights VK_QCOM_filter_cubic_weights>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCubicWeightsFeaturesQCOM = PhysicalDeviceCubicWeightsFeaturesQCOM
  { -- | #features-filter-cubic-weight-selection# @selectableCubicWeights@
    -- indicates that the implementation supports the selection of filter cubic
    -- weights.
    PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
selectableCubicWeights :: Bool }
  deriving (Typeable, PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
$c/= :: PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
== :: PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
$c== :: PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCubicWeightsFeaturesQCOM)
#endif
deriving instance Show PhysicalDeviceCubicWeightsFeaturesQCOM

instance ToCStruct PhysicalDeviceCubicWeightsFeaturesQCOM where
  withCStruct :: forall b.
PhysicalDeviceCubicWeightsFeaturesQCOM
-> (Ptr PhysicalDeviceCubicWeightsFeaturesQCOM -> IO b) -> IO b
withCStruct PhysicalDeviceCubicWeightsFeaturesQCOM
x Ptr PhysicalDeviceCubicWeightsFeaturesQCOM -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p PhysicalDeviceCubicWeightsFeaturesQCOM
x (Ptr PhysicalDeviceCubicWeightsFeaturesQCOM -> IO b
f Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p PhysicalDeviceCubicWeightsFeaturesQCOM{Bool
selectableCubicWeights :: Bool
$sel:selectableCubicWeights:PhysicalDeviceCubicWeightsFeaturesQCOM :: PhysicalDeviceCubicWeightsFeaturesQCOM -> Bool
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUBIC_WEIGHTS_FEATURES_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
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 PhysicalDeviceCubicWeightsFeaturesQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
selectableCubicWeights))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCubicWeightsFeaturesQCOM -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUBIC_WEIGHTS_FEATURES_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
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 PhysicalDeviceCubicWeightsFeaturesQCOM
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 PhysicalDeviceCubicWeightsFeaturesQCOM where
  peekCStruct :: Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
-> IO PhysicalDeviceCubicWeightsFeaturesQCOM
peekCStruct Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
p = do
    Bool32
selectableCubicWeights <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
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 -> PhysicalDeviceCubicWeightsFeaturesQCOM
PhysicalDeviceCubicWeightsFeaturesQCOM
             (Bool32 -> Bool
bool32ToBool Bool32
selectableCubicWeights)

instance Storable PhysicalDeviceCubicWeightsFeaturesQCOM where
  sizeOf :: PhysicalDeviceCubicWeightsFeaturesQCOM -> Int
sizeOf ~PhysicalDeviceCubicWeightsFeaturesQCOM
_ = Int
24
  alignment :: PhysicalDeviceCubicWeightsFeaturesQCOM -> Int
alignment ~PhysicalDeviceCubicWeightsFeaturesQCOM
_ = Int
8
  peek :: Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
-> IO PhysicalDeviceCubicWeightsFeaturesQCOM
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
-> PhysicalDeviceCubicWeightsFeaturesQCOM -> IO ()
poke Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
ptr PhysicalDeviceCubicWeightsFeaturesQCOM
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCubicWeightsFeaturesQCOM
ptr PhysicalDeviceCubicWeightsFeaturesQCOM
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceCubicWeightsFeaturesQCOM where
  zero :: PhysicalDeviceCubicWeightsFeaturesQCOM
zero = Bool -> PhysicalDeviceCubicWeightsFeaturesQCOM
PhysicalDeviceCubicWeightsFeaturesQCOM
           forall a. Zero a => a
zero


-- | VkSamplerCubicWeightsCreateInfoQCOM - Structure specifying sampler cubic
-- weights
--
-- = Description
--
-- If the @pNext@ chain of 'Vulkan.Core10.Sampler.SamplerCreateInfo'
-- includes a 'SamplerCubicWeightsCreateInfoQCOM' structure, then that
-- structure specifies which cubic weights are used.
--
-- If that structure is not present, @cubicWeights@ is considered to be
-- 'CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_filter_cubic_weights VK_QCOM_filter_cubic_weights>,
-- 'CubicFilterWeightsQCOM',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SamplerCubicWeightsCreateInfoQCOM = SamplerCubicWeightsCreateInfoQCOM
  { -- | @cubicWeights@ is a 'CubicFilterWeightsQCOM' value controlling which
    -- cubic weights are used.
    --
    -- #VUID-VkSamplerCubicWeightsCreateInfoQCOM-cubicWeights-parameter#
    -- @cubicWeights@ /must/ be a valid 'CubicFilterWeightsQCOM' value
    SamplerCubicWeightsCreateInfoQCOM -> CubicFilterWeightsQCOM
cubicWeights :: CubicFilterWeightsQCOM }
  deriving (Typeable, SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> Bool
$c/= :: SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> Bool
== :: SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> Bool
$c== :: SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SamplerCubicWeightsCreateInfoQCOM)
#endif
deriving instance Show SamplerCubicWeightsCreateInfoQCOM

instance ToCStruct SamplerCubicWeightsCreateInfoQCOM where
  withCStruct :: forall b.
SamplerCubicWeightsCreateInfoQCOM
-> (Ptr SamplerCubicWeightsCreateInfoQCOM -> IO b) -> IO b
withCStruct SamplerCubicWeightsCreateInfoQCOM
x Ptr SamplerCubicWeightsCreateInfoQCOM -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr SamplerCubicWeightsCreateInfoQCOM
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SamplerCubicWeightsCreateInfoQCOM
p SamplerCubicWeightsCreateInfoQCOM
x (Ptr SamplerCubicWeightsCreateInfoQCOM -> IO b
f Ptr SamplerCubicWeightsCreateInfoQCOM
p)
  pokeCStruct :: forall b.
Ptr SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> IO b -> IO b
pokeCStruct Ptr SamplerCubicWeightsCreateInfoQCOM
p SamplerCubicWeightsCreateInfoQCOM{CubicFilterWeightsQCOM
cubicWeights :: CubicFilterWeightsQCOM
$sel:cubicWeights:SamplerCubicWeightsCreateInfoQCOM :: SamplerCubicWeightsCreateInfoQCOM -> CubicFilterWeightsQCOM
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCubicWeightsCreateInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CUBIC_WEIGHTS_CREATE_INFO_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCubicWeightsCreateInfoQCOM
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 SamplerCubicWeightsCreateInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM)) (CubicFilterWeightsQCOM
cubicWeights)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SamplerCubicWeightsCreateInfoQCOM -> IO b -> IO b
pokeZeroCStruct Ptr SamplerCubicWeightsCreateInfoQCOM
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCubicWeightsCreateInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CUBIC_WEIGHTS_CREATE_INFO_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCubicWeightsCreateInfoQCOM
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 SamplerCubicWeightsCreateInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SamplerCubicWeightsCreateInfoQCOM where
  peekCStruct :: Ptr SamplerCubicWeightsCreateInfoQCOM
-> IO SamplerCubicWeightsCreateInfoQCOM
peekCStruct Ptr SamplerCubicWeightsCreateInfoQCOM
p = do
    CubicFilterWeightsQCOM
cubicWeights <- forall a. Storable a => Ptr a -> IO a
peek @CubicFilterWeightsQCOM ((Ptr SamplerCubicWeightsCreateInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CubicFilterWeightsQCOM -> SamplerCubicWeightsCreateInfoQCOM
SamplerCubicWeightsCreateInfoQCOM
             CubicFilterWeightsQCOM
cubicWeights

instance Storable SamplerCubicWeightsCreateInfoQCOM where
  sizeOf :: SamplerCubicWeightsCreateInfoQCOM -> Int
sizeOf ~SamplerCubicWeightsCreateInfoQCOM
_ = Int
24
  alignment :: SamplerCubicWeightsCreateInfoQCOM -> Int
alignment ~SamplerCubicWeightsCreateInfoQCOM
_ = Int
8
  peek :: Ptr SamplerCubicWeightsCreateInfoQCOM
-> IO SamplerCubicWeightsCreateInfoQCOM
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr SamplerCubicWeightsCreateInfoQCOM
-> SamplerCubicWeightsCreateInfoQCOM -> IO ()
poke Ptr SamplerCubicWeightsCreateInfoQCOM
ptr SamplerCubicWeightsCreateInfoQCOM
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SamplerCubicWeightsCreateInfoQCOM
ptr SamplerCubicWeightsCreateInfoQCOM
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SamplerCubicWeightsCreateInfoQCOM where
  zero :: SamplerCubicWeightsCreateInfoQCOM
zero = CubicFilterWeightsQCOM -> SamplerCubicWeightsCreateInfoQCOM
SamplerCubicWeightsCreateInfoQCOM
           forall a. Zero a => a
zero


-- | VkBlitImageCubicWeightsInfoQCOM - Structure specifying image blit cubic
-- weight info
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_filter_cubic_weights VK_QCOM_filter_cubic_weights>,
-- 'CubicFilterWeightsQCOM',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BlitImageCubicWeightsInfoQCOM = BlitImageCubicWeightsInfoQCOM
  { -- | @cubicWeights@ is a 'CubicFilterWeightsQCOM' value controlling cubic
    -- filter weights for the blit.
    --
    -- #VUID-VkBlitImageCubicWeightsInfoQCOM-cubicWeights-parameter#
    -- @cubicWeights@ /must/ be a valid 'CubicFilterWeightsQCOM' value
    BlitImageCubicWeightsInfoQCOM -> CubicFilterWeightsQCOM
cubicWeights :: CubicFilterWeightsQCOM }
  deriving (Typeable, BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> Bool
$c/= :: BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> Bool
== :: BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> Bool
$c== :: BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BlitImageCubicWeightsInfoQCOM)
#endif
deriving instance Show BlitImageCubicWeightsInfoQCOM

instance ToCStruct BlitImageCubicWeightsInfoQCOM where
  withCStruct :: forall b.
BlitImageCubicWeightsInfoQCOM
-> (Ptr BlitImageCubicWeightsInfoQCOM -> IO b) -> IO b
withCStruct BlitImageCubicWeightsInfoQCOM
x Ptr BlitImageCubicWeightsInfoQCOM -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr BlitImageCubicWeightsInfoQCOM
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BlitImageCubicWeightsInfoQCOM
p BlitImageCubicWeightsInfoQCOM
x (Ptr BlitImageCubicWeightsInfoQCOM -> IO b
f Ptr BlitImageCubicWeightsInfoQCOM
p)
  pokeCStruct :: forall b.
Ptr BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> IO b -> IO b
pokeCStruct Ptr BlitImageCubicWeightsInfoQCOM
p BlitImageCubicWeightsInfoQCOM{CubicFilterWeightsQCOM
cubicWeights :: CubicFilterWeightsQCOM
$sel:cubicWeights:BlitImageCubicWeightsInfoQCOM :: BlitImageCubicWeightsInfoQCOM -> CubicFilterWeightsQCOM
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BlitImageCubicWeightsInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BLIT_IMAGE_CUBIC_WEIGHTS_INFO_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BlitImageCubicWeightsInfoQCOM
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 BlitImageCubicWeightsInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM)) (CubicFilterWeightsQCOM
cubicWeights)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr BlitImageCubicWeightsInfoQCOM -> IO b -> IO b
pokeZeroCStruct Ptr BlitImageCubicWeightsInfoQCOM
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BlitImageCubicWeightsInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BLIT_IMAGE_CUBIC_WEIGHTS_INFO_QCOM)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BlitImageCubicWeightsInfoQCOM
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 BlitImageCubicWeightsInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BlitImageCubicWeightsInfoQCOM where
  peekCStruct :: Ptr BlitImageCubicWeightsInfoQCOM
-> IO BlitImageCubicWeightsInfoQCOM
peekCStruct Ptr BlitImageCubicWeightsInfoQCOM
p = do
    CubicFilterWeightsQCOM
cubicWeights <- forall a. Storable a => Ptr a -> IO a
peek @CubicFilterWeightsQCOM ((Ptr BlitImageCubicWeightsInfoQCOM
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CubicFilterWeightsQCOM))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CubicFilterWeightsQCOM -> BlitImageCubicWeightsInfoQCOM
BlitImageCubicWeightsInfoQCOM
             CubicFilterWeightsQCOM
cubicWeights

instance Storable BlitImageCubicWeightsInfoQCOM where
  sizeOf :: BlitImageCubicWeightsInfoQCOM -> Int
sizeOf ~BlitImageCubicWeightsInfoQCOM
_ = Int
24
  alignment :: BlitImageCubicWeightsInfoQCOM -> Int
alignment ~BlitImageCubicWeightsInfoQCOM
_ = Int
8
  peek :: Ptr BlitImageCubicWeightsInfoQCOM
-> IO BlitImageCubicWeightsInfoQCOM
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr BlitImageCubicWeightsInfoQCOM
-> BlitImageCubicWeightsInfoQCOM -> IO ()
poke Ptr BlitImageCubicWeightsInfoQCOM
ptr BlitImageCubicWeightsInfoQCOM
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BlitImageCubicWeightsInfoQCOM
ptr BlitImageCubicWeightsInfoQCOM
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero BlitImageCubicWeightsInfoQCOM where
  zero :: BlitImageCubicWeightsInfoQCOM
zero = CubicFilterWeightsQCOM -> BlitImageCubicWeightsInfoQCOM
BlitImageCubicWeightsInfoQCOM
           forall a. Zero a => a
zero


-- | VkCubicFilterWeightsQCOM - Specify cubic weights for texture filtering
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_filter_cubic_weights VK_QCOM_filter_cubic_weights>,
-- 'BlitImageCubicWeightsInfoQCOM', 'SamplerCubicWeightsCreateInfoQCOM'
newtype CubicFilterWeightsQCOM = CubicFilterWeightsQCOM Int32
  deriving newtype (CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c/= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
== :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c== :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
Eq, Eq CubicFilterWeightsQCOM
CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Ordering
CubicFilterWeightsQCOM
-> CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM
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 :: CubicFilterWeightsQCOM
-> CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM
$cmin :: CubicFilterWeightsQCOM
-> CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM
max :: CubicFilterWeightsQCOM
-> CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM
$cmax :: CubicFilterWeightsQCOM
-> CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM
>= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c>= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
> :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c> :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
<= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c<= :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
< :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
$c< :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Bool
compare :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Ordering
$ccompare :: CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> Ordering
Ord, Ptr CubicFilterWeightsQCOM -> IO CubicFilterWeightsQCOM
Ptr CubicFilterWeightsQCOM -> Int -> IO CubicFilterWeightsQCOM
Ptr CubicFilterWeightsQCOM
-> Int -> CubicFilterWeightsQCOM -> IO ()
Ptr CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> IO ()
CubicFilterWeightsQCOM -> Int
forall b. Ptr b -> Int -> IO CubicFilterWeightsQCOM
forall b. Ptr b -> Int -> CubicFilterWeightsQCOM -> 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 CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> IO ()
$cpoke :: Ptr CubicFilterWeightsQCOM -> CubicFilterWeightsQCOM -> IO ()
peek :: Ptr CubicFilterWeightsQCOM -> IO CubicFilterWeightsQCOM
$cpeek :: Ptr CubicFilterWeightsQCOM -> IO CubicFilterWeightsQCOM
pokeByteOff :: forall b. Ptr b -> Int -> CubicFilterWeightsQCOM -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> CubicFilterWeightsQCOM -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO CubicFilterWeightsQCOM
$cpeekByteOff :: forall b. Ptr b -> Int -> IO CubicFilterWeightsQCOM
pokeElemOff :: Ptr CubicFilterWeightsQCOM
-> Int -> CubicFilterWeightsQCOM -> IO ()
$cpokeElemOff :: Ptr CubicFilterWeightsQCOM
-> Int -> CubicFilterWeightsQCOM -> IO ()
peekElemOff :: Ptr CubicFilterWeightsQCOM -> Int -> IO CubicFilterWeightsQCOM
$cpeekElemOff :: Ptr CubicFilterWeightsQCOM -> Int -> IO CubicFilterWeightsQCOM
alignment :: CubicFilterWeightsQCOM -> Int
$calignment :: CubicFilterWeightsQCOM -> Int
sizeOf :: CubicFilterWeightsQCOM -> Int
$csizeOf :: CubicFilterWeightsQCOM -> Int
Storable, CubicFilterWeightsQCOM
forall a. a -> Zero a
zero :: CubicFilterWeightsQCOM
$czero :: CubicFilterWeightsQCOM
Zero)

-- | 'CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM' specifies Catmull-Rom weights.
pattern $bCUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM :: CubicFilterWeightsQCOM
$mCUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM :: forall {r}.
CubicFilterWeightsQCOM -> ((# #) -> r) -> ((# #) -> r) -> r
CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM = CubicFilterWeightsQCOM 0

-- | 'CUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM' specifies Zero Tangent
-- Cardinal weights.
pattern $bCUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM :: CubicFilterWeightsQCOM
$mCUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM :: forall {r}.
CubicFilterWeightsQCOM -> ((# #) -> r) -> ((# #) -> r) -> r
CUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM = CubicFilterWeightsQCOM 1

-- | 'CUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM' specifies B-Spline weights.
pattern $bCUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM :: CubicFilterWeightsQCOM
$mCUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM :: forall {r}.
CubicFilterWeightsQCOM -> ((# #) -> r) -> ((# #) -> r) -> r
CUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM = CubicFilterWeightsQCOM 2

-- | 'CUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM' specifies
-- Mitchell-Netravali weights.
pattern $bCUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM :: CubicFilterWeightsQCOM
$mCUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM :: forall {r}.
CubicFilterWeightsQCOM -> ((# #) -> r) -> ((# #) -> r) -> r
CUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM = CubicFilterWeightsQCOM 3

{-# COMPLETE
  CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM
  , CUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM
  , CUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM
  , CUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM ::
    CubicFilterWeightsQCOM
  #-}

conNameCubicFilterWeightsQCOM :: String
conNameCubicFilterWeightsQCOM :: String
conNameCubicFilterWeightsQCOM = String
"CubicFilterWeightsQCOM"

enumPrefixCubicFilterWeightsQCOM :: String
enumPrefixCubicFilterWeightsQCOM :: String
enumPrefixCubicFilterWeightsQCOM = String
"CUBIC_FILTER_WEIGHTS_"

showTableCubicFilterWeightsQCOM :: [(CubicFilterWeightsQCOM, String)]
showTableCubicFilterWeightsQCOM :: [(CubicFilterWeightsQCOM, String)]
showTableCubicFilterWeightsQCOM =
  [
    ( CubicFilterWeightsQCOM
CUBIC_FILTER_WEIGHTS_CATMULL_ROM_QCOM
    , String
"CATMULL_ROM_QCOM"
    )
  ,
    ( CubicFilterWeightsQCOM
CUBIC_FILTER_WEIGHTS_ZERO_TANGENT_CARDINAL_QCOM
    , String
"ZERO_TANGENT_CARDINAL_QCOM"
    )
  ,
    ( CubicFilterWeightsQCOM
CUBIC_FILTER_WEIGHTS_B_SPLINE_QCOM
    , String
"B_SPLINE_QCOM"
    )
  ,
    ( CubicFilterWeightsQCOM
CUBIC_FILTER_WEIGHTS_MITCHELL_NETRAVALI_QCOM
    , String
"MITCHELL_NETRAVALI_QCOM"
    )
  ]

instance Show CubicFilterWeightsQCOM where
  showsPrec :: Int -> CubicFilterWeightsQCOM -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixCubicFilterWeightsQCOM
      [(CubicFilterWeightsQCOM, String)]
showTableCubicFilterWeightsQCOM
      String
conNameCubicFilterWeightsQCOM
      (\(CubicFilterWeightsQCOM Int32
x) -> Int32
x)
      (forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read CubicFilterWeightsQCOM where
  readPrec :: ReadPrec CubicFilterWeightsQCOM
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixCubicFilterWeightsQCOM
      [(CubicFilterWeightsQCOM, String)]
showTableCubicFilterWeightsQCOM
      String
conNameCubicFilterWeightsQCOM
      Int32 -> CubicFilterWeightsQCOM
CubicFilterWeightsQCOM

type QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION"
pattern QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION :: forall a . Integral a => a
pattern $bQCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION :: forall a. Integral a => a
$mQCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
QCOM_FILTER_CUBIC_WEIGHTS_SPEC_VERSION = 1


type QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME = "VK_QCOM_filter_cubic_weights"

-- No documentation found for TopLevel "VK_QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME"
pattern QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bQCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mQCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
QCOM_FILTER_CUBIC_WEIGHTS_EXTENSION_NAME = "VK_QCOM_filter_cubic_weights"