{-# language CPP #-}
-- | = Name
--
-- VK_EXT_custom_border_color - device extension
--
-- == VK_EXT_custom_border_color
--
-- [__Name String__]
--     @VK_EXT_custom_border_color@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     288
--
-- [__Revision__]
--     12
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
-- [__Special Uses__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse OpenGL \/ ES support>
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse D3D support>
--
-- [__Contact__]
--
--     -   Liam Middlebrook
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_custom_border_color] @liam-middlebrook%0A<<Here describe the issue or question you have about the VK_EXT_custom_border_color extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-04-16
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Joshua Ashton, Valve
--
--     -   Hans-Kristian Arntzen, Valve
--
--     -   Philip Rebohle, Valve
--
--     -   Liam Middlebrook, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Tobias Hector, AMD
--
--     -   Jason Ekstrand, Intel
--
--     -   Spencer Fricke, Samsung Electronics
--
--     -   Graeme Leese, Broadcom
--
--     -   Jesse Hall, Google
--
--     -   Jan-Harald Fredriksen, ARM
--
--     -   Tom Olson, ARM
--
--     -   Stuart Smith, Imagination Technologies
--
--     -   Donald Scorgie, Imagination Technologies
--
--     -   Alex Walters, Imagination Technologies
--
--     -   Peter Quayle, Imagination Technologies
--
-- == Description
--
-- This extension provides cross-vendor functionality to specify a custom
-- border color for use when the sampler address mode
-- 'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER'
-- is used.
--
-- To create a sampler which uses a custom border color set
-- 'Vulkan.Core10.Sampler.SamplerCreateInfo'::@borderColor@ to one of:
--
-- -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT'
--
-- -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT'
--
-- When 'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT' or
-- 'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT' is used,
-- applications must provide a 'SamplerCustomBorderColorCreateInfoEXT' in
-- the @pNext@ chain for 'Vulkan.Core10.Sampler.SamplerCreateInfo'.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceCustomBorderColorFeaturesEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceCustomBorderColorPropertiesEXT'
--
-- -   Extending 'Vulkan.Core10.Sampler.SamplerCreateInfo':
--
--     -   'SamplerCustomBorderColorCreateInfoEXT'
--
-- == New Enum Constants
--
-- -   'EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME'
--
-- -   'EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.BorderColor.BorderColor':
--
--     -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT'
--
--     -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLER_CUSTOM_BORDER_COLOR_CREATE_INFO_EXT'
--
-- == Issues
--
-- 1) Should VkClearColorValue be used for the border color value, or
-- should we have our own struct\/union? Do we need to specify the type of
-- the input values for the components? This is more of a concern if
-- VkClearColorValue is used here because it provides a union of
-- float,int,uint types.
--
-- __RESOLVED__: Will reuse existing VkClearColorValue structure in order
-- to easily take advantage of float,int,uint borderColor types.
--
-- 2) For hardware which supports a limited number of border colors what
-- happens if that number is exceeded? Should this be handled by the driver
-- unbeknownst to the application? In Revision 1 we had solved this issue
-- using a new Object type, however that may have lead to additional system
-- resource consumption which would otherwise not be required.
--
-- __RESOLVED__: Added
-- 'PhysicalDeviceCustomBorderColorPropertiesEXT'::@maxCustomBorderColorSamplers@
-- for tracking implementation-specific limit, and Valid Usage statement
-- handling overflow.
--
-- 3) Should this be supported for immutable samplers at all, or by a
-- feature bit? Some implementations may not be able to support custom
-- border colors on immutable samplers — is it worthwhile enabling this to
-- work on them for implementations that can support it, or forbidding it
-- entirely.
--
-- __RESOLVED__: Samplers created with a custom border color are forbidden
-- from being immutable. This resolves concerns for implementations where
-- the custom border color is an index to a LUT instead of being directly
-- embedded into sampler state.
--
-- 4) Should UINT and SINT (unsigned integer and signed integer) border
-- color types be separated or should they be combined into one generic INT
-- (integer) type?
--
-- __RESOLVED__: Separating these does not make much sense as the existing
-- fixed border color types do not have this distinction, and there is no
-- reason in hardware to do so. This separation would also create
-- unnecessary work and considerations for the application.
--
-- == Version History
--
-- -   Revision 1, 2019-10-10 (Joshua Ashton)
--
--     -   Internal revisions.
--
-- -   Revision 2, 2019-10-11 (Liam Middlebrook)
--
--     -   Remove VkCustomBorderColor object and associated functions
--
--     -   Add issues concerning HW limitations for custom border color
--         count
--
-- -   Revision 3, 2019-10-12 (Joshua Ashton)
--
--     -   Re-expose the limits for the maximum number of unique border
--         colors
--
--     -   Add extra details about border color tracking
--
--     -   Fix typos
--
-- -   Revision 4, 2019-10-12 (Joshua Ashton)
--
--     -   Changed maxUniqueCustomBorderColors to a uint32_t from a
--         VkDeviceSize
--
-- -   Revision 5, 2019-10-14 (Liam Middlebrook)
--
--     -   Added features bit
--
-- -   Revision 6, 2019-10-15 (Joshua Ashton)
--
--     -   Type-ize VK_BORDER_COLOR_CUSTOM
--
--     -   Fix const-ness on @pNext@ of
--         VkSamplerCustomBorderColorCreateInfoEXT
--
-- -   Revision 7, 2019-11-26 (Liam Middlebrook)
--
--     -   Renamed maxUniqueCustomBorderColors to maxCustomBorderColors
--
-- -   Revision 8, 2019-11-29 (Joshua Ashton)
--
--     -   Renamed borderColor member of
--         VkSamplerCustomBorderColorCreateInfoEXT to customBorderColor
--
-- -   Revision 9, 2020-02-19 (Joshua Ashton)
--
--     -   Renamed maxCustomBorderColors to maxCustomBorderColorSamplers
--
-- -   Revision 10, 2020-02-21 (Joshua Ashton)
--
--     -   Added format to VkSamplerCustomBorderColorCreateInfoEXT and
--         feature bit
--
-- -   Revision 11, 2020-04-07 (Joshua Ashton)
--
--     -   Dropped UINT\/SINT border color differences, consolidated types
--
-- -   Revision 12, 2020-04-16 (Joshua Ashton)
--
--     -   Renamed VK_BORDER_COLOR_CUSTOM_FLOAT_EXT to
--         VK_BORDER_COLOR_FLOAT_CUSTOM_EXT for consistency
--
-- == See Also
--
-- 'PhysicalDeviceCustomBorderColorFeaturesEXT',
-- 'PhysicalDeviceCustomBorderColorPropertiesEXT',
-- 'SamplerCustomBorderColorCreateInfoEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_custom_border_color Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_custom_border_color  ( SamplerCustomBorderColorCreateInfoEXT(..)
                                                     , PhysicalDeviceCustomBorderColorPropertiesEXT(..)
                                                     , PhysicalDeviceCustomBorderColorFeaturesEXT(..)
                                                     , EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION
                                                     , pattern EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION
                                                     , EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME
                                                     , pattern EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME
                                                     ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.CommandBufferBuilding (ClearColorValue)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SAMPLER_CUSTOM_BORDER_COLOR_CREATE_INFO_EXT))
-- | VkSamplerCustomBorderColorCreateInfoEXT - Structure specifying custom
-- border color
--
-- == Valid Usage
--
-- -   #VUID-VkSamplerCustomBorderColorCreateInfoEXT-format-04013# If
--     provided @format@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED' then the
--     'Vulkan.Core10.Sampler.SamplerCreateInfo'::@borderColor@ type /must/
--     match the sampled type of the provided @format@, as shown in the
--     /SPIR-V Sampled Type/ column of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-numericformat>
--     table
--
-- -   #VUID-VkSamplerCustomBorderColorCreateInfoEXT-format-04014# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-customBorderColorWithoutFormat customBorderColorWithoutFormat>
--     feature is not enabled then @format@ /must/ not be
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED'
--
-- -   #VUID-VkSamplerCustomBorderColorCreateInfoEXT-format-04015# If the
--     sampler is used to sample an image view of
--     'Vulkan.Core10.Enums.Format.FORMAT_B4G4R4A4_UNORM_PACK16',
--     'Vulkan.Core10.Enums.Format.FORMAT_B5G6R5_UNORM_PACK16', or
--     'Vulkan.Core10.Enums.Format.FORMAT_B5G5R5A1_UNORM_PACK16' format
--     then @format@ /must/ not be
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSamplerCustomBorderColorCreateInfoEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLER_CUSTOM_BORDER_COLOR_CREATE_INFO_EXT'
--
-- -   #VUID-VkSamplerCustomBorderColorCreateInfoEXT-format-parameter#
--     @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_custom_border_color VK_EXT_custom_border_color>,
-- 'Vulkan.Core10.CommandBufferBuilding.ClearColorValue',
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SamplerCustomBorderColorCreateInfoEXT = SamplerCustomBorderColorCreateInfoEXT
  { -- | @customBorderColor@ is a
    -- 'Vulkan.Core10.CommandBufferBuilding.ClearColorValue' representing the
    -- desired custom sampler border color.
    SamplerCustomBorderColorCreateInfoEXT -> ClearColorValue
customBorderColor :: ClearColorValue
  , -- | @format@ is a 'Vulkan.Core10.Enums.Format.Format' representing the
    -- format of the sampled image view(s). This field may be
    -- 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED' if the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-customBorderColorWithoutFormat customBorderColorWithoutFormat>
    -- feature is enabled.
    SamplerCustomBorderColorCreateInfoEXT -> Format
format :: Format
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SamplerCustomBorderColorCreateInfoEXT)
#endif
deriving instance Show SamplerCustomBorderColorCreateInfoEXT

instance ToCStruct SamplerCustomBorderColorCreateInfoEXT where
  withCStruct :: SamplerCustomBorderColorCreateInfoEXT
-> (Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b) -> IO b
withCStruct SamplerCustomBorderColorCreateInfoEXT
x Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b
f = Int -> (Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b) -> IO b)
-> (Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SamplerCustomBorderColorCreateInfoEXT
p -> Ptr SamplerCustomBorderColorCreateInfoEXT
-> SamplerCustomBorderColorCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SamplerCustomBorderColorCreateInfoEXT
p SamplerCustomBorderColorCreateInfoEXT
x (Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b
f Ptr SamplerCustomBorderColorCreateInfoEXT
p)
  pokeCStruct :: Ptr SamplerCustomBorderColorCreateInfoEXT
-> SamplerCustomBorderColorCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr SamplerCustomBorderColorCreateInfoEXT
p SamplerCustomBorderColorCreateInfoEXT{ClearColorValue
Format
format :: Format
customBorderColor :: ClearColorValue
$sel:format:SamplerCustomBorderColorCreateInfoEXT :: SamplerCustomBorderColorCreateInfoEXT -> Format
$sel:customBorderColor:SamplerCustomBorderColorCreateInfoEXT :: SamplerCustomBorderColorCreateInfoEXT -> ClearColorValue
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CUSTOM_BORDER_COLOR_CREATE_INFO_EXT)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ClearColorValue -> ClearColorValue -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT
-> Int -> Ptr ClearColorValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ClearColorValue)) (ClearColorValue
customBorderColor) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Format)) (Format
format)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr SamplerCustomBorderColorCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr SamplerCustomBorderColorCreateInfoEXT
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLER_CUSTOM_BORDER_COLOR_CREATE_INFO_EXT)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ClearColorValue -> ClearColorValue -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT
-> Int -> Ptr ClearColorValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ClearColorValue)) (ClearColorValue
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SamplerCustomBorderColorCreateInfoEXT
p Ptr SamplerCustomBorderColorCreateInfoEXT -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance Zero SamplerCustomBorderColorCreateInfoEXT where
  zero :: SamplerCustomBorderColorCreateInfoEXT
zero = ClearColorValue -> Format -> SamplerCustomBorderColorCreateInfoEXT
SamplerCustomBorderColorCreateInfoEXT
           ClearColorValue
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero


-- | VkPhysicalDeviceCustomBorderColorPropertiesEXT - Structure describing
-- whether custom border colors can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceCustomBorderColorPropertiesEXT' 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.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_custom_border_color VK_EXT_custom_border_color>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCustomBorderColorPropertiesEXT = PhysicalDeviceCustomBorderColorPropertiesEXT
  { -- | #limits-maxCustomBorderColorSamplers# @maxCustomBorderColorSamplers@
    -- indicates the maximum number of samplers with custom border colors which
    -- /can/ simultaneously exist on a device.
    PhysicalDeviceCustomBorderColorPropertiesEXT -> Word32
maxCustomBorderColorSamplers :: Word32 }
  deriving (Typeable, PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool
(PhysicalDeviceCustomBorderColorPropertiesEXT
 -> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool)
-> (PhysicalDeviceCustomBorderColorPropertiesEXT
    -> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool)
-> Eq PhysicalDeviceCustomBorderColorPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool
$c/= :: PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool
== :: PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool
$c== :: PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCustomBorderColorPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceCustomBorderColorPropertiesEXT

instance ToCStruct PhysicalDeviceCustomBorderColorPropertiesEXT where
  withCStruct :: PhysicalDeviceCustomBorderColorPropertiesEXT
-> (Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceCustomBorderColorPropertiesEXT
x Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p -> Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p PhysicalDeviceCustomBorderColorPropertiesEXT
x (Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b
f Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p)
  pokeCStruct :: Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p PhysicalDeviceCustomBorderColorPropertiesEXT{Word32
maxCustomBorderColorSamplers :: Word32
$sel:maxCustomBorderColorSamplers:PhysicalDeviceCustomBorderColorPropertiesEXT :: PhysicalDeviceCustomBorderColorPropertiesEXT -> Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
maxCustomBorderColorSamplers)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceCustomBorderColorPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_CUSTOM_BORDER_COLOR_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
p Ptr PhysicalDeviceCustomBorderColorPropertiesEXT
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

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

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

instance Zero PhysicalDeviceCustomBorderColorPropertiesEXT where
  zero :: PhysicalDeviceCustomBorderColorPropertiesEXT
zero = Word32 -> PhysicalDeviceCustomBorderColorPropertiesEXT
PhysicalDeviceCustomBorderColorPropertiesEXT
           Word32
forall a. Zero a => a
zero


-- | VkPhysicalDeviceCustomBorderColorFeaturesEXT - Structure describing
-- whether custom border colors can be supported by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceCustomBorderColorFeaturesEXT' 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. 'PhysicalDeviceCustomBorderColorFeaturesEXT' /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_EXT_custom_border_color VK_EXT_custom_border_color>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCustomBorderColorFeaturesEXT = PhysicalDeviceCustomBorderColorFeaturesEXT
  { -- | #features-customBorderColors# @customBorderColors@ indicates that the
    -- implementation supports providing a @borderColor@ value with one of the
    -- following values at sampler creation time:
    --
    -- -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_FLOAT_CUSTOM_EXT'
    --
    -- -   'Vulkan.Core10.Enums.BorderColor.BORDER_COLOR_INT_CUSTOM_EXT'
    PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
customBorderColors :: Bool
  , -- | #features-customBorderColorWithoutFormat#
    -- @customBorderColorWithoutFormat@ indicates that explicit formats are not
    -- required for custom border colors and the value of the @format@ member
    -- of the 'SamplerCustomBorderColorCreateInfoEXT' structure /may/ be
    -- 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED'. If this feature bit is
    -- not set, applications /must/ provide the
    -- 'Vulkan.Core10.Enums.Format.Format' of the image view(s) being sampled
    -- by this sampler in the @format@ member of the
    -- 'SamplerCustomBorderColorCreateInfoEXT' structure.
    PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
customBorderColorWithoutFormat :: Bool
  }
  deriving (Typeable, PhysicalDeviceCustomBorderColorFeaturesEXT
-> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
(PhysicalDeviceCustomBorderColorFeaturesEXT
 -> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool)
-> (PhysicalDeviceCustomBorderColorFeaturesEXT
    -> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool)
-> Eq PhysicalDeviceCustomBorderColorFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCustomBorderColorFeaturesEXT
-> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
$c/= :: PhysicalDeviceCustomBorderColorFeaturesEXT
-> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
== :: PhysicalDeviceCustomBorderColorFeaturesEXT
-> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
$c== :: PhysicalDeviceCustomBorderColorFeaturesEXT
-> PhysicalDeviceCustomBorderColorFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCustomBorderColorFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceCustomBorderColorFeaturesEXT

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

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

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


type EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION = 12

-- No documentation found for TopLevel "VK_EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION"
pattern EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_CUSTOM_BORDER_COLOR_SPEC_VERSION :: a
$mEXT_CUSTOM_BORDER_COLOR_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_CUSTOM_BORDER_COLOR_SPEC_VERSION = 12


type EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME = "VK_EXT_custom_border_color"

-- No documentation found for TopLevel "VK_EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME"
pattern EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME :: a
$mEXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_CUSTOM_BORDER_COLOR_EXTENSION_NAME = "VK_EXT_custom_border_color"