{-# language CPP #-}
-- | = Name
--
-- VK_EXT_depth_bias_control - device extension
--
-- == VK_EXT_depth_bias_control
--
-- [__Name String__]
--     @VK_EXT_depth_bias_control@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     284
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--
-- [__Special Use__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse D3D support>
--
-- [__Contact__]
--
--     -   Joshua Ashton
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_depth_bias_control] @Joshua-Ashton%0A*Here describe the issue or question you have about the VK_EXT_depth_bias_control extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_depth_bias_control.adoc VK_EXT_depth_bias_control>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-02-15
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Joshua Ashton, VALVE
--
--     -   Hans-Kristian Arntzen, VALVE
--
--     -   Mike Blumenkrantz, VALVE
--
--     -   Georg Lehmann, VALVE
--
--     -   Piers Daniell, NVIDIA
--
--     -   Lionel Landwerlin, INTEL
--
--     -   Tobias Hector, AMD
--
--     -   Ricardo Garcia, IGALIA
--
--     -   Jan-Harald Fredriksen, ARM
--
--     -   Shahbaz Youssefi, GOOGLE
--
--     -   Tom Olson, ARM
--
-- == Description
--
-- This extension adds a new structure, 'DepthBiasRepresentationInfoEXT',
-- that can be added to a @pNext@ chain of
-- 'Vulkan.Core10.Pipeline.PipelineRasterizationStateCreateInfo' and allows
-- setting the scaling and representation of depth bias for a pipeline.
--
-- This state can also be set dynamically by using the new structure
-- mentioned above in combination with the new 'cmdSetDepthBias2EXT'
-- command.
--
-- == New Commands
--
-- -   'cmdSetDepthBias2EXT'
--
-- == New Structures
--
-- -   'DepthBiasInfoEXT'
--
-- -   Extending 'DepthBiasInfoEXT',
--     'Vulkan.Core10.Pipeline.PipelineRasterizationStateCreateInfo':
--
--     -   'DepthBiasRepresentationInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceDepthBiasControlFeaturesEXT'
--
-- == New Enums
--
-- -   'DepthBiasRepresentationEXT'
--
-- == New Enum Constants
--
-- -   'EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME'
--
-- -   'EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEPTH_BIAS_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEPTH_BIAS_REPRESENTATION_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_DEPTH_BIAS_CONTROL_FEATURES_EXT'
--
-- == Version History
--
-- -   Revision 1, 2022-09-22 (Joshua Ashton)
--
--     -   Initial draft.
--
-- == See Also
--
-- 'DepthBiasInfoEXT', 'DepthBiasRepresentationEXT',
-- 'DepthBiasRepresentationInfoEXT',
-- 'PhysicalDeviceDepthBiasControlFeaturesEXT', 'cmdSetDepthBias2EXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_depth_bias_control 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_depth_bias_control  ( cmdSetDepthBias2EXT
                                                    , DepthBiasInfoEXT(..)
                                                    , DepthBiasRepresentationInfoEXT(..)
                                                    , PhysicalDeviceDepthBiasControlFeaturesEXT(..)
                                                    , DepthBiasRepresentationEXT( DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT
                                                                                , DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT
                                                                                , DEPTH_BIAS_REPRESENTATION_FLOAT_EXT
                                                                                , ..
                                                                                )
                                                    , EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION
                                                    , pattern EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION
                                                    , EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME
                                                    , pattern EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME
                                                    ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Data.Coerce (coerce)
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 Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetDepthBias2EXT))
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEPTH_BIAS_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEPTH_BIAS_REPRESENTATION_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DEPTH_BIAS_CONTROL_FEATURES_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdSetDepthBias2EXT
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ()

-- | vkCmdSetDepthBias2EXT - Set depth bias factors and clamp dynamically for
-- a command buffer
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdSetDepthBias', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetDepthBias2EXT-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetDepthBias2EXT-pDepthBiasInfo-parameter#
--     @pDepthBiasInfo@ /must/ be a valid pointer to a valid
--     'DepthBiasInfoEXT' structure
--
-- -   #VUID-vkCmdSetDepthBias2EXT-commandBuffer-recording# @commandBuffer@
--     /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdSetDepthBias2EXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSetDepthBias2EXT-videocoding# This command /must/ only be
--     called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Both                                                                                                                   | Outside                                                                                                                     | Graphics                                                                                                              | State                                                                                                                                  |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             |                                                                                                                       |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_depth_bias_control VK_EXT_depth_bias_control>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'DepthBiasInfoEXT'
cmdSetDepthBias2EXT :: forall a io
                     . (Extendss DepthBiasInfoEXT a, PokeChain a, MonadIO io)
                    => -- | @commandBuffer@ is the command buffer into which the command will be
                       -- recorded.
                       CommandBuffer
                    -> -- | @pDepthBiasInfo@ is a pointer to a 'DepthBiasInfoEXT' structure
                       -- specifying depth bias parameters.
                       (DepthBiasInfoEXT a)
                    -> io ()
cmdSetDepthBias2EXT :: forall (a :: [*]) (io :: * -> *).
(Extendss DepthBiasInfoEXT a, PokeChain a, MonadIO io) =>
CommandBuffer -> DepthBiasInfoEXT a -> io ()
cmdSetDepthBias2EXT CommandBuffer
commandBuffer DepthBiasInfoEXT a
depthBiasInfo = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdSetDepthBias2EXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
vkCmdSetDepthBias2EXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
pVkCmdSetDepthBias2EXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
vkCmdSetDepthBias2EXTPtr FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdSetDepthBias2EXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetDepthBias2EXT' :: Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ()
vkCmdSetDepthBias2EXT' = FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
-> Ptr CommandBuffer_T
-> Ptr (SomeStruct DepthBiasInfoEXT)
-> IO ()
mkVkCmdSetDepthBias2EXT FunPtr
  (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ())
vkCmdSetDepthBias2EXTPtr
  Ptr (DepthBiasInfoEXT a)
pDepthBiasInfo <- ((Ptr (DepthBiasInfoEXT a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (DepthBiasInfoEXT a))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (DepthBiasInfoEXT a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (DepthBiasInfoEXT a)))
-> ((Ptr (DepthBiasInfoEXT a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (DepthBiasInfoEXT a))
forall a b. (a -> b) -> a -> b
$ DepthBiasInfoEXT a -> (Ptr (DepthBiasInfoEXT a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
DepthBiasInfoEXT a -> (Ptr (DepthBiasInfoEXT a) -> IO b) -> IO b
withCStruct (DepthBiasInfoEXT a
depthBiasInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetDepthBias2EXT" (Ptr CommandBuffer_T -> Ptr (SomeStruct DepthBiasInfoEXT) -> IO ()
vkCmdSetDepthBias2EXT'
                                                     (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                     (Ptr (DepthBiasInfoEXT a) -> Ptr (SomeStruct DepthBiasInfoEXT)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (DepthBiasInfoEXT a)
pDepthBiasInfo))
  () -> ContT () IO ()
forall a. a -> ContT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkDepthBiasInfoEXT - Structure specifying depth bias parameters
--
-- = Description
--
-- If @pNext@ does not contain a 'DepthBiasRepresentationInfoEXT'
-- structure, then this command is equivalent to including a
-- 'DepthBiasRepresentationInfoEXT' with @depthBiasExact@ set to
-- 'Vulkan.Core10.FundamentalTypes.FALSE' and @depthBiasRepresentation@ set
-- to 'DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT'.
--
-- == Valid Usage
--
-- -   #VUID-VkDepthBiasInfoEXT-depthBiasClamp-08950# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-depthBiasClamp depthBiasClamp>
--     feature is not enabled, @depthBiasClamp@ /must/ be @0.0@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDepthBiasInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEPTH_BIAS_INFO_EXT'
--
-- -   #VUID-VkDepthBiasInfoEXT-pNext-pNext# @pNext@ /must/ be @NULL@ or a
--     pointer to a valid instance of 'DepthBiasRepresentationInfoEXT'
--
-- -   #VUID-VkDepthBiasInfoEXT-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_depth_bias_control VK_EXT_depth_bias_control>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdSetDepthBias2EXT'
data DepthBiasInfoEXT (es :: [Type]) = DepthBiasInfoEXT
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). DepthBiasInfoEXT es -> Chain es
next :: Chain es
  , -- | @depthBiasConstantFactor@ is a scalar factor controlling the constant
    -- depth value added to each fragment.
    forall (es :: [*]). DepthBiasInfoEXT es -> Float
depthBiasConstantFactor :: Float
  , -- | @depthBiasClamp@ is the maximum (or minimum) depth bias of a fragment.
    forall (es :: [*]). DepthBiasInfoEXT es -> Float
depthBiasClamp :: Float
  , -- | @depthBiasSlopeFactor@ is a scalar factor applied to a fragment’s slope
    -- in depth bias calculations.
    forall (es :: [*]). DepthBiasInfoEXT es -> Float
depthBiasSlopeFactor :: Float
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DepthBiasInfoEXT (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (DepthBiasInfoEXT es)

instance Extensible DepthBiasInfoEXT where
  extensibleTypeName :: String
extensibleTypeName = String
"DepthBiasInfoEXT"
  setNext :: forall (ds :: [*]) (es :: [*]).
DepthBiasInfoEXT ds -> Chain es -> DepthBiasInfoEXT es
setNext DepthBiasInfoEXT{Float
Chain ds
$sel:next:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Chain es
$sel:depthBiasConstantFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasClamp:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasSlopeFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
next :: Chain ds
depthBiasConstantFactor :: Float
depthBiasClamp :: Float
depthBiasSlopeFactor :: Float
..} Chain es
next' = DepthBiasInfoEXT{$sel:next:DepthBiasInfoEXT :: Chain es
next = Chain es
next', Float
$sel:depthBiasConstantFactor:DepthBiasInfoEXT :: Float
$sel:depthBiasClamp:DepthBiasInfoEXT :: Float
$sel:depthBiasSlopeFactor:DepthBiasInfoEXT :: Float
depthBiasConstantFactor :: Float
depthBiasClamp :: Float
depthBiasSlopeFactor :: Float
..}
  getNext :: forall (es :: [*]). DepthBiasInfoEXT es -> Chain es
getNext DepthBiasInfoEXT{Float
Chain es
$sel:next:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Chain es
$sel:depthBiasConstantFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasClamp:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasSlopeFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
next :: Chain es
depthBiasConstantFactor :: Float
depthBiasClamp :: Float
depthBiasSlopeFactor :: Float
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends DepthBiasInfoEXT e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends DepthBiasInfoEXT e => b) -> Maybe b
extends proxy e
_ Extends DepthBiasInfoEXT e => b
f
    | Just e :~: DepthBiasRepresentationInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @DepthBiasRepresentationInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends DepthBiasInfoEXT e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance ( Extendss DepthBiasInfoEXT es
         , PokeChain es ) => ToCStruct (DepthBiasInfoEXT es) where
  withCStruct :: forall b.
DepthBiasInfoEXT es -> (Ptr (DepthBiasInfoEXT es) -> IO b) -> IO b
withCStruct DepthBiasInfoEXT es
x Ptr (DepthBiasInfoEXT es) -> IO b
f = Int -> (Ptr (DepthBiasInfoEXT es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr (DepthBiasInfoEXT es) -> IO b) -> IO b)
-> (Ptr (DepthBiasInfoEXT es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (DepthBiasInfoEXT es)
p -> Ptr (DepthBiasInfoEXT es) -> DepthBiasInfoEXT es -> IO b -> IO b
forall b.
Ptr (DepthBiasInfoEXT es) -> DepthBiasInfoEXT es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (DepthBiasInfoEXT es)
p DepthBiasInfoEXT es
x (Ptr (DepthBiasInfoEXT es) -> IO b
f Ptr (DepthBiasInfoEXT es)
p)
  pokeCStruct :: forall b.
Ptr (DepthBiasInfoEXT es) -> DepthBiasInfoEXT es -> IO b -> IO b
pokeCStruct Ptr (DepthBiasInfoEXT es)
p DepthBiasInfoEXT{Float
Chain es
$sel:next:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Chain es
$sel:depthBiasConstantFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasClamp:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
$sel:depthBiasSlopeFactor:DepthBiasInfoEXT :: forall (es :: [*]). DepthBiasInfoEXT es -> Float
next :: Chain es
depthBiasConstantFactor :: Float
depthBiasClamp :: Float
depthBiasSlopeFactor :: Float
..} 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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEPTH_BIAS_INFO_EXT)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> ContT b IO a -> ContT b IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
forall a. Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
depthBiasConstantFactor))
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
depthBiasClamp))
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
depthBiasSlopeFactor))
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (DepthBiasInfoEXT es) -> IO b -> IO b
pokeZeroCStruct Ptr (DepthBiasInfoEXT es)
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 (m :: * -> *) a. Monad m => m a -> ContT b m a
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 (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEPTH_BIAS_INFO_EXT)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> ContT b IO a -> ContT b IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
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 ( Extendss DepthBiasInfoEXT es
         , PeekChain es ) => FromCStruct (DepthBiasInfoEXT es) where
  peekCStruct :: Ptr (DepthBiasInfoEXT es) -> IO (DepthBiasInfoEXT es)
peekCStruct Ptr (DepthBiasInfoEXT es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    CFloat
depthBiasConstantFactor <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr CFloat))
    CFloat
depthBiasClamp <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr CFloat))
    CFloat
depthBiasSlopeFactor <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr (DepthBiasInfoEXT es)
p Ptr (DepthBiasInfoEXT es) -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CFloat))
    DepthBiasInfoEXT es -> IO (DepthBiasInfoEXT es)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepthBiasInfoEXT es -> IO (DepthBiasInfoEXT es))
-> DepthBiasInfoEXT es -> IO (DepthBiasInfoEXT es)
forall a b. (a -> b) -> a -> b
$ Chain es -> Float -> Float -> Float -> DepthBiasInfoEXT es
forall (es :: [*]).
Chain es -> Float -> Float -> Float -> DepthBiasInfoEXT es
DepthBiasInfoEXT
             Chain es
next
             (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
depthBiasConstantFactor)
             (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
depthBiasClamp)
             (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
depthBiasSlopeFactor)

instance es ~ '[] => Zero (DepthBiasInfoEXT es) where
  zero :: DepthBiasInfoEXT es
zero = Chain es -> Float -> Float -> Float -> DepthBiasInfoEXT es
forall (es :: [*]).
Chain es -> Float -> Float -> Float -> DepthBiasInfoEXT es
DepthBiasInfoEXT
           ()
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


-- | VkDepthBiasRepresentationInfoEXT - Structure specifying depth bias
-- parameters
--
-- == Valid Usage
--
-- -   #VUID-VkDepthBiasRepresentationInfoEXT-leastRepresentableValueForceUnormRepresentation-08947#
--     If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-leastRepresentableValueForceUnormRepresentation leastRepresentableValueForceUnormRepresentation>
--     feature is not enabled, @depthBiasRepresentation@ /must/ not be
--     'DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT'
--
-- -   #VUID-VkDepthBiasRepresentationInfoEXT-floatRepresentation-08948# If
--     the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-floatRepresentation floatRepresentation>
--     feature is not enabled, @depthBiasRepresentation@ /must/ not be
--     'DEPTH_BIAS_REPRESENTATION_FLOAT_EXT'
--
-- -   #VUID-VkDepthBiasRepresentationInfoEXT-depthBiasExact-08949# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-depthBiasExact depthBiasExact>
--     feature is not enabled, @depthBiasExact@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDepthBiasRepresentationInfoEXT-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEPTH_BIAS_REPRESENTATION_INFO_EXT'
--
-- -   #VUID-VkDepthBiasRepresentationInfoEXT-depthBiasRepresentation-parameter#
--     @depthBiasRepresentation@ /must/ be a valid
--     'DepthBiasRepresentationEXT' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_depth_bias_control VK_EXT_depth_bias_control>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32', 'DepthBiasRepresentationEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DepthBiasRepresentationInfoEXT = DepthBiasRepresentationInfoEXT
  { -- | @depthBiasRepresentation@ is a 'DepthBiasRepresentationEXT' value
    -- specifying the depth bias representation.
    DepthBiasRepresentationInfoEXT -> DepthBiasRepresentationEXT
depthBiasRepresentation :: DepthBiasRepresentationEXT
  , -- | @depthBiasExact@ specifies that the implementation is not allowed to
    -- scale the depth bias value to ensure a minimum resolvable distance.
    DepthBiasRepresentationInfoEXT -> Bool
depthBiasExact :: Bool
  }
  deriving (Typeable, DepthBiasRepresentationInfoEXT
-> DepthBiasRepresentationInfoEXT -> Bool
(DepthBiasRepresentationInfoEXT
 -> DepthBiasRepresentationInfoEXT -> Bool)
-> (DepthBiasRepresentationInfoEXT
    -> DepthBiasRepresentationInfoEXT -> Bool)
-> Eq DepthBiasRepresentationInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepthBiasRepresentationInfoEXT
-> DepthBiasRepresentationInfoEXT -> Bool
== :: DepthBiasRepresentationInfoEXT
-> DepthBiasRepresentationInfoEXT -> Bool
$c/= :: DepthBiasRepresentationInfoEXT
-> DepthBiasRepresentationInfoEXT -> Bool
/= :: DepthBiasRepresentationInfoEXT
-> DepthBiasRepresentationInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DepthBiasRepresentationInfoEXT)
#endif
deriving instance Show DepthBiasRepresentationInfoEXT

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

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

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


-- | VkPhysicalDeviceDepthBiasControlFeaturesEXT - Structure indicating
-- support for depth bias scaling and representation control
--
-- = Members
--
-- This structure describes the following feature:
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_depth_bias_control VK_EXT_depth_bias_control>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDepthBiasControlFeaturesEXT = PhysicalDeviceDepthBiasControlFeaturesEXT
  { -- | #features-depthBiasControl# @depthBiasControl@ indicates whether the
    -- implementation supports the 'cmdSetDepthBias2EXT' command and the
    -- 'DepthBiasRepresentationInfoEXT' structure.
    PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
depthBiasControl :: Bool
  , -- | #features-leastRepresentableValueForceUnormRepresentation#
    -- @leastRepresentableValueForceUnormRepresentation@ indicates whether the
    -- implementation supports using the
    -- 'DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT'
    -- depth bias representation.
    PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
leastRepresentableValueForceUnormRepresentation :: Bool
  , -- | #features-floatRepresentation# @floatRepresentation@ indicates whether
    -- the implementation supports using the
    -- 'DEPTH_BIAS_REPRESENTATION_FLOAT_EXT' depth bias representation.
    PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
floatRepresentation :: Bool
  , -- | #features-depthBiasExact# @depthBiasExact@ indicates whether the
    -- implementation supports forcing depth bias to not be scaled to ensure a
    -- minimum resolvable difference using
    -- 'DepthBiasRepresentationInfoEXT'::@depthBiasExact@.
    PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
depthBiasExact :: Bool
  }
  deriving (Typeable, PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
(PhysicalDeviceDepthBiasControlFeaturesEXT
 -> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool)
-> (PhysicalDeviceDepthBiasControlFeaturesEXT
    -> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool)
-> Eq PhysicalDeviceDepthBiasControlFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
== :: PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
$c/= :: PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
/= :: PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDepthBiasControlFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceDepthBiasControlFeaturesEXT

instance ToCStruct PhysicalDeviceDepthBiasControlFeaturesEXT where
  withCStruct :: forall b.
PhysicalDeviceDepthBiasControlFeaturesEXT
-> (Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceDepthBiasControlFeaturesEXT
x Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p -> Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b -> IO b
forall b.
Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p PhysicalDeviceDepthBiasControlFeaturesEXT
x (Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b
f Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p PhysicalDeviceDepthBiasControlFeaturesEXT{Bool
$sel:depthBiasControl:PhysicalDeviceDepthBiasControlFeaturesEXT :: PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
$sel:leastRepresentableValueForceUnormRepresentation:PhysicalDeviceDepthBiasControlFeaturesEXT :: PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
$sel:floatRepresentation:PhysicalDeviceDepthBiasControlFeaturesEXT :: PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
$sel:depthBiasExact:PhysicalDeviceDepthBiasControlFeaturesEXT :: PhysicalDeviceDepthBiasControlFeaturesEXT -> Bool
depthBiasControl :: Bool
leastRepresentableValueForceUnormRepresentation :: Bool
floatRepresentation :: Bool
depthBiasExact :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEPTH_BIAS_CONTROL_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> 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 PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
depthBiasControl))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
leastRepresentableValueForceUnormRepresentation))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
floatRepresentation))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
depthBiasExact))
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DEPTH_BIAS_CONTROL_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> 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 PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> 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 PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: 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 PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceDepthBiasControlFeaturesEXT where
  peekCStruct :: Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
-> IO PhysicalDeviceDepthBiasControlFeaturesEXT
peekCStruct Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p = do
    Bool32
depthBiasControl <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    Bool32
leastRepresentableValueForceUnormRepresentation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    Bool32
floatRepresentation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32))
    Bool32
depthBiasExact <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDepthBiasControlFeaturesEXT
p Ptr PhysicalDeviceDepthBiasControlFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32))
    PhysicalDeviceDepthBiasControlFeaturesEXT
-> IO PhysicalDeviceDepthBiasControlFeaturesEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceDepthBiasControlFeaturesEXT
 -> IO PhysicalDeviceDepthBiasControlFeaturesEXT)
-> PhysicalDeviceDepthBiasControlFeaturesEXT
-> IO PhysicalDeviceDepthBiasControlFeaturesEXT
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceDepthBiasControlFeaturesEXT
PhysicalDeviceDepthBiasControlFeaturesEXT
             (Bool32 -> Bool
bool32ToBool Bool32
depthBiasControl)
             (Bool32 -> Bool
bool32ToBool Bool32
leastRepresentableValueForceUnormRepresentation)
             (Bool32 -> Bool
bool32ToBool Bool32
floatRepresentation)
             (Bool32 -> Bool
bool32ToBool Bool32
depthBiasExact)

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

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


-- | VkDepthBiasRepresentationEXT - Specify the depth bias representation
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_depth_bias_control VK_EXT_depth_bias_control>,
-- 'DepthBiasRepresentationInfoEXT'
newtype DepthBiasRepresentationEXT = DepthBiasRepresentationEXT Int32
  deriving newtype (DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
(DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> Bool)
-> Eq DepthBiasRepresentationEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
== :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
$c/= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
/= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
Eq, Eq DepthBiasRepresentationEXT
Eq DepthBiasRepresentationEXT =>
(DepthBiasRepresentationEXT
 -> DepthBiasRepresentationEXT -> Ordering)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> Bool)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> Bool)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> Bool)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> Bool)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT)
-> (DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT)
-> Ord DepthBiasRepresentationEXT
DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> Ordering
DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT
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
$ccompare :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> Ordering
compare :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> Ordering
$c< :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
< :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
$c<= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
<= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
$c> :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
> :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
$c>= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
>= :: DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT -> Bool
$cmax :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT
max :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT
$cmin :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT
min :: DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> DepthBiasRepresentationEXT
Ord, Ptr DepthBiasRepresentationEXT -> IO DepthBiasRepresentationEXT
Ptr DepthBiasRepresentationEXT
-> Int -> IO DepthBiasRepresentationEXT
Ptr DepthBiasRepresentationEXT
-> Int -> DepthBiasRepresentationEXT -> IO ()
Ptr DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> IO ()
DepthBiasRepresentationEXT -> Int
(DepthBiasRepresentationEXT -> Int)
-> (DepthBiasRepresentationEXT -> Int)
-> (Ptr DepthBiasRepresentationEXT
    -> Int -> IO DepthBiasRepresentationEXT)
-> (Ptr DepthBiasRepresentationEXT
    -> Int -> DepthBiasRepresentationEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO DepthBiasRepresentationEXT)
-> (forall b. Ptr b -> Int -> DepthBiasRepresentationEXT -> IO ())
-> (Ptr DepthBiasRepresentationEXT
    -> IO DepthBiasRepresentationEXT)
-> (Ptr DepthBiasRepresentationEXT
    -> DepthBiasRepresentationEXT -> IO ())
-> Storable DepthBiasRepresentationEXT
forall b. Ptr b -> Int -> IO DepthBiasRepresentationEXT
forall b. Ptr b -> Int -> DepthBiasRepresentationEXT -> 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
$csizeOf :: DepthBiasRepresentationEXT -> Int
sizeOf :: DepthBiasRepresentationEXT -> Int
$calignment :: DepthBiasRepresentationEXT -> Int
alignment :: DepthBiasRepresentationEXT -> Int
$cpeekElemOff :: Ptr DepthBiasRepresentationEXT
-> Int -> IO DepthBiasRepresentationEXT
peekElemOff :: Ptr DepthBiasRepresentationEXT
-> Int -> IO DepthBiasRepresentationEXT
$cpokeElemOff :: Ptr DepthBiasRepresentationEXT
-> Int -> DepthBiasRepresentationEXT -> IO ()
pokeElemOff :: Ptr DepthBiasRepresentationEXT
-> Int -> DepthBiasRepresentationEXT -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DepthBiasRepresentationEXT
peekByteOff :: forall b. Ptr b -> Int -> IO DepthBiasRepresentationEXT
$cpokeByteOff :: forall b. Ptr b -> Int -> DepthBiasRepresentationEXT -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DepthBiasRepresentationEXT -> IO ()
$cpeek :: Ptr DepthBiasRepresentationEXT -> IO DepthBiasRepresentationEXT
peek :: Ptr DepthBiasRepresentationEXT -> IO DepthBiasRepresentationEXT
$cpoke :: Ptr DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> IO ()
poke :: Ptr DepthBiasRepresentationEXT
-> DepthBiasRepresentationEXT -> IO ()
Storable, DepthBiasRepresentationEXT
DepthBiasRepresentationEXT -> Zero DepthBiasRepresentationEXT
forall a. a -> Zero a
$czero :: DepthBiasRepresentationEXT
zero :: DepthBiasRepresentationEXT
Zero)

-- | 'DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT'
-- specifies that the depth bias representation is a factor of the format’s
-- r as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#primsrast-depthbias-computation>.
pattern $bDEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT :: DepthBiasRepresentationEXT
$mDEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT :: forall {r}.
DepthBiasRepresentationEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT = DepthBiasRepresentationEXT 0

-- | 'DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT'
-- specifies that the depth bias representation is a factor of a constant r
-- defined by the bit-size or mantissa of the format as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#primsrast-depthbias-computation>.
pattern $bDEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT :: DepthBiasRepresentationEXT
$mDEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT :: forall {r}.
DepthBiasRepresentationEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT = DepthBiasRepresentationEXT 1

-- | 'DEPTH_BIAS_REPRESENTATION_FLOAT_EXT' specifies that the depth bias
-- representation is a factor of constant r equal to 1.
pattern $bDEPTH_BIAS_REPRESENTATION_FLOAT_EXT :: DepthBiasRepresentationEXT
$mDEPTH_BIAS_REPRESENTATION_FLOAT_EXT :: forall {r}.
DepthBiasRepresentationEXT -> ((# #) -> r) -> ((# #) -> r) -> r
DEPTH_BIAS_REPRESENTATION_FLOAT_EXT = DepthBiasRepresentationEXT 2

{-# COMPLETE
  DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT
  , DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT
  , DEPTH_BIAS_REPRESENTATION_FLOAT_EXT ::
    DepthBiasRepresentationEXT
  #-}

conNameDepthBiasRepresentationEXT :: String
conNameDepthBiasRepresentationEXT :: String
conNameDepthBiasRepresentationEXT = String
"DepthBiasRepresentationEXT"

enumPrefixDepthBiasRepresentationEXT :: String
enumPrefixDepthBiasRepresentationEXT :: String
enumPrefixDepthBiasRepresentationEXT = String
"DEPTH_BIAS_REPRESENTATION_"

showTableDepthBiasRepresentationEXT :: [(DepthBiasRepresentationEXT, String)]
showTableDepthBiasRepresentationEXT :: [(DepthBiasRepresentationEXT, String)]
showTableDepthBiasRepresentationEXT =
  [
    ( DepthBiasRepresentationEXT
DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORMAT_EXT
    , String
"LEAST_REPRESENTABLE_VALUE_FORMAT_EXT"
    )
  ,
    ( DepthBiasRepresentationEXT
DEPTH_BIAS_REPRESENTATION_LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT
    , String
"LEAST_REPRESENTABLE_VALUE_FORCE_UNORM_EXT"
    )
  ,
    ( DepthBiasRepresentationEXT
DEPTH_BIAS_REPRESENTATION_FLOAT_EXT
    , String
"FLOAT_EXT"
    )
  ]

instance Show DepthBiasRepresentationEXT where
  showsPrec :: Int -> DepthBiasRepresentationEXT -> ShowS
showsPrec =
    String
-> [(DepthBiasRepresentationEXT, String)]
-> String
-> (DepthBiasRepresentationEXT -> Int32)
-> (Int32 -> ShowS)
-> Int
-> DepthBiasRepresentationEXT
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixDepthBiasRepresentationEXT
      [(DepthBiasRepresentationEXT, String)]
showTableDepthBiasRepresentationEXT
      String
conNameDepthBiasRepresentationEXT
      (\(DepthBiasRepresentationEXT Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read DepthBiasRepresentationEXT where
  readPrec :: ReadPrec DepthBiasRepresentationEXT
readPrec =
    String
-> [(DepthBiasRepresentationEXT, String)]
-> String
-> (Int32 -> DepthBiasRepresentationEXT)
-> ReadPrec DepthBiasRepresentationEXT
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixDepthBiasRepresentationEXT
      [(DepthBiasRepresentationEXT, String)]
showTableDepthBiasRepresentationEXT
      String
conNameDepthBiasRepresentationEXT
      Int32 -> DepthBiasRepresentationEXT
DepthBiasRepresentationEXT

type EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION"
pattern EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_DEPTH_BIAS_CONTROL_SPEC_VERSION :: forall a. Integral a => a
$mEXT_DEPTH_BIAS_CONTROL_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEPTH_BIAS_CONTROL_SPEC_VERSION = 1


type EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME = "VK_EXT_depth_bias_control"

-- No documentation found for TopLevel "VK_EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME"
pattern EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_DEPTH_BIAS_CONTROL_EXTENSION_NAME = "VK_EXT_depth_bias_control"