{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_EXT_sampler_filter_minmax"
module Vulkan.Core12.Promoted_From_VK_EXT_sampler_filter_minmax  ( PhysicalDeviceSamplerFilterMinmaxProperties(..)
                                                                 , SamplerReductionModeCreateInfo(..)
                                                                 , StructureType(..)
                                                                 , FormatFeatureFlagBits(..)
                                                                 , FormatFeatureFlags
                                                                 , SamplerReductionMode(..)
                                                                 ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.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.Core12.Enums.SamplerReductionMode (SamplerReductionMode)
import Vulkan.Core10.Enums.StructureType (StructureType)
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(..))
-- | VkPhysicalDeviceSamplerFilterMinmaxProperties - Structure describing
-- sampler filter minmax limits that can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceSamplerFilterMinmaxProperties' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- If @filterMinmaxSingleComponentFormats@ is
-- 'Vulkan.Core10.FundamentalTypes.TRUE', the following formats /must/
-- support the
-- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_MINMAX_BIT'
-- feature with 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_OPTIMAL', if
-- they support
-- 'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_BIT':
--
-- If the format is a depth\/stencil format, this bit only specifies that
-- the depth aspect (not the stencil aspect) of an image of this format
-- supports min\/max filtering, and that min\/max filtering of the depth
-- aspect is supported when depth compare is disabled in the sampler.
--
-- If @filterMinmaxImageComponentMapping@ is
-- 'Vulkan.Core10.FundamentalTypes.FALSE' the component mapping of the
-- image view used with min\/max filtering /must/ have been created with
-- the @r@ component set to the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-views-identity-mappings identity swizzle>.
-- Only the @r@ component of the sampled image value is defined and the
-- other component values are undefined. If
-- @filterMinmaxImageComponentMapping@ is
-- 'Vulkan.Core10.FundamentalTypes.TRUE' this restriction does not apply
-- and image component mapping works as normal.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sampler_filter_minmax VK_EXT_sampler_filter_minmax>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSamplerFilterMinmaxProperties = PhysicalDeviceSamplerFilterMinmaxProperties
  { -- | #extension-limits-filterMinmaxSingleComponentFormats#
    -- @filterMinmaxSingleComponentFormats@ is a boolean value indicating
    -- whether a minimum set of required formats support min\/max filtering.
    PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
filterMinmaxSingleComponentFormats :: Bool
  , -- | #extension-limits-filterMinmaxImageComponentMapping#
    -- @filterMinmaxImageComponentMapping@ is a boolean value indicating
    -- whether the implementation supports non-identity component mapping of
    -- the image when doing min\/max filtering.
    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 PhysicalDeviceSamplerFilterMinmaxProperties
x Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b
f = Int
-> (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b) -> IO b)
-> (Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \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 Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p PhysicalDeviceSamplerFilterMinmaxProperties{Bool
filterMinmaxImageComponentMapping :: Bool
filterMinmaxSingleComponentFormats :: Bool
$sel:filterMinmaxImageComponentMapping:PhysicalDeviceSamplerFilterMinmaxProperties :: PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
$sel:filterMinmaxSingleComponentFormats:PhysicalDeviceSamplerFilterMinmaxProperties :: PhysicalDeviceSamplerFilterMinmaxProperties -> Bool
..} 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` Int
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` Int
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` Int
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` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
filterMinmaxImageComponentMapping))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceSamplerFilterMinmaxProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSamplerFilterMinmaxProperties
p 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` Int
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` Int
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` Int
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` Int
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 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` Int
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` Int
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
_ = Int
24
  alignment :: PhysicalDeviceSamplerFilterMinmaxProperties -> Int
alignment ~PhysicalDeviceSamplerFilterMinmaxProperties
_ = Int
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 PhysicalDeviceSamplerFilterMinmaxProperties
ptr 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


-- | VkSamplerReductionModeCreateInfo - Structure specifying sampler
-- reduction mode
--
-- = Description
--
-- If the @pNext@ chain of 'Vulkan.Core10.Sampler.SamplerCreateInfo'
-- includes a 'SamplerReductionModeCreateInfo' structure, then that
-- structure includes a mode controlling how texture filtering combines
-- texel values.
--
-- If this structure is not present, @reductionMode@ is considered to be
-- 'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_WEIGHTED_AVERAGE'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sampler_filter_minmax VK_EXT_sampler_filter_minmax>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core12.Enums.SamplerReductionMode.SamplerReductionMode',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SamplerReductionModeCreateInfo = SamplerReductionModeCreateInfo
  { -- | @reductionMode@ is a
    -- 'Vulkan.Core12.Enums.SamplerReductionMode.SamplerReductionMode' value
    -- controlling how texture filtering combines texel values.
    --
    -- #VUID-VkSamplerReductionModeCreateInfo-reductionMode-parameter#
    -- @reductionMode@ /must/ be a valid
    -- 'Vulkan.Core12.Enums.SamplerReductionMode.SamplerReductionMode' value
    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 SamplerReductionModeCreateInfo
x Ptr SamplerReductionModeCreateInfo -> IO b
f = Int -> (Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b)
-> (Ptr SamplerReductionModeCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \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 Ptr SamplerReductionModeCreateInfo
p SamplerReductionModeCreateInfo{SamplerReductionMode
reductionMode :: SamplerReductionMode
$sel:reductionMode:SamplerReductionModeCreateInfo :: SamplerReductionModeCreateInfo -> SamplerReductionMode
..} 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` Int
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` Int
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` Int
16 :: Ptr SamplerReductionMode)) (SamplerReductionMode
reductionMode)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr SamplerReductionModeCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr SamplerReductionModeCreateInfo
p 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` Int
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` Int
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` Int
16 :: Ptr SamplerReductionMode)) (SamplerReductionMode
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SamplerReductionModeCreateInfo where
  peekCStruct :: Ptr SamplerReductionModeCreateInfo
-> IO SamplerReductionModeCreateInfo
peekCStruct 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` Int
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
_ = Int
24
  alignment :: SamplerReductionModeCreateInfo -> Int
alignment ~SamplerReductionModeCreateInfo
_ = Int
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 SamplerReductionModeCreateInfo
ptr 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