{-# language CPP #-}
-- | = Name
--
-- VK_EXT_sample_locations - device extension
--
-- == VK_EXT_sample_locations
--
-- [__Name String__]
--     @VK_EXT_sample_locations@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     144
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
-- [__Contact__]
--
--     -   Daniel Rakos
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_sample_locations] @drakos-amd%0A*Here describe the issue or question you have about the VK_EXT_sample_locations extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2017-08-02
--
-- [__Contributors__]
--
--     -   Mais Alnasser, AMD
--
--     -   Matthaeus G. Chajdas, AMD
--
--     -   Maciej Jesionowski, AMD
--
--     -   Daniel Rakos, AMD
--
--     -   Slawomir Grajewski, Intel
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Bill Licea-Kane, Qualcomm
--
-- == Description
--
-- This extension allows an application to modify the locations of samples
-- within a pixel used in rasterization. Additionally, it allows
-- applications to specify different sample locations for each pixel in a
-- group of adjacent pixels, which /can/ increase antialiasing quality
-- (particularly if a custom resolve shader is used that takes advantage of
-- these different locations).
--
-- It is common for implementations to optimize the storage of depth values
-- by storing values that /can/ be used to reconstruct depth at each sample
-- location, rather than storing separate depth values for each sample. For
-- example, the depth values from a single triangle /may/ be represented
-- using plane equations. When the depth value for a sample is needed, it
-- is automatically evaluated at the sample location. Modifying the sample
-- locations causes the reconstruction to no longer evaluate the same depth
-- values as when the samples were originally generated, thus the depth
-- aspect of a depth\/stencil attachment /must/ be cleared before rendering
-- to it using different sample locations.
--
-- Some implementations /may/ need to evaluate depth image values while
-- performing image layout transitions. To accommodate this, instances of
-- the 'SampleLocationsInfoEXT' structure /can/ be specified for each
-- situation where an explicit or automatic layout transition has to take
-- place. 'SampleLocationsInfoEXT' /can/ be chained from
-- 'Vulkan.Core10.OtherTypes.ImageMemoryBarrier' structures to provide
-- sample locations for layout transitions performed by
-- 'Vulkan.Core10.CommandBufferBuilding.cmdWaitEvents' and
-- 'Vulkan.Core10.CommandBufferBuilding.cmdPipelineBarrier' calls, and
-- 'RenderPassSampleLocationsBeginInfoEXT' /can/ be chained from
-- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo' to provide
-- sample locations for layout transitions performed implicitly by a render
-- pass instance.
--
-- == New Commands
--
-- -   'cmdSetSampleLocationsEXT'
--
-- -   'getPhysicalDeviceMultisamplePropertiesEXT'
--
-- == New Structures
--
-- -   'AttachmentSampleLocationsEXT'
--
-- -   'MultisamplePropertiesEXT'
--
-- -   'SampleLocationEXT'
--
-- -   'SubpassSampleLocationsEXT'
--
-- -   Extending 'Vulkan.Core10.OtherTypes.ImageMemoryBarrier',
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.ImageMemoryBarrier2':
--
--     -   'SampleLocationsInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceSampleLocationsPropertiesEXT'
--
-- -   Extending
--     'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo':
--
--     -   'PipelineSampleLocationsStateCreateInfoEXT'
--
-- -   Extending 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo':
--
--     -   'RenderPassSampleLocationsBeginInfoEXT'
--
-- == New Enum Constants
--
-- -   'EXT_SAMPLE_LOCATIONS_EXTENSION_NAME'
--
-- -   'EXT_SAMPLE_LOCATIONS_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.DynamicState.DynamicState':
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SAMPLE_LOCATIONS_EXT'
--
-- -   Extending
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SAMPLE_LOCATIONS_COMPATIBLE_DEPTH_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MULTISAMPLE_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLE_LOCATIONS_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_SAMPLE_LOCATIONS_STATE_CREATE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDER_PASS_SAMPLE_LOCATIONS_BEGIN_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLE_LOCATIONS_INFO_EXT'
--
-- == Version History
--
-- -   Revision 1, 2017-08-02 (Daniel Rakos)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'AttachmentSampleLocationsEXT', 'MultisamplePropertiesEXT',
-- 'PhysicalDeviceSampleLocationsPropertiesEXT',
-- 'PipelineSampleLocationsStateCreateInfoEXT',
-- 'RenderPassSampleLocationsBeginInfoEXT', 'SampleLocationEXT',
-- 'SampleLocationsInfoEXT', 'SubpassSampleLocationsEXT',
-- 'cmdSetSampleLocationsEXT', 'getPhysicalDeviceMultisamplePropertiesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_sample_locations 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_sample_locations  ( cmdSetSampleLocationsEXT
                                                  , getPhysicalDeviceMultisamplePropertiesEXT
                                                  , SampleLocationEXT(..)
                                                  , SampleLocationsInfoEXT(..)
                                                  , AttachmentSampleLocationsEXT(..)
                                                  , SubpassSampleLocationsEXT(..)
                                                  , RenderPassSampleLocationsBeginInfoEXT(..)
                                                  , PipelineSampleLocationsStateCreateInfoEXT(..)
                                                  , PhysicalDeviceSampleLocationsPropertiesEXT(..)
                                                  , MultisamplePropertiesEXT(..)
                                                  , EXT_SAMPLE_LOCATIONS_SPEC_VERSION
                                                  , pattern EXT_SAMPLE_LOCATIONS_SPEC_VERSION
                                                  , EXT_SAMPLE_LOCATIONS_EXTENSION_NAME
                                                  , pattern EXT_SAMPLE_LOCATIONS_EXTENSION_NAME
                                                  ) where

import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
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 Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
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(pVkCmdSetSampleLocationsEXT))
import Vulkan.Core10.FundamentalTypes (Extent2D)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceMultisamplePropertiesEXT))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MULTISAMPLE_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLE_LOCATIONS_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_SAMPLE_LOCATIONS_STATE_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDER_PASS_SAMPLE_LOCATIONS_BEGIN_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SAMPLE_LOCATIONS_INFO_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdSetSampleLocationsEXT
  :: FunPtr (Ptr CommandBuffer_T -> Ptr SampleLocationsInfoEXT -> IO ()) -> Ptr CommandBuffer_T -> Ptr SampleLocationsInfoEXT -> IO ()

-- | vkCmdSetSampleLocationsEXT - Set sample locations dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the custom sample locations for subsequent drawing
-- commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SAMPLE_LOCATIONS_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@,
-- and when the
-- 'PipelineSampleLocationsStateCreateInfoEXT'::@sampleLocationsEnable@
-- property of the bound graphics pipeline is
-- 'Vulkan.Core10.FundamentalTypes.TRUE'. Otherwise, this state is
-- specified by the
-- 'PipelineSampleLocationsStateCreateInfoEXT'::@sampleLocationsInfo@
-- values used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetSampleLocationsEXT-variableSampleLocations-01530# If
--     'PhysicalDeviceSampleLocationsPropertiesEXT'::@variableSampleLocations@
--     is 'Vulkan.Core10.FundamentalTypes.FALSE' then the current render
--     pass /must/ have been begun by specifying a
--     'RenderPassSampleLocationsBeginInfoEXT' structure whose
--     @pPostSubpassSampleLocations@ member contains an element with a
--     @subpassIndex@ matching the current subpass index and the
--     @sampleLocationsInfo@ member of that element /must/ match the sample
--     locations state pointed to by @pSampleLocationsInfo@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetSampleLocationsEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetSampleLocationsEXT-pSampleLocationsInfo-parameter#
--     @pSampleLocationsInfo@ /must/ be a valid pointer to a valid
--     'SampleLocationsInfoEXT' structure
--
-- -   #VUID-vkCmdSetSampleLocationsEXT-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-vkCmdSetSampleLocationsEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSetSampleLocationsEXT-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_sample_locations VK_EXT_sample_locations>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'SampleLocationsInfoEXT'
cmdSetSampleLocationsEXT :: forall io
                          . (MonadIO io)
                         => -- | @commandBuffer@ is the command buffer into which the command will be
                            -- recorded.
                            CommandBuffer
                         -> -- | @pSampleLocationsInfo@ is the sample locations state to set.
                            SampleLocationsInfoEXT
                         -> io ()
cmdSetSampleLocationsEXT :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> SampleLocationsInfoEXT -> io ()
cmdSetSampleLocationsEXT CommandBuffer
commandBuffer
                           SampleLocationsInfoEXT
sampleLocationsInfo = IO () -> io ()
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 vkCmdSetSampleLocationsEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
vkCmdSetSampleLocationsEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
      -> IO ())
pVkCmdSetSampleLocationsEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
vkCmdSetSampleLocationsEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> 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 vkCmdSetSampleLocationsEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetSampleLocationsEXT' :: Ptr CommandBuffer_T
-> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO ()
vkCmdSetSampleLocationsEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> IO ()
mkVkCmdSetSampleLocationsEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
vkCmdSetSampleLocationsEXTPtr
  "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
pSampleLocationsInfo <- ((("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO ())
 -> IO ())
-> ContT
     () IO ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
   -> IO ())
  -> IO ())
 -> ContT
      () IO ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT))
-> ((("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
forall a b. (a -> b) -> a -> b
$ SampleLocationsInfoEXT
-> (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SampleLocationsInfoEXT
sampleLocationsInfo)
  IO () -> ContT () IO ()
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
"vkCmdSetSampleLocationsEXT" (Ptr CommandBuffer_T
-> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO ()
vkCmdSetSampleLocationsEXT'
                                                          (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                          "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
pSampleLocationsInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceMultisamplePropertiesEXT
  :: FunPtr (Ptr PhysicalDevice_T -> SampleCountFlagBits -> Ptr MultisamplePropertiesEXT -> IO ()) -> Ptr PhysicalDevice_T -> SampleCountFlagBits -> Ptr MultisamplePropertiesEXT -> IO ()

-- | vkGetPhysicalDeviceMultisamplePropertiesEXT - Report sample count
-- specific multisampling capabilities of a physical device
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'MultisamplePropertiesEXT', 'Vulkan.Core10.Handles.PhysicalDevice',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits'
getPhysicalDeviceMultisamplePropertiesEXT :: forall io
                                           . (MonadIO io)
                                          => -- | @physicalDevice@ is the physical device from which to query the
                                             -- additional multisampling capabilities.
                                             --
                                             -- #VUID-vkGetPhysicalDeviceMultisamplePropertiesEXT-physicalDevice-parameter#
                                             -- @physicalDevice@ /must/ be a valid
                                             -- 'Vulkan.Core10.Handles.PhysicalDevice' handle
                                             PhysicalDevice
                                          -> -- | @samples@ is a
                                             -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
                                             -- specifying the sample count to query capabilities for.
                                             --
                                             -- #VUID-vkGetPhysicalDeviceMultisamplePropertiesEXT-samples-parameter#
                                             -- @samples@ /must/ be a valid
                                             -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
                                             ("samples" ::: SampleCountFlagBits)
                                          -> io (MultisamplePropertiesEXT)
getPhysicalDeviceMultisamplePropertiesEXT :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> ("samples" ::: SampleCountFlagBits)
-> io MultisamplePropertiesEXT
getPhysicalDeviceMultisamplePropertiesEXT PhysicalDevice
physicalDevice
                                            "samples" ::: SampleCountFlagBits
samples = IO MultisamplePropertiesEXT -> io MultisamplePropertiesEXT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MultisamplePropertiesEXT -> io MultisamplePropertiesEXT)
-> (ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
    -> IO MultisamplePropertiesEXT)
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
-> io MultisamplePropertiesEXT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
-> IO MultisamplePropertiesEXT
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
 -> io MultisamplePropertiesEXT)
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
-> io MultisamplePropertiesEXT
forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceMultisamplePropertiesEXTPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> IO ())
vkGetPhysicalDeviceMultisamplePropertiesEXTPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("samples" ::: SampleCountFlagBits)
      -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
      -> IO ())
pVkGetPhysicalDeviceMultisamplePropertiesEXT (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  IO () -> ContT MultisamplePropertiesEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MultisamplePropertiesEXT IO ())
-> IO () -> ContT MultisamplePropertiesEXT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> IO ())
vkGetPhysicalDeviceMultisamplePropertiesEXTPtr FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> IO ())
-> FunPtr
     (Ptr PhysicalDevice_T
      -> ("samples" ::: SampleCountFlagBits)
      -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> 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 vkGetPhysicalDeviceMultisamplePropertiesEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceMultisamplePropertiesEXT' :: Ptr PhysicalDevice_T
-> ("samples" ::: SampleCountFlagBits)
-> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
-> IO ()
vkGetPhysicalDeviceMultisamplePropertiesEXT' = FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> IO ())
-> Ptr PhysicalDevice_T
-> ("samples" ::: SampleCountFlagBits)
-> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
-> IO ()
mkVkGetPhysicalDeviceMultisamplePropertiesEXT FunPtr
  (Ptr PhysicalDevice_T
   -> ("samples" ::: SampleCountFlagBits)
   -> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
   -> IO ())
vkGetPhysicalDeviceMultisamplePropertiesEXTPtr
  "pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT
pPMultisampleProperties <- ((("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
  -> IO MultisamplePropertiesEXT)
 -> IO MultisamplePropertiesEXT)
-> ContT
     MultisamplePropertiesEXT
     IO
     ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @MultisamplePropertiesEXT)
  IO () -> ContT MultisamplePropertiesEXT IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MultisamplePropertiesEXT IO ())
-> IO () -> ContT MultisamplePropertiesEXT IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceMultisamplePropertiesEXT" (Ptr PhysicalDevice_T
-> ("samples" ::: SampleCountFlagBits)
-> ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
-> IO ()
vkGetPhysicalDeviceMultisamplePropertiesEXT'
                                                                           (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
                                                                           ("samples" ::: SampleCountFlagBits
samples)
                                                                           ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT
pPMultisampleProperties))
  MultisamplePropertiesEXT
pMultisampleProperties <- IO MultisamplePropertiesEXT
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO MultisamplePropertiesEXT
 -> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT)
-> IO MultisamplePropertiesEXT
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MultisamplePropertiesEXT "pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT
pPMultisampleProperties
  MultisamplePropertiesEXT
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultisamplePropertiesEXT
 -> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT)
-> MultisamplePropertiesEXT
-> ContT MultisamplePropertiesEXT IO MultisamplePropertiesEXT
forall a b. (a -> b) -> a -> b
$ (MultisamplePropertiesEXT
pMultisampleProperties)


-- | VkSampleLocationEXT - Structure specifying the coordinates of a sample
-- location
--
-- = Description
--
-- The domain space of the sample location coordinates has an upper-left
-- origin within the pixel in framebuffer space.
--
-- The values specified in a 'SampleLocationEXT' structure are always
-- clamped to the implementation-dependent sample location coordinate range
-- [@sampleLocationCoordinateRange@[0],@sampleLocationCoordinateRange@[1]]
-- that /can/ be queried using
-- 'PhysicalDeviceSampleLocationsPropertiesEXT'.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'SampleLocationsInfoEXT'
data SampleLocationEXT = SampleLocationEXT
  { -- | @x@ is the horizontal coordinate of the sample’s location.
    SampleLocationEXT -> Float
x :: Float
  , -- | @y@ is the vertical coordinate of the sample’s location.
    SampleLocationEXT -> Float
y :: Float
  }
  deriving (Typeable, SampleLocationEXT -> SampleLocationEXT -> Bool
(SampleLocationEXT -> SampleLocationEXT -> Bool)
-> (SampleLocationEXT -> SampleLocationEXT -> Bool)
-> Eq SampleLocationEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleLocationEXT -> SampleLocationEXT -> Bool
$c/= :: SampleLocationEXT -> SampleLocationEXT -> Bool
== :: SampleLocationEXT -> SampleLocationEXT -> Bool
$c== :: SampleLocationEXT -> SampleLocationEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SampleLocationEXT)
#endif
deriving instance Show SampleLocationEXT

instance ToCStruct SampleLocationEXT where
  withCStruct :: forall b.
SampleLocationEXT -> (Ptr SampleLocationEXT -> IO b) -> IO b
withCStruct SampleLocationEXT
x Ptr SampleLocationEXT -> IO b
f = Int -> (Ptr SampleLocationEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 ((Ptr SampleLocationEXT -> IO b) -> IO b)
-> (Ptr SampleLocationEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SampleLocationEXT
p -> Ptr SampleLocationEXT -> SampleLocationEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SampleLocationEXT
p SampleLocationEXT
x (Ptr SampleLocationEXT -> IO b
f Ptr SampleLocationEXT
p)
  pokeCStruct :: forall b.
Ptr SampleLocationEXT -> SampleLocationEXT -> IO b -> IO b
pokeCStruct Ptr SampleLocationEXT
p SampleLocationEXT{Float
y :: Float
x :: Float
$sel:y:SampleLocationEXT :: SampleLocationEXT -> Float
$sel:x:SampleLocationEXT :: SampleLocationEXT -> Float
..} IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
x))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
y))
    IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr SampleLocationEXT -> IO b -> IO b
pokeZeroCStruct Ptr SampleLocationEXT
p IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct SampleLocationEXT where
  peekCStruct :: Ptr SampleLocationEXT -> IO SampleLocationEXT
peekCStruct Ptr SampleLocationEXT
p = do
    CFloat
x <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr CFloat))
    CFloat
y <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr SampleLocationEXT
p Ptr SampleLocationEXT -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat))
    SampleLocationEXT -> IO SampleLocationEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SampleLocationEXT -> IO SampleLocationEXT)
-> SampleLocationEXT -> IO SampleLocationEXT
forall a b. (a -> b) -> a -> b
$ Float -> Float -> SampleLocationEXT
SampleLocationEXT
             (forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
x) (forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
y)

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

instance Zero SampleLocationEXT where
  zero :: SampleLocationEXT
zero = Float -> Float -> SampleLocationEXT
SampleLocationEXT
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


-- | VkSampleLocationsInfoEXT - Structure specifying a set of sample
-- locations
--
-- = Description
--
-- This structure /can/ be used either to specify the sample locations to
-- be used for rendering or to specify the set of sample locations an image
-- subresource has been last rendered with for the purposes of layout
-- transitions of depth\/stencil images created with
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SAMPLE_LOCATIONS_COMPATIBLE_DEPTH_BIT_EXT'.
--
-- The sample locations in @pSampleLocations@ specify
-- @sampleLocationsPerPixel@ number of sample locations for each pixel in
-- the grid of the size specified in @sampleLocationGridSize@. The sample
-- location for sample i at the pixel grid location (x,y) is taken from
-- @pSampleLocations@[(x + y × @sampleLocationGridSize.width@) ×
-- @sampleLocationsPerPixel@ + i].
--
-- If the render pass has a fragment density map, the implementation will
-- choose the sample locations for the fragment and the contents of
-- @pSampleLocations@ /may/ be ignored.
--
-- == Valid Usage
--
-- -   #VUID-VkSampleLocationsInfoEXT-sampleLocationsPerPixel-01526#
--     @sampleLocationsPerPixel@ /must/ be a bit value that is set in
--     'PhysicalDeviceSampleLocationsPropertiesEXT'::@sampleLocationSampleCounts@
--
-- -   #VUID-VkSampleLocationsInfoEXT-sampleLocationsCount-01527#
--     @sampleLocationsCount@ /must/ equal @sampleLocationsPerPixel@ ×
--     @sampleLocationGridSize.width@ × @sampleLocationGridSize.height@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSampleLocationsInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SAMPLE_LOCATIONS_INFO_EXT'
--
-- -   #VUID-VkSampleLocationsInfoEXT-pSampleLocations-parameter# If
--     @sampleLocationsCount@ is not @0@, @pSampleLocations@ /must/ be a
--     valid pointer to an array of @sampleLocationsCount@
--     'SampleLocationEXT' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'AttachmentSampleLocationsEXT',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'PipelineSampleLocationsStateCreateInfoEXT',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'SampleLocationEXT', 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'SubpassSampleLocationsEXT', 'cmdSetSampleLocationsEXT'
data SampleLocationsInfoEXT = SampleLocationsInfoEXT
  { -- | @sampleLocationsPerPixel@ is a
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
    -- specifying the number of sample locations per pixel.
    SampleLocationsInfoEXT -> "samples" ::: SampleCountFlagBits
sampleLocationsPerPixel :: SampleCountFlagBits
  , -- | @sampleLocationGridSize@ is the size of the sample location grid to
    -- select custom sample locations for.
    SampleLocationsInfoEXT -> Extent2D
sampleLocationGridSize :: Extent2D
  , -- | @pSampleLocations@ is a pointer to an array of @sampleLocationsCount@
    -- 'SampleLocationEXT' structures.
    SampleLocationsInfoEXT -> Vector SampleLocationEXT
sampleLocations :: Vector SampleLocationEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SampleLocationsInfoEXT)
#endif
deriving instance Show SampleLocationsInfoEXT

instance ToCStruct SampleLocationsInfoEXT where
  withCStruct :: forall b.
SampleLocationsInfoEXT
-> (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
    -> IO b)
-> IO b
withCStruct SampleLocationsInfoEXT
x ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO b
f = Int
-> (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO b)
 -> IO b)
-> (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p -> ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p SampleLocationsInfoEXT
x (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT) -> IO b
f "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p)
  pokeCStruct :: forall b.
("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
pokeCStruct "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p SampleLocationsInfoEXT{Vector SampleLocationEXT
"samples" ::: SampleCountFlagBits
Extent2D
sampleLocations :: Vector SampleLocationEXT
sampleLocationGridSize :: Extent2D
sampleLocationsPerPixel :: "samples" ::: SampleCountFlagBits
$sel:sampleLocations:SampleLocationsInfoEXT :: SampleLocationsInfoEXT -> Vector SampleLocationEXT
$sel:sampleLocationGridSize:SampleLocationsInfoEXT :: SampleLocationsInfoEXT -> Extent2D
$sel:sampleLocationsPerPixel:SampleLocationsInfoEXT :: SampleLocationsInfoEXT -> "samples" ::: SampleCountFlagBits
..} 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 (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLE_LOCATIONS_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 (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 ("samples" ::: SampleCountFlagBits)
-> ("samples" ::: SampleCountFlagBits) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlagBits)) ("samples" ::: SampleCountFlagBits
sampleLocationsPerPixel)
    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 Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
sampleLocationGridSize)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SampleLocationEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SampleLocationEXT -> Int)
-> Vector SampleLocationEXT -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SampleLocationEXT
sampleLocations)) :: Word32))
    Ptr SampleLocationEXT
pPSampleLocations' <- ((Ptr SampleLocationEXT -> IO b) -> IO b)
-> ContT b IO (Ptr SampleLocationEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SampleLocationEXT -> IO b) -> IO b)
 -> ContT b IO (Ptr SampleLocationEXT))
-> ((Ptr SampleLocationEXT -> IO b) -> IO b)
-> ContT b IO (Ptr SampleLocationEXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @SampleLocationEXT ((Vector SampleLocationEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SampleLocationEXT
sampleLocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
    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
$ (Int -> SampleLocationEXT -> IO ())
-> Vector SampleLocationEXT -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SampleLocationEXT
e -> Ptr SampleLocationEXT -> SampleLocationEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SampleLocationEXT
pPSampleLocations' Ptr SampleLocationEXT -> Int -> Ptr SampleLocationEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SampleLocationEXT) (SampleLocationEXT
e)) (Vector SampleLocationEXT
sampleLocations)
    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 SampleLocationEXT) -> Ptr SampleLocationEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr (Ptr SampleLocationEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr SampleLocationEXT))) (Ptr SampleLocationEXT
pPSampleLocations')
    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 :: forall b.
("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SAMPLE_LOCATIONS_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("samples" ::: SampleCountFlagBits)
-> ("samples" ::: SampleCountFlagBits) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlagBits)) ("samples" ::: SampleCountFlagBits
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SampleLocationsInfoEXT where
  peekCStruct :: ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> IO SampleLocationsInfoEXT
peekCStruct "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p = do
    "samples" ::: SampleCountFlagBits
sampleLocationsPerPixel <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlagBits))
    Extent2D
sampleLocationGridSize <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D))
    Word32
sampleLocationsCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    Ptr SampleLocationEXT
pSampleLocations <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SampleLocationEXT) (("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
p ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> Int -> Ptr (Ptr SampleLocationEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr SampleLocationEXT)))
    Vector SampleLocationEXT
pSampleLocations' <- Int
-> (Int -> IO SampleLocationEXT) -> IO (Vector SampleLocationEXT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sampleLocationsCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SampleLocationEXT ((Ptr SampleLocationEXT
pSampleLocations Ptr SampleLocationEXT -> Int -> Ptr SampleLocationEXT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SampleLocationEXT)))
    SampleLocationsInfoEXT -> IO SampleLocationsInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SampleLocationsInfoEXT -> IO SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO SampleLocationsInfoEXT
forall a b. (a -> b) -> a -> b
$ ("samples" ::: SampleCountFlagBits)
-> Extent2D -> Vector SampleLocationEXT -> SampleLocationsInfoEXT
SampleLocationsInfoEXT
             "samples" ::: SampleCountFlagBits
sampleLocationsPerPixel Extent2D
sampleLocationGridSize Vector SampleLocationEXT
pSampleLocations'

instance Zero SampleLocationsInfoEXT where
  zero :: SampleLocationsInfoEXT
zero = ("samples" ::: SampleCountFlagBits)
-> Extent2D -> Vector SampleLocationEXT -> SampleLocationsInfoEXT
SampleLocationsInfoEXT
           "samples" ::: SampleCountFlagBits
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Vector SampleLocationEXT
forall a. Monoid a => a
mempty


-- | VkAttachmentSampleLocationsEXT - Structure specifying the sample
-- locations state to use in the initial layout transition of attachments
--
-- = Description
--
-- If the image referenced by the framebuffer attachment at index
-- @attachmentIndex@ was not created with
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SAMPLE_LOCATIONS_COMPATIBLE_DEPTH_BIT_EXT'
-- then the values specified in @sampleLocationsInfo@ are ignored.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'RenderPassSampleLocationsBeginInfoEXT', 'SampleLocationsInfoEXT'
data AttachmentSampleLocationsEXT = AttachmentSampleLocationsEXT
  { -- | @attachmentIndex@ is the index of the attachment for which the sample
    -- locations state is provided.
    --
    -- #VUID-VkAttachmentSampleLocationsEXT-attachmentIndex-01531#
    -- @attachmentIndex@ /must/ be less than the @attachmentCount@ specified in
    -- 'Vulkan.Core10.Pass.RenderPassCreateInfo' the render pass specified by
    -- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo'::@renderPass@
    -- was created with
    AttachmentSampleLocationsEXT -> Word32
attachmentIndex :: Word32
  , -- | @sampleLocationsInfo@ is the sample locations state to use for the
    -- layout transition of the given attachment from the initial layout of the
    -- attachment to the image layout specified for the attachment in the first
    -- subpass using it.
    --
    -- #VUID-VkAttachmentSampleLocationsEXT-sampleLocationsInfo-parameter#
    -- @sampleLocationsInfo@ /must/ be a valid 'SampleLocationsInfoEXT'
    -- structure
    AttachmentSampleLocationsEXT -> SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentSampleLocationsEXT)
#endif
deriving instance Show AttachmentSampleLocationsEXT

instance ToCStruct AttachmentSampleLocationsEXT where
  withCStruct :: forall b.
AttachmentSampleLocationsEXT
-> (Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b
withCStruct AttachmentSampleLocationsEXT
x Ptr AttachmentSampleLocationsEXT -> IO b
f = Int -> (Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b)
-> (Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr AttachmentSampleLocationsEXT
p -> Ptr AttachmentSampleLocationsEXT
-> AttachmentSampleLocationsEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr AttachmentSampleLocationsEXT
p AttachmentSampleLocationsEXT
x (Ptr AttachmentSampleLocationsEXT -> IO b
f Ptr AttachmentSampleLocationsEXT
p)
  pokeCStruct :: forall b.
Ptr AttachmentSampleLocationsEXT
-> AttachmentSampleLocationsEXT -> IO b -> IO b
pokeCStruct Ptr AttachmentSampleLocationsEXT
p AttachmentSampleLocationsEXT{Word32
SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
attachmentIndex :: Word32
$sel:sampleLocationsInfo:AttachmentSampleLocationsEXT :: AttachmentSampleLocationsEXT -> SampleLocationsInfoEXT
$sel:attachmentIndex:AttachmentSampleLocationsEXT :: AttachmentSampleLocationsEXT -> Word32
..} 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
attachmentIndex)
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
sampleLocationsInfo) (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 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
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr AttachmentSampleLocationsEXT -> IO b -> IO b
pokeZeroCStruct Ptr AttachmentSampleLocationsEXT
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
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 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 FromCStruct AttachmentSampleLocationsEXT where
  peekCStruct :: Ptr AttachmentSampleLocationsEXT -> IO AttachmentSampleLocationsEXT
peekCStruct Ptr AttachmentSampleLocationsEXT
p = do
    Word32
attachmentIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    SampleLocationsInfoEXT
sampleLocationsInfo <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SampleLocationsInfoEXT ((Ptr AttachmentSampleLocationsEXT
p Ptr AttachmentSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT))
    AttachmentSampleLocationsEXT -> IO AttachmentSampleLocationsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttachmentSampleLocationsEXT -> IO AttachmentSampleLocationsEXT)
-> AttachmentSampleLocationsEXT -> IO AttachmentSampleLocationsEXT
forall a b. (a -> b) -> a -> b
$ Word32 -> SampleLocationsInfoEXT -> AttachmentSampleLocationsEXT
AttachmentSampleLocationsEXT
             Word32
attachmentIndex SampleLocationsInfoEXT
sampleLocationsInfo

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


-- | VkSubpassSampleLocationsEXT - Structure specifying the sample locations
-- state to use for layout transitions of attachments performed after a
-- given subpass
--
-- = Description
--
-- If the image referenced by the depth\/stencil attachment used in the
-- subpass identified by @subpassIndex@ was not created with
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SAMPLE_LOCATIONS_COMPATIBLE_DEPTH_BIT_EXT'
-- or if the subpass does not use a depth\/stencil attachment, and
-- 'PhysicalDeviceSampleLocationsPropertiesEXT'::@variableSampleLocations@
-- is 'Vulkan.Core10.FundamentalTypes.TRUE' then the values specified in
-- @sampleLocationsInfo@ are ignored.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'RenderPassSampleLocationsBeginInfoEXT', 'SampleLocationsInfoEXT'
data SubpassSampleLocationsEXT = SubpassSampleLocationsEXT
  { -- | @subpassIndex@ is the index of the subpass for which the sample
    -- locations state is provided.
    --
    -- #VUID-VkSubpassSampleLocationsEXT-subpassIndex-01532# @subpassIndex@
    -- /must/ be less than the @subpassCount@ specified in
    -- 'Vulkan.Core10.Pass.RenderPassCreateInfo' the render pass specified by
    -- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo'::@renderPass@
    -- was created with
    SubpassSampleLocationsEXT -> Word32
subpassIndex :: Word32
  , -- | @sampleLocationsInfo@ is the sample locations state to use for the
    -- layout transition of the depth\/stencil attachment away from the image
    -- layout the attachment is used with in the subpass specified in
    -- @subpassIndex@.
    --
    -- #VUID-VkSubpassSampleLocationsEXT-sampleLocationsInfo-parameter#
    -- @sampleLocationsInfo@ /must/ be a valid 'SampleLocationsInfoEXT'
    -- structure
    SubpassSampleLocationsEXT -> SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassSampleLocationsEXT)
#endif
deriving instance Show SubpassSampleLocationsEXT

instance ToCStruct SubpassSampleLocationsEXT where
  withCStruct :: forall b.
SubpassSampleLocationsEXT
-> (Ptr SubpassSampleLocationsEXT -> IO b) -> IO b
withCStruct SubpassSampleLocationsEXT
x Ptr SubpassSampleLocationsEXT -> IO b
f = Int -> (Ptr SubpassSampleLocationsEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr SubpassSampleLocationsEXT -> IO b) -> IO b)
-> (Ptr SubpassSampleLocationsEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SubpassSampleLocationsEXT
p -> Ptr SubpassSampleLocationsEXT
-> SubpassSampleLocationsEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SubpassSampleLocationsEXT
p SubpassSampleLocationsEXT
x (Ptr SubpassSampleLocationsEXT -> IO b
f Ptr SubpassSampleLocationsEXT
p)
  pokeCStruct :: forall b.
Ptr SubpassSampleLocationsEXT
-> SubpassSampleLocationsEXT -> IO b -> IO b
pokeCStruct Ptr SubpassSampleLocationsEXT
p SubpassSampleLocationsEXT{Word32
SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
subpassIndex :: Word32
$sel:sampleLocationsInfo:SubpassSampleLocationsEXT :: SubpassSampleLocationsEXT -> SampleLocationsInfoEXT
$sel:subpassIndex:SubpassSampleLocationsEXT :: SubpassSampleLocationsEXT -> Word32
..} 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
subpassIndex)
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
sampleLocationsInfo) (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 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
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SubpassSampleLocationsEXT -> IO b -> IO b
pokeZeroCStruct Ptr SubpassSampleLocationsEXT
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
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 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 FromCStruct SubpassSampleLocationsEXT where
  peekCStruct :: Ptr SubpassSampleLocationsEXT -> IO SubpassSampleLocationsEXT
peekCStruct Ptr SubpassSampleLocationsEXT
p = do
    Word32
subpassIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    SampleLocationsInfoEXT
sampleLocationsInfo <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SampleLocationsInfoEXT ((Ptr SubpassSampleLocationsEXT
p Ptr SubpassSampleLocationsEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr SampleLocationsInfoEXT))
    SubpassSampleLocationsEXT -> IO SubpassSampleLocationsEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassSampleLocationsEXT -> IO SubpassSampleLocationsEXT)
-> SubpassSampleLocationsEXT -> IO SubpassSampleLocationsEXT
forall a b. (a -> b) -> a -> b
$ Word32 -> SampleLocationsInfoEXT -> SubpassSampleLocationsEXT
SubpassSampleLocationsEXT
             Word32
subpassIndex SampleLocationsInfoEXT
sampleLocationsInfo

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


-- | VkRenderPassSampleLocationsBeginInfoEXT - Structure specifying sample
-- locations to use for the layout transition of custom sample locations
-- compatible depth\/stencil attachments
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderPassSampleLocationsBeginInfoEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDER_PASS_SAMPLE_LOCATIONS_BEGIN_INFO_EXT'
--
-- -   #VUID-VkRenderPassSampleLocationsBeginInfoEXT-pAttachmentInitialSampleLocations-parameter#
--     If @attachmentInitialSampleLocationsCount@ is not @0@,
--     @pAttachmentInitialSampleLocations@ /must/ be a valid pointer to an
--     array of @attachmentInitialSampleLocationsCount@ valid
--     'AttachmentSampleLocationsEXT' structures
--
-- -   #VUID-VkRenderPassSampleLocationsBeginInfoEXT-pPostSubpassSampleLocations-parameter#
--     If @postSubpassSampleLocationsCount@ is not @0@,
--     @pPostSubpassSampleLocations@ /must/ be a valid pointer to an array
--     of @postSubpassSampleLocationsCount@ valid
--     'SubpassSampleLocationsEXT' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'AttachmentSampleLocationsEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'SubpassSampleLocationsEXT'
data RenderPassSampleLocationsBeginInfoEXT = RenderPassSampleLocationsBeginInfoEXT
  { -- | @pAttachmentInitialSampleLocations@ is a pointer to an array of
    -- @attachmentInitialSampleLocationsCount@ 'AttachmentSampleLocationsEXT'
    -- structures specifying the attachment indices and their corresponding
    -- sample location state. Each element of
    -- @pAttachmentInitialSampleLocations@ /can/ specify the sample location
    -- state to use in the automatic layout transition performed to transition
    -- a depth\/stencil attachment from the initial layout of the attachment to
    -- the image layout specified for the attachment in the first subpass using
    -- it.
    RenderPassSampleLocationsBeginInfoEXT
-> Vector AttachmentSampleLocationsEXT
attachmentInitialSampleLocations :: Vector AttachmentSampleLocationsEXT
  , -- | @pPostSubpassSampleLocations@ is a pointer to an array of
    -- @postSubpassSampleLocationsCount@ 'SubpassSampleLocationsEXT' structures
    -- specifying the subpass indices and their corresponding sample location
    -- state. Each element of @pPostSubpassSampleLocations@ /can/ specify the
    -- sample location state to use in the automatic layout transition
    -- performed to transition the depth\/stencil attachment used by the
    -- specified subpass to the image layout specified in a dependent subpass
    -- or to the final layout of the attachment in case the specified subpass
    -- is the last subpass using that attachment. In addition, if
    -- 'PhysicalDeviceSampleLocationsPropertiesEXT'::@variableSampleLocations@
    -- is 'Vulkan.Core10.FundamentalTypes.FALSE', each element of
    -- @pPostSubpassSampleLocations@ /must/ specify the sample location state
    -- that matches the sample locations used by all pipelines that will be
    -- bound to a command buffer during the specified subpass. If
    -- @variableSampleLocations@ is 'Vulkan.Core10.FundamentalTypes.TRUE', the
    -- sample locations used for rasterization do not depend on
    -- @pPostSubpassSampleLocations@.
    RenderPassSampleLocationsBeginInfoEXT
-> Vector SubpassSampleLocationsEXT
postSubpassSampleLocations :: Vector SubpassSampleLocationsEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderPassSampleLocationsBeginInfoEXT)
#endif
deriving instance Show RenderPassSampleLocationsBeginInfoEXT

instance ToCStruct RenderPassSampleLocationsBeginInfoEXT where
  withCStruct :: forall b.
RenderPassSampleLocationsBeginInfoEXT
-> (Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b) -> IO b
withCStruct RenderPassSampleLocationsBeginInfoEXT
x Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b
f = Int -> (Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b) -> IO b)
-> (Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderPassSampleLocationsBeginInfoEXT
p -> Ptr RenderPassSampleLocationsBeginInfoEXT
-> RenderPassSampleLocationsBeginInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderPassSampleLocationsBeginInfoEXT
p RenderPassSampleLocationsBeginInfoEXT
x (Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b
f Ptr RenderPassSampleLocationsBeginInfoEXT
p)
  pokeCStruct :: forall b.
Ptr RenderPassSampleLocationsBeginInfoEXT
-> RenderPassSampleLocationsBeginInfoEXT -> IO b -> IO b
pokeCStruct Ptr RenderPassSampleLocationsBeginInfoEXT
p RenderPassSampleLocationsBeginInfoEXT{Vector SubpassSampleLocationsEXT
Vector AttachmentSampleLocationsEXT
postSubpassSampleLocations :: Vector SubpassSampleLocationsEXT
attachmentInitialSampleLocations :: Vector AttachmentSampleLocationsEXT
$sel:postSubpassSampleLocations:RenderPassSampleLocationsBeginInfoEXT :: RenderPassSampleLocationsBeginInfoEXT
-> Vector SubpassSampleLocationsEXT
$sel:attachmentInitialSampleLocations:RenderPassSampleLocationsBeginInfoEXT :: RenderPassSampleLocationsBeginInfoEXT
-> Vector AttachmentSampleLocationsEXT
..} 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 RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_SAMPLE_LOCATIONS_BEGIN_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 RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector AttachmentSampleLocationsEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector AttachmentSampleLocationsEXT -> Int)
-> Vector AttachmentSampleLocationsEXT -> Int
forall a b. (a -> b) -> a -> b
$ (Vector AttachmentSampleLocationsEXT
attachmentInitialSampleLocations)) :: Word32))
    Ptr AttachmentSampleLocationsEXT
pPAttachmentInitialSampleLocations' <- ((Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b)
-> ContT b IO (Ptr AttachmentSampleLocationsEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b)
 -> ContT b IO (Ptr AttachmentSampleLocationsEXT))
-> ((Ptr AttachmentSampleLocationsEXT -> IO b) -> IO b)
-> ContT b IO (Ptr AttachmentSampleLocationsEXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @AttachmentSampleLocationsEXT ((Vector AttachmentSampleLocationsEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector AttachmentSampleLocationsEXT
attachmentInitialSampleLocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)
    (Int -> AttachmentSampleLocationsEXT -> ContT b IO ())
-> Vector AttachmentSampleLocationsEXT -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i AttachmentSampleLocationsEXT
e -> ((() -> 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 AttachmentSampleLocationsEXT
-> AttachmentSampleLocationsEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr AttachmentSampleLocationsEXT
pPAttachmentInitialSampleLocations' Ptr AttachmentSampleLocationsEXT
-> Int -> Ptr AttachmentSampleLocationsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AttachmentSampleLocationsEXT) (AttachmentSampleLocationsEXT
e) (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
$ ())) (Vector AttachmentSampleLocationsEXT
attachmentInitialSampleLocations)
    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 AttachmentSampleLocationsEXT)
-> Ptr AttachmentSampleLocationsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr (Ptr AttachmentSampleLocationsEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr AttachmentSampleLocationsEXT))) (Ptr AttachmentSampleLocationsEXT
pPAttachmentInitialSampleLocations')
    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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SubpassSampleLocationsEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SubpassSampleLocationsEXT -> Int)
-> Vector SubpassSampleLocationsEXT -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SubpassSampleLocationsEXT
postSubpassSampleLocations)) :: Word32))
    Ptr SubpassSampleLocationsEXT
pPPostSubpassSampleLocations' <- ((Ptr SubpassSampleLocationsEXT -> IO b) -> IO b)
-> ContT b IO (Ptr SubpassSampleLocationsEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SubpassSampleLocationsEXT -> IO b) -> IO b)
 -> ContT b IO (Ptr SubpassSampleLocationsEXT))
-> ((Ptr SubpassSampleLocationsEXT -> IO b) -> IO b)
-> ContT b IO (Ptr SubpassSampleLocationsEXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @SubpassSampleLocationsEXT ((Vector SubpassSampleLocationsEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SubpassSampleLocationsEXT
postSubpassSampleLocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)
    (Int -> SubpassSampleLocationsEXT -> ContT b IO ())
-> Vector SubpassSampleLocationsEXT -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SubpassSampleLocationsEXT
e -> ((() -> 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 SubpassSampleLocationsEXT
-> SubpassSampleLocationsEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SubpassSampleLocationsEXT
pPPostSubpassSampleLocations' Ptr SubpassSampleLocationsEXT
-> Int -> Ptr SubpassSampleLocationsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SubpassSampleLocationsEXT) (SubpassSampleLocationsEXT
e) (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
$ ())) (Vector SubpassSampleLocationsEXT
postSubpassSampleLocations)
    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 SubpassSampleLocationsEXT)
-> Ptr SubpassSampleLocationsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr (Ptr SubpassSampleLocationsEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr SubpassSampleLocationsEXT))) (Ptr SubpassSampleLocationsEXT
pPPostSubpassSampleLocations')
    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
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr RenderPassSampleLocationsBeginInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr RenderPassSampleLocationsBeginInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_SAMPLE_LOCATIONS_BEGIN_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct RenderPassSampleLocationsBeginInfoEXT where
  peekCStruct :: Ptr RenderPassSampleLocationsBeginInfoEXT
-> IO RenderPassSampleLocationsBeginInfoEXT
peekCStruct Ptr RenderPassSampleLocationsBeginInfoEXT
p = do
    Word32
attachmentInitialSampleLocationsCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr AttachmentSampleLocationsEXT
pAttachmentInitialSampleLocations <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr AttachmentSampleLocationsEXT) ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr (Ptr AttachmentSampleLocationsEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr AttachmentSampleLocationsEXT)))
    Vector AttachmentSampleLocationsEXT
pAttachmentInitialSampleLocations' <- Int
-> (Int -> IO AttachmentSampleLocationsEXT)
-> IO (Vector AttachmentSampleLocationsEXT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
attachmentInitialSampleLocationsCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AttachmentSampleLocationsEXT ((Ptr AttachmentSampleLocationsEXT
pAttachmentInitialSampleLocations Ptr AttachmentSampleLocationsEXT
-> Int -> Ptr AttachmentSampleLocationsEXT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AttachmentSampleLocationsEXT)))
    Word32
postSubpassSampleLocationsCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr SubpassSampleLocationsEXT
pPostSubpassSampleLocations <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SubpassSampleLocationsEXT) ((Ptr RenderPassSampleLocationsBeginInfoEXT
p Ptr RenderPassSampleLocationsBeginInfoEXT
-> Int -> Ptr (Ptr SubpassSampleLocationsEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr SubpassSampleLocationsEXT)))
    Vector SubpassSampleLocationsEXT
pPostSubpassSampleLocations' <- Int
-> (Int -> IO SubpassSampleLocationsEXT)
-> IO (Vector SubpassSampleLocationsEXT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
postSubpassSampleLocationsCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SubpassSampleLocationsEXT ((Ptr SubpassSampleLocationsEXT
pPostSubpassSampleLocations Ptr SubpassSampleLocationsEXT
-> Int -> Ptr SubpassSampleLocationsEXT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SubpassSampleLocationsEXT)))
    RenderPassSampleLocationsBeginInfoEXT
-> IO RenderPassSampleLocationsBeginInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderPassSampleLocationsBeginInfoEXT
 -> IO RenderPassSampleLocationsBeginInfoEXT)
-> RenderPassSampleLocationsBeginInfoEXT
-> IO RenderPassSampleLocationsBeginInfoEXT
forall a b. (a -> b) -> a -> b
$ Vector AttachmentSampleLocationsEXT
-> Vector SubpassSampleLocationsEXT
-> RenderPassSampleLocationsBeginInfoEXT
RenderPassSampleLocationsBeginInfoEXT
             Vector AttachmentSampleLocationsEXT
pAttachmentInitialSampleLocations' Vector SubpassSampleLocationsEXT
pPostSubpassSampleLocations'

instance Zero RenderPassSampleLocationsBeginInfoEXT where
  zero :: RenderPassSampleLocationsBeginInfoEXT
zero = Vector AttachmentSampleLocationsEXT
-> Vector SubpassSampleLocationsEXT
-> RenderPassSampleLocationsBeginInfoEXT
RenderPassSampleLocationsBeginInfoEXT
           Vector AttachmentSampleLocationsEXT
forall a. Monoid a => a
mempty
           Vector SubpassSampleLocationsEXT
forall a. Monoid a => a
mempty


-- | VkPipelineSampleLocationsStateCreateInfoEXT - Structure specifying
-- sample locations for a pipeline
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32', 'SampleLocationsInfoEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineSampleLocationsStateCreateInfoEXT = PipelineSampleLocationsStateCreateInfoEXT
  { -- | @sampleLocationsEnable@ controls whether custom sample locations are
    -- used. If @sampleLocationsEnable@ is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', the default sample locations are
    -- used and the values specified in @sampleLocationsInfo@ are ignored.
    PipelineSampleLocationsStateCreateInfoEXT -> Bool
sampleLocationsEnable :: Bool
  , -- | @sampleLocationsInfo@ is the sample locations to use during
    -- rasterization if @sampleLocationsEnable@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE' and the graphics pipeline is not
    -- created with
    -- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SAMPLE_LOCATIONS_EXT'.
    --
    -- #VUID-VkPipelineSampleLocationsStateCreateInfoEXT-sampleLocationsInfo-parameter#
    -- @sampleLocationsInfo@ /must/ be a valid 'SampleLocationsInfoEXT'
    -- structure
    PipelineSampleLocationsStateCreateInfoEXT -> SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineSampleLocationsStateCreateInfoEXT)
#endif
deriving instance Show PipelineSampleLocationsStateCreateInfoEXT

instance ToCStruct PipelineSampleLocationsStateCreateInfoEXT where
  withCStruct :: forall b.
PipelineSampleLocationsStateCreateInfoEXT
-> (Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b) -> IO b
withCStruct PipelineSampleLocationsStateCreateInfoEXT
x Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b
f = Int
-> (Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 ((Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b) -> IO b)
-> (Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PipelineSampleLocationsStateCreateInfoEXT
p -> Ptr PipelineSampleLocationsStateCreateInfoEXT
-> PipelineSampleLocationsStateCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineSampleLocationsStateCreateInfoEXT
p PipelineSampleLocationsStateCreateInfoEXT
x (Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b
f Ptr PipelineSampleLocationsStateCreateInfoEXT
p)
  pokeCStruct :: forall b.
Ptr PipelineSampleLocationsStateCreateInfoEXT
-> PipelineSampleLocationsStateCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr PipelineSampleLocationsStateCreateInfoEXT
p PipelineSampleLocationsStateCreateInfoEXT{Bool
SampleLocationsInfoEXT
sampleLocationsInfo :: SampleLocationsInfoEXT
sampleLocationsEnable :: Bool
$sel:sampleLocationsInfo:PipelineSampleLocationsStateCreateInfoEXT :: PipelineSampleLocationsStateCreateInfoEXT -> SampleLocationsInfoEXT
$sel:sampleLocationsEnable:PipelineSampleLocationsStateCreateInfoEXT :: PipelineSampleLocationsStateCreateInfoEXT -> Bool
..} 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 PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SAMPLE_LOCATIONS_STATE_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 PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sampleLocationsEnable))
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
sampleLocationsInfo) (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 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
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PipelineSampleLocationsStateCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr PipelineSampleLocationsStateCreateInfoEXT
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 PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_SAMPLE_LOCATIONS_STATE_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 PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    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 Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT -> 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))
    ((() -> 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
$ ("pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT)
-> SampleLocationsInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleLocationsInfoEXT)) (SampleLocationsInfoEXT
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 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 FromCStruct PipelineSampleLocationsStateCreateInfoEXT where
  peekCStruct :: Ptr PipelineSampleLocationsStateCreateInfoEXT
-> IO PipelineSampleLocationsStateCreateInfoEXT
peekCStruct Ptr PipelineSampleLocationsStateCreateInfoEXT
p = do
    Bool32
sampleLocationsEnable <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    SampleLocationsInfoEXT
sampleLocationsInfo <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SampleLocationsInfoEXT ((Ptr PipelineSampleLocationsStateCreateInfoEXT
p Ptr PipelineSampleLocationsStateCreateInfoEXT
-> Int -> "pSampleLocationsInfo" ::: Ptr SampleLocationsInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleLocationsInfoEXT))
    PipelineSampleLocationsStateCreateInfoEXT
-> IO PipelineSampleLocationsStateCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineSampleLocationsStateCreateInfoEXT
 -> IO PipelineSampleLocationsStateCreateInfoEXT)
-> PipelineSampleLocationsStateCreateInfoEXT
-> IO PipelineSampleLocationsStateCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ Bool
-> SampleLocationsInfoEXT
-> PipelineSampleLocationsStateCreateInfoEXT
PipelineSampleLocationsStateCreateInfoEXT
             (Bool32 -> Bool
bool32ToBool Bool32
sampleLocationsEnable) SampleLocationsInfoEXT
sampleLocationsInfo

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


-- | VkPhysicalDeviceSampleLocationsPropertiesEXT - Structure describing
-- sample location limits that can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceSampleLocationsPropertiesEXT' 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_sample_locations VK_EXT_sample_locations>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSampleLocationsPropertiesEXT = PhysicalDeviceSampleLocationsPropertiesEXT
  { -- | #limits-sampleLocationSampleCounts# @sampleLocationSampleCounts@ is a
    -- bitmask of 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits'
    -- indicating the sample counts supporting custom sample locations.
    PhysicalDeviceSampleLocationsPropertiesEXT
-> "samples" ::: SampleCountFlagBits
sampleLocationSampleCounts :: SampleCountFlags
  , -- | #limits-maxSampleLocationGridSize# @maxSampleLocationGridSize@ is the
    -- maximum size of the pixel grid in which sample locations /can/ vary that
    -- is supported for all sample counts in @sampleLocationSampleCounts@.
    PhysicalDeviceSampleLocationsPropertiesEXT -> Extent2D
maxSampleLocationGridSize :: Extent2D
  , -- | #limits-sampleLocationCoordinateRange#
    -- @sampleLocationCoordinateRange@[2] is the range of supported sample
    -- location coordinates.
    PhysicalDeviceSampleLocationsPropertiesEXT -> (Float, Float)
sampleLocationCoordinateRange :: (Float, Float)
  , -- | #limits-sampleLocationSubPixelBits# @sampleLocationSubPixelBits@ is the
    -- number of bits of subpixel precision for sample locations.
    PhysicalDeviceSampleLocationsPropertiesEXT -> Word32
sampleLocationSubPixelBits :: Word32
  , -- | #limits-variableSampleLocations# @variableSampleLocations@ specifies
    -- whether the sample locations used by all pipelines that will be bound to
    -- a command buffer during a subpass /must/ match. If set to
    -- 'Vulkan.Core10.FundamentalTypes.TRUE', the implementation supports
    -- variable sample locations in a subpass. If set to
    -- 'Vulkan.Core10.FundamentalTypes.FALSE', then the sample locations /must/
    -- stay constant in each subpass.
    PhysicalDeviceSampleLocationsPropertiesEXT -> Bool
variableSampleLocations :: Bool
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSampleLocationsPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceSampleLocationsPropertiesEXT

instance ToCStruct PhysicalDeviceSampleLocationsPropertiesEXT where
  withCStruct :: forall b.
PhysicalDeviceSampleLocationsPropertiesEXT
-> (Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceSampleLocationsPropertiesEXT
x Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p -> Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> PhysicalDeviceSampleLocationsPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p PhysicalDeviceSampleLocationsPropertiesEXT
x (Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b
f Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> PhysicalDeviceSampleLocationsPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p PhysicalDeviceSampleLocationsPropertiesEXT{Bool
Word32
(Float, Float)
"samples" ::: SampleCountFlagBits
Extent2D
variableSampleLocations :: Bool
sampleLocationSubPixelBits :: Word32
sampleLocationCoordinateRange :: (Float, Float)
maxSampleLocationGridSize :: Extent2D
sampleLocationSampleCounts :: "samples" ::: SampleCountFlagBits
$sel:variableSampleLocations:PhysicalDeviceSampleLocationsPropertiesEXT :: PhysicalDeviceSampleLocationsPropertiesEXT -> Bool
$sel:sampleLocationSubPixelBits:PhysicalDeviceSampleLocationsPropertiesEXT :: PhysicalDeviceSampleLocationsPropertiesEXT -> Word32
$sel:sampleLocationCoordinateRange:PhysicalDeviceSampleLocationsPropertiesEXT :: PhysicalDeviceSampleLocationsPropertiesEXT -> (Float, Float)
$sel:maxSampleLocationGridSize:PhysicalDeviceSampleLocationsPropertiesEXT :: PhysicalDeviceSampleLocationsPropertiesEXT -> Extent2D
$sel:sampleLocationSampleCounts:PhysicalDeviceSampleLocationsPropertiesEXT :: PhysicalDeviceSampleLocationsPropertiesEXT
-> "samples" ::: SampleCountFlagBits
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLE_LOCATIONS_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("samples" ::: SampleCountFlagBits)
-> ("samples" ::: SampleCountFlagBits) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlags)) ("samples" ::: SampleCountFlagBits
sampleLocationSampleCounts)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
maxSampleLocationGridSize)
    let pSampleLocationCoordinateRange' :: Ptr CFloat
pSampleLocationCoordinateRange' = Ptr (FixedArray 2 CFloat) -> Ptr CFloat
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr (FixedArray 2 CFloat)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray 2 CFloat)))
    case ((Float, Float)
sampleLocationCoordinateRange) of
      (Float
e0, Float
e1) -> do
        Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pSampleLocationCoordinateRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
        Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pSampleLocationCoordinateRange' Ptr CFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
sampleLocationSubPixelBits)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
variableSampleLocations))
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_SAMPLE_LOCATIONS_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("samples" ::: SampleCountFlagBits)
-> ("samples" ::: SampleCountFlagBits) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlags)) ("samples" ::: SampleCountFlagBits
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    let pSampleLocationCoordinateRange' :: Ptr CFloat
pSampleLocationCoordinateRange' = Ptr (FixedArray 2 CFloat) -> Ptr CFloat
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr (FixedArray 2 CFloat)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray 2 CFloat)))
    case ((Float
forall a. Zero a => a
zero, Float
forall a. Zero a => a
zero)) of
      (Float
e0, Float
e1) -> do
        Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pSampleLocationCoordinateRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
        Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pSampleLocationCoordinateRange' Ptr CFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceSampleLocationsPropertiesEXT where
  peekCStruct :: Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> IO PhysicalDeviceSampleLocationsPropertiesEXT
peekCStruct Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p = do
    "samples" ::: SampleCountFlagBits
sampleLocationSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr ("samples" ::: SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SampleCountFlags))
    Extent2D
maxSampleLocationGridSize <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Extent2D))
    let psampleLocationCoordinateRange :: Ptr CFloat
psampleLocationCoordinateRange = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @CFloat ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT
-> Int -> Ptr (FixedArray 2 CFloat)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr (FixedArray 2 CFloat)))
    CFloat
sampleLocationCoordinateRange0 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
psampleLocationCoordinateRange Ptr CFloat -> Int -> Ptr CFloat
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr CFloat))
    CFloat
sampleLocationCoordinateRange1 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
psampleLocationCoordinateRange Ptr CFloat -> Int -> Ptr CFloat
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr CFloat))
    Word32
sampleLocationSubPixelBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Bool32
variableSampleLocations <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSampleLocationsPropertiesEXT
p Ptr PhysicalDeviceSampleLocationsPropertiesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32))
    PhysicalDeviceSampleLocationsPropertiesEXT
-> IO PhysicalDeviceSampleLocationsPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSampleLocationsPropertiesEXT
 -> IO PhysicalDeviceSampleLocationsPropertiesEXT)
-> PhysicalDeviceSampleLocationsPropertiesEXT
-> IO PhysicalDeviceSampleLocationsPropertiesEXT
forall a b. (a -> b) -> a -> b
$ ("samples" ::: SampleCountFlagBits)
-> Extent2D
-> (Float, Float)
-> Word32
-> Bool
-> PhysicalDeviceSampleLocationsPropertiesEXT
PhysicalDeviceSampleLocationsPropertiesEXT
             "samples" ::: SampleCountFlagBits
sampleLocationSampleCounts
             Extent2D
maxSampleLocationGridSize
             (( (forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
sampleLocationCoordinateRange0)
              , (forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
sampleLocationCoordinateRange1) ))
             Word32
sampleLocationSubPixelBits
             (Bool32 -> Bool
bool32ToBool Bool32
variableSampleLocations)

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

instance Zero PhysicalDeviceSampleLocationsPropertiesEXT where
  zero :: PhysicalDeviceSampleLocationsPropertiesEXT
zero = ("samples" ::: SampleCountFlagBits)
-> Extent2D
-> (Float, Float)
-> Word32
-> Bool
-> PhysicalDeviceSampleLocationsPropertiesEXT
PhysicalDeviceSampleLocationsPropertiesEXT
           "samples" ::: SampleCountFlagBits
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           (Float
forall a. Zero a => a
zero, Float
forall a. Zero a => a
zero)
           Word32
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkMultisamplePropertiesEXT - Structure returning information about
-- sample count specific additional multisampling capabilities
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_sample_locations VK_EXT_sample_locations>,
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPhysicalDeviceMultisamplePropertiesEXT'
data MultisamplePropertiesEXT = MultisamplePropertiesEXT
  { -- | @maxSampleLocationGridSize@ is the maximum size of the pixel grid in
    -- which sample locations /can/ vary.
    MultisamplePropertiesEXT -> Extent2D
maxSampleLocationGridSize :: Extent2D }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MultisamplePropertiesEXT)
#endif
deriving instance Show MultisamplePropertiesEXT

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

instance FromCStruct MultisamplePropertiesEXT where
  peekCStruct :: ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
-> IO MultisamplePropertiesEXT
peekCStruct "pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT
p = do
    Extent2D
maxSampleLocationGridSize <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT
p ("pMultisampleProperties" ::: Ptr MultisamplePropertiesEXT)
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent2D))
    MultisamplePropertiesEXT -> IO MultisamplePropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultisamplePropertiesEXT -> IO MultisamplePropertiesEXT)
-> MultisamplePropertiesEXT -> IO MultisamplePropertiesEXT
forall a b. (a -> b) -> a -> b
$ Extent2D -> MultisamplePropertiesEXT
MultisamplePropertiesEXT
             Extent2D
maxSampleLocationGridSize

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

instance Zero MultisamplePropertiesEXT where
  zero :: MultisamplePropertiesEXT
zero = Extent2D -> MultisamplePropertiesEXT
MultisamplePropertiesEXT
           Extent2D
forall a. Zero a => a
zero


type EXT_SAMPLE_LOCATIONS_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_SAMPLE_LOCATIONS_SPEC_VERSION"
pattern EXT_SAMPLE_LOCATIONS_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_SAMPLE_LOCATIONS_SPEC_VERSION :: forall a. Integral a => a
$mEXT_SAMPLE_LOCATIONS_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_SAMPLE_LOCATIONS_SPEC_VERSION = 1


type EXT_SAMPLE_LOCATIONS_EXTENSION_NAME = "VK_EXT_sample_locations"

-- No documentation found for TopLevel "VK_EXT_SAMPLE_LOCATIONS_EXTENSION_NAME"
pattern EXT_SAMPLE_LOCATIONS_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_SAMPLE_LOCATIONS_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_SAMPLE_LOCATIONS_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_SAMPLE_LOCATIONS_EXTENSION_NAME = "VK_EXT_sample_locations"