{-# language CPP #-}
-- | = Name
--
-- VK_QCOM_tile_properties - device extension
--
-- == VK_QCOM_tile_properties
--
-- [__Name String__]
--     @VK_QCOM_tile_properties@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     485
--
-- [__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__]
--
--     -   Jeff Leger
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_QCOM_tile_properties] @jackohound%0A*Here describe the issue or question you have about the VK_QCOM_tile_properties extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_QCOM_tile_properties.adoc VK_QCOM_tile_properties>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2022-07-11
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension interacts with @VK_EXT_subpass_merge_feedback@
--
-- [__Contributors__]
--
--     -   Jonathan Wicks, Qualcomm Technologies, Inc.
--
--     -   Jonathan Tinkham, Qualcomm Technologies, Inc.
--
--     -   Arpit Agarwal, Qualcomm Technologies, Inc.
--
--     -   Jeff Leger, Qualcomm Technologies, Inc.
--
-- == Description
--
-- This extension allows an application to query the tile properties. This
-- extension supports both renderpasses and dynamic rendering.
--
-- == New Commands
--
-- -   'getDynamicRenderingTilePropertiesQCOM'
--
-- -   'getFramebufferTilePropertiesQCOM'
--
-- == New Structures
--
-- -   'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'
--
-- -   'TilePropertiesQCOM'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceTilePropertiesFeaturesQCOM'
--
-- == New Enum Constants
--
-- -   'QCOM_TILE_PROPERTIES_EXTENSION_NAME'
--
-- -   'QCOM_TILE_PROPERTIES_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_TILE_PROPERTIES_FEATURES_QCOM'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_TILE_PROPERTIES_QCOM'
--
-- == Version History
--
-- -   Revision 1, 2022-07-11 (Arpit Agarwal)
--
--     -   Initial version
--
-- == See Also
--
-- 'PhysicalDeviceTilePropertiesFeaturesQCOM',
-- 'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR',
-- 'TilePropertiesQCOM', 'getDynamicRenderingTilePropertiesQCOM',
-- 'getFramebufferTilePropertiesQCOM'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_QCOM_tile_properties Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_QCOM_tile_properties  ( getFramebufferTilePropertiesQCOM
                                                  , getDynamicRenderingTilePropertiesQCOM
                                                  , PhysicalDeviceTilePropertiesFeaturesQCOM(..)
                                                  , TilePropertiesQCOM(..)
                                                  , QCOM_TILE_PROPERTIES_SPEC_VERSION
                                                  , pattern QCOM_TILE_PROPERTIES_SPEC_VERSION
                                                  , QCOM_TILE_PROPERTIES_EXTENSION_NAME
                                                  , pattern QCOM_TILE_PROPERTIES_EXTENSION_NAME
                                                  , RenderingInfoKHR
                                                  ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
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.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.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetDynamicRenderingTilePropertiesQCOM))
import Vulkan.Dynamic (DeviceCmds(pVkGetFramebufferTilePropertiesQCOM))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.Core10.FundamentalTypes (Extent2D)
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Handles (Framebuffer)
import Vulkan.Core10.Handles (Framebuffer(..))
import Vulkan.Core10.FundamentalTypes (Offset2D)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering (RenderingInfo)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TILE_PROPERTIES_FEATURES_QCOM))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_TILE_PROPERTIES_QCOM))
import Vulkan.Extensions.VK_KHR_dynamic_rendering (RenderingInfoKHR)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetFramebufferTilePropertiesQCOM
  :: FunPtr (Ptr Device_T -> Framebuffer -> Ptr Word32 -> Ptr TilePropertiesQCOM -> IO Result) -> Ptr Device_T -> Framebuffer -> Ptr Word32 -> Ptr TilePropertiesQCOM -> IO Result

-- | vkGetFramebufferTilePropertiesQCOM - Get tile properties from the
-- attachments in framebuffer
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of tile properties available
-- is returned in @pPropertiesCount@. Otherwise, @pPropertiesCount@ /must/
-- point to a variable set by the user to the number of elements in the
-- @pProperties@ array, and on return the variable is overwritten with the
-- number of properties actually written to @pProperties@. If
-- @pPropertiesCount@ is less than the number of tile properties available,
-- at most @pPropertiesCount@ structures will be written, and
-- 'Vulkan.Core10.Enums.Result.INCOMPLETE' will be returned instead of
-- 'Vulkan.Core10.Enums.Result.SUCCESS', to indicate that not all the
-- available properties were returned.
--
-- The number of tile properties available is determined by the number of
-- merged subpasses, and each tile property is associated with a merged
-- subpass. There will be at most as many properties as there are subpasses
-- within the render pass. To obtain the tile properties for a given merged
-- subpass, the @pProperties@ array can be indexed using the
-- @postMergeIndex@ value provided in
-- 'Vulkan.Extensions.VK_EXT_subpass_merge_feedback.RenderPassSubpassFeedbackInfoEXT'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetFramebufferTilePropertiesQCOM-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetFramebufferTilePropertiesQCOM-framebuffer-parameter#
--     @framebuffer@ /must/ be a valid 'Vulkan.Core10.Handles.Framebuffer'
--     handle
--
-- -   #VUID-vkGetFramebufferTilePropertiesQCOM-pPropertiesCount-parameter#
--     @pPropertiesCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetFramebufferTilePropertiesQCOM-pProperties-parameter# If
--     the value referenced by @pPropertiesCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertiesCount@ 'TilePropertiesQCOM' structures
--
-- -   #VUID-vkGetFramebufferTilePropertiesQCOM-framebuffer-parent#
--     @framebuffer@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_tile_properties VK_QCOM_tile_properties>,
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Framebuffer',
-- 'TilePropertiesQCOM'
getFramebufferTilePropertiesQCOM :: forall io
                                  . (MonadIO io)
                                 => -- | @device@ is a logical device associated with the framebuffer.
                                    Device
                                 -> -- | @framebuffer@ is a handle of the framebuffer to query.
                                    Framebuffer
                                 -> io (Result, ("properties" ::: Vector TilePropertiesQCOM))
getFramebufferTilePropertiesQCOM :: forall (io :: * -> *).
MonadIO io =>
Device
-> Framebuffer
-> io (Result, "properties" ::: Vector TilePropertiesQCOM)
getFramebufferTilePropertiesQCOM Device
device Framebuffer
framebuffer = IO (Result, "properties" ::: Vector TilePropertiesQCOM)
-> io (Result, "properties" ::: Vector TilePropertiesQCOM)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "properties" ::: Vector TilePropertiesQCOM)
 -> io (Result, "properties" ::: Vector TilePropertiesQCOM))
-> (ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM)
      IO
      (Result, "properties" ::: Vector TilePropertiesQCOM)
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     (Result, "properties" ::: Vector TilePropertiesQCOM)
-> io (Result, "properties" ::: Vector TilePropertiesQCOM)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "properties" ::: Vector TilePropertiesQCOM)
  IO
  (Result, "properties" ::: Vector TilePropertiesQCOM)
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "properties" ::: Vector TilePropertiesQCOM)
   IO
   (Result, "properties" ::: Vector TilePropertiesQCOM)
 -> io (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     (Result, "properties" ::: Vector TilePropertiesQCOM)
-> io (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetFramebufferTilePropertiesQCOMPtr :: FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetFramebufferTilePropertiesQCOMPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Framebuffer
      -> ("pPropertiesCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr TilePropertiesQCOM)
      -> IO Result)
pVkGetFramebufferTilePropertiesQCOM (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO ()
-> ContT (Result, "properties" ::: Vector TilePropertiesQCOM) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO ())
-> IO ()
-> ContT (Result, "properties" ::: Vector TilePropertiesQCOM) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetFramebufferTilePropertiesQCOMPtr FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Framebuffer
      -> ("pPropertiesCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr TilePropertiesQCOM)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
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 vkGetFramebufferTilePropertiesQCOM is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetFramebufferTilePropertiesQCOM' :: Ptr Device_T
-> Framebuffer
-> ("pPropertiesCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
vkGetFramebufferTilePropertiesQCOM' = FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
-> Ptr Device_T
-> Framebuffer
-> ("pPropertiesCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
mkVkGetFramebufferTilePropertiesQCOM FunPtr
  (Ptr Device_T
   -> Framebuffer
   -> ("pPropertiesCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetFramebufferTilePropertiesQCOMPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pPropertiesCount" ::: Ptr Word32
pPPropertiesCount <- ((("pPropertiesCount" ::: Ptr Word32)
  -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("pPropertiesCount" ::: Ptr Word32)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPropertiesCount" ::: Ptr Word32)
   -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
  -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM)
      IO
      ("pPropertiesCount" ::: Ptr Word32))
-> ((("pPropertiesCount" ::: Ptr Word32)
     -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("pPropertiesCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPropertiesCount" ::: Ptr Word32)
-> (("pPropertiesCount" ::: Ptr Word32) -> IO ())
-> (("pPropertiesCount" ::: Ptr Word32)
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) ("pPropertiesCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
_ <- IO Result
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetFramebufferTilePropertiesQCOM" (Ptr Device_T
-> Framebuffer
-> ("pPropertiesCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
vkGetFramebufferTilePropertiesQCOM'
                                                                       Ptr Device_T
device'
                                                                       (Framebuffer
framebuffer)
                                                                       ("pPropertiesCount" ::: Ptr Word32
pPPropertiesCount)
                                                                       ("pProperties" ::: Ptr TilePropertiesQCOM
forall a. Ptr a
nullPtr))
  Word32
pPropertiesCount <- IO Word32
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertiesCount" ::: Ptr Word32
pPPropertiesCount
  "pProperties" ::: Ptr TilePropertiesQCOM
pPProperties <- ((("pProperties" ::: Ptr TilePropertiesQCOM)
  -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("pProperties" ::: Ptr TilePropertiesQCOM)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
  -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM)
      IO
      ("pProperties" ::: Ptr TilePropertiesQCOM))
-> ((("pProperties" ::: Ptr TilePropertiesQCOM)
     -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("pProperties" ::: Ptr TilePropertiesQCOM)
forall a b. (a -> b) -> a -> b
$ IO ("pProperties" ::: Ptr TilePropertiesQCOM)
-> (("pProperties" ::: Ptr TilePropertiesQCOM) -> IO ())
-> (("pProperties" ::: Ptr TilePropertiesQCOM)
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @TilePropertiesQCOM ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertiesCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)) ("pProperties" ::: Ptr TilePropertiesQCOM) -> IO ()
forall a. Ptr a -> IO ()
free
  [()]
_ <- (Int
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO ())
-> [Int]
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> ((() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT (Result, "properties" ::: Vector TilePropertiesQCOM) IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
  -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO ())
-> ((() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ContT (Result, "properties" ::: Vector TilePropertiesQCOM) IO ()
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr TilePropertiesQCOM
pPProperties ("pProperties" ::: Ptr TilePropertiesQCOM)
-> Int -> "pProperties" ::: Ptr TilePropertiesQCOM
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48) :: Ptr TilePropertiesQCOM) (IO (Result, "properties" ::: Vector TilePropertiesQCOM)
 -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> ((() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
    -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> (() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "properties" ::: Vector TilePropertiesQCOM))
-> () -> IO (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertiesCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  Result
r <- IO Result
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result)
-> IO Result
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetFramebufferTilePropertiesQCOM" (Ptr Device_T
-> Framebuffer
-> ("pPropertiesCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
vkGetFramebufferTilePropertiesQCOM'
                                                                       Ptr Device_T
device'
                                                                       (Framebuffer
framebuffer)
                                                                       ("pPropertiesCount" ::: Ptr Word32
pPPropertiesCount)
                                                                       (("pProperties" ::: Ptr TilePropertiesQCOM
pPProperties)))
  Word32
pPropertiesCount' <- IO Word32
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32)
-> IO Word32
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM) IO Word32
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPropertiesCount" ::: Ptr Word32
pPPropertiesCount
  "properties" ::: Vector TilePropertiesQCOM
pProperties' <- IO ("properties" ::: Vector TilePropertiesQCOM)
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("properties" ::: Vector TilePropertiesQCOM)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("properties" ::: Vector TilePropertiesQCOM)
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM)
      IO
      ("properties" ::: Vector TilePropertiesQCOM))
-> IO ("properties" ::: Vector TilePropertiesQCOM)
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     ("properties" ::: Vector TilePropertiesQCOM)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO TilePropertiesQCOM)
-> IO ("properties" ::: Vector TilePropertiesQCOM)
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
pPropertiesCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @TilePropertiesQCOM ((("pProperties" ::: Ptr TilePropertiesQCOM
pPProperties) ("pProperties" ::: Ptr TilePropertiesQCOM)
-> Int -> "pProperties" ::: Ptr TilePropertiesQCOM
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr TilePropertiesQCOM)))
  (Result, "properties" ::: Vector TilePropertiesQCOM)
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     (Result, "properties" ::: Vector TilePropertiesQCOM)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "properties" ::: Vector TilePropertiesQCOM)
 -> ContT
      (Result, "properties" ::: Vector TilePropertiesQCOM)
      IO
      (Result, "properties" ::: Vector TilePropertiesQCOM))
-> (Result, "properties" ::: Vector TilePropertiesQCOM)
-> ContT
     (Result, "properties" ::: Vector TilePropertiesQCOM)
     IO
     (Result, "properties" ::: Vector TilePropertiesQCOM)
forall a b. (a -> b) -> a -> b
$ (Result
r, "properties" ::: Vector TilePropertiesQCOM
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDynamicRenderingTilePropertiesQCOM
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct RenderingInfo) -> Ptr TilePropertiesQCOM -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct RenderingInfo) -> Ptr TilePropertiesQCOM -> IO Result

-- | vkGetDynamicRenderingTilePropertiesQCOM - Get the properties when using
-- dynamic rendering
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_tile_properties VK_QCOM_tile_properties>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo',
-- 'TilePropertiesQCOM'
getDynamicRenderingTilePropertiesQCOM :: forall a io
                                       . ( Extendss RenderingInfo a
                                         , PokeChain a
                                         , MonadIO io )
                                      => -- | @device@ is a logical device associated with the render pass.
                                         --
                                         -- #VUID-vkGetDynamicRenderingTilePropertiesQCOM-device-parameter# @device@
                                         -- /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                         Device
                                      -> -- | @pRenderingInfo@ is a pointer to the
                                         -- 'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo'
                                         -- structure specifying details of the render pass instance in dynamic
                                         -- rendering.
                                         --
                                         -- #VUID-vkGetDynamicRenderingTilePropertiesQCOM-pRenderingInfo-parameter#
                                         -- @pRenderingInfo@ /must/ be a valid pointer to a valid
                                         -- 'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo'
                                         -- structure
                                         (RenderingInfo a)
                                      -> io (TilePropertiesQCOM)
getDynamicRenderingTilePropertiesQCOM :: forall (a :: [*]) (io :: * -> *).
(Extendss RenderingInfo a, PokeChain a, MonadIO io) =>
Device -> RenderingInfo a -> io TilePropertiesQCOM
getDynamicRenderingTilePropertiesQCOM Device
device
                                        RenderingInfo a
renderingInfo = IO TilePropertiesQCOM -> io TilePropertiesQCOM
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TilePropertiesQCOM -> io TilePropertiesQCOM)
-> (ContT TilePropertiesQCOM IO TilePropertiesQCOM
    -> IO TilePropertiesQCOM)
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
-> io TilePropertiesQCOM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT TilePropertiesQCOM IO TilePropertiesQCOM
-> IO TilePropertiesQCOM
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT TilePropertiesQCOM IO TilePropertiesQCOM
 -> io TilePropertiesQCOM)
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
-> io TilePropertiesQCOM
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDynamicRenderingTilePropertiesQCOMPtr :: FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetDynamicRenderingTilePropertiesQCOMPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
      -> ("pProperties" ::: Ptr TilePropertiesQCOM)
      -> IO Result)
pVkGetDynamicRenderingTilePropertiesQCOM (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT TilePropertiesQCOM IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT TilePropertiesQCOM IO ())
-> IO () -> ContT TilePropertiesQCOM IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetDynamicRenderingTilePropertiesQCOMPtr FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
      -> ("pProperties" ::: Ptr TilePropertiesQCOM)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
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 vkGetDynamicRenderingTilePropertiesQCOM is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDynamicRenderingTilePropertiesQCOM' :: Ptr Device_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
vkGetDynamicRenderingTilePropertiesQCOM' = FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
-> Ptr Device_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
mkVkGetDynamicRenderingTilePropertiesQCOM FunPtr
  (Ptr Device_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
   -> ("pProperties" ::: Ptr TilePropertiesQCOM)
   -> IO Result)
vkGetDynamicRenderingTilePropertiesQCOMPtr
  Ptr (RenderingInfo a)
pRenderingInfo <- ((Ptr (RenderingInfo a) -> IO TilePropertiesQCOM)
 -> IO TilePropertiesQCOM)
-> ContT TilePropertiesQCOM IO (Ptr (RenderingInfo a))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RenderingInfo a) -> IO TilePropertiesQCOM)
  -> IO TilePropertiesQCOM)
 -> ContT TilePropertiesQCOM IO (Ptr (RenderingInfo a)))
-> ((Ptr (RenderingInfo a) -> IO TilePropertiesQCOM)
    -> IO TilePropertiesQCOM)
-> ContT TilePropertiesQCOM IO (Ptr (RenderingInfo a))
forall a b. (a -> b) -> a -> b
$ RenderingInfo a
-> (Ptr (RenderingInfo a) -> IO TilePropertiesQCOM)
-> IO TilePropertiesQCOM
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderingInfo a
renderingInfo)
  "pProperties" ::: Ptr TilePropertiesQCOM
pPProperties <- ((("pProperties" ::: Ptr TilePropertiesQCOM)
  -> IO TilePropertiesQCOM)
 -> IO TilePropertiesQCOM)
-> ContT
     TilePropertiesQCOM IO ("pProperties" ::: Ptr TilePropertiesQCOM)
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 @TilePropertiesQCOM)
  Result
_ <- IO Result -> ContT TilePropertiesQCOM IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT TilePropertiesQCOM IO Result)
-> IO Result -> ContT TilePropertiesQCOM IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDynamicRenderingTilePropertiesQCOM" (Ptr Device_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
-> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> IO Result
vkGetDynamicRenderingTilePropertiesQCOM'
                                                                            (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                            (Ptr (RenderingInfo a)
-> "pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (RenderingInfo a)
pRenderingInfo)
                                                                            ("pProperties" ::: Ptr TilePropertiesQCOM
pPProperties))
  TilePropertiesQCOM
pProperties <- IO TilePropertiesQCOM
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO TilePropertiesQCOM
 -> ContT TilePropertiesQCOM IO TilePropertiesQCOM)
-> IO TilePropertiesQCOM
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @TilePropertiesQCOM "pProperties" ::: Ptr TilePropertiesQCOM
pPProperties
  TilePropertiesQCOM
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TilePropertiesQCOM
 -> ContT TilePropertiesQCOM IO TilePropertiesQCOM)
-> TilePropertiesQCOM
-> ContT TilePropertiesQCOM IO TilePropertiesQCOM
forall a b. (a -> b) -> a -> b
$ (TilePropertiesQCOM
pProperties)


-- | VkPhysicalDeviceTilePropertiesFeaturesQCOM - Structure describing tile
-- properties features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceTilePropertiesFeaturesQCOM' structure is included
-- in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceTilePropertiesFeaturesQCOM' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_tile_properties VK_QCOM_tile_properties>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceTilePropertiesFeaturesQCOM = PhysicalDeviceTilePropertiesFeaturesQCOM
  { -- | #features-tileProperties# @tileProperties@ indicates that the
    -- implementation supports queries for returning tile properties.
    PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
tileProperties :: Bool }
  deriving (Typeable, PhysicalDeviceTilePropertiesFeaturesQCOM
-> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
(PhysicalDeviceTilePropertiesFeaturesQCOM
 -> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool)
-> (PhysicalDeviceTilePropertiesFeaturesQCOM
    -> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool)
-> Eq PhysicalDeviceTilePropertiesFeaturesQCOM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceTilePropertiesFeaturesQCOM
-> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
$c/= :: PhysicalDeviceTilePropertiesFeaturesQCOM
-> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
== :: PhysicalDeviceTilePropertiesFeaturesQCOM
-> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
$c== :: PhysicalDeviceTilePropertiesFeaturesQCOM
-> PhysicalDeviceTilePropertiesFeaturesQCOM -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceTilePropertiesFeaturesQCOM)
#endif
deriving instance Show PhysicalDeviceTilePropertiesFeaturesQCOM

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

instance FromCStruct PhysicalDeviceTilePropertiesFeaturesQCOM where
  peekCStruct :: Ptr PhysicalDeviceTilePropertiesFeaturesQCOM
-> IO PhysicalDeviceTilePropertiesFeaturesQCOM
peekCStruct Ptr PhysicalDeviceTilePropertiesFeaturesQCOM
p = do
    Bool32
tileProperties <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTilePropertiesFeaturesQCOM
p Ptr PhysicalDeviceTilePropertiesFeaturesQCOM -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceTilePropertiesFeaturesQCOM
-> IO PhysicalDeviceTilePropertiesFeaturesQCOM
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceTilePropertiesFeaturesQCOM
 -> IO PhysicalDeviceTilePropertiesFeaturesQCOM)
-> PhysicalDeviceTilePropertiesFeaturesQCOM
-> IO PhysicalDeviceTilePropertiesFeaturesQCOM
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceTilePropertiesFeaturesQCOM
PhysicalDeviceTilePropertiesFeaturesQCOM
             (Bool32 -> Bool
bool32ToBool Bool32
tileProperties)

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

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


-- | VkTilePropertiesQCOM - Structure holding available tile properties
--
-- = Description
--
-- All tiles will be tightly packed around the first tile, with edges being
-- multiples of tile width and\/or height from the origin.
--
-- Note
--
-- Reported value for @apronSize@ will be zero and its functionality will
-- be described in a future extension.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_tile_properties VK_QCOM_tile_properties>,
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.FundamentalTypes.Offset2D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getDynamicRenderingTilePropertiesQCOM',
-- 'getFramebufferTilePropertiesQCOM'
data TilePropertiesQCOM = TilePropertiesQCOM
  { -- | @tileSize@ is the dimensions of a tile, with width and height describing
    -- the width and height of a tile in pixels, and depth corresponding to the
    -- number of slices the tile spans.
    TilePropertiesQCOM -> Extent3D
tileSize :: Extent3D
  , -- | @apronSize@ is the dimension of the apron.
    TilePropertiesQCOM -> Extent2D
apronSize :: Extent2D
  , -- | @origin@ is the top-left corner of the first tile in attachment space.
    TilePropertiesQCOM -> Offset2D
origin :: Offset2D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (TilePropertiesQCOM)
#endif
deriving instance Show TilePropertiesQCOM

instance ToCStruct TilePropertiesQCOM where
  withCStruct :: forall b.
TilePropertiesQCOM
-> (("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b) -> IO b
withCStruct TilePropertiesQCOM
x ("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b
f = Int -> (("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b) -> IO b)
-> (("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr TilePropertiesQCOM
p -> ("pProperties" ::: Ptr TilePropertiesQCOM)
-> TilePropertiesQCOM -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr TilePropertiesQCOM
p TilePropertiesQCOM
x (("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b
f "pProperties" ::: Ptr TilePropertiesQCOM
p)
  pokeCStruct :: forall b.
("pProperties" ::: Ptr TilePropertiesQCOM)
-> TilePropertiesQCOM -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr TilePropertiesQCOM
p TilePropertiesQCOM{Offset2D
Extent3D
Extent2D
origin :: Offset2D
apronSize :: Extent2D
tileSize :: Extent3D
$sel:origin:TilePropertiesQCOM :: TilePropertiesQCOM -> Offset2D
$sel:apronSize:TilePropertiesQCOM :: TilePropertiesQCOM -> Extent2D
$sel:tileSize:TilePropertiesQCOM :: TilePropertiesQCOM -> Extent3D
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_TILE_PROPERTIES_QCOM)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent3D)) (Extent3D
tileSize)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
apronSize)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D)) (Offset2D
origin)
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr TilePropertiesQCOM) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr TilePropertiesQCOM
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_TILE_PROPERTIES_QCOM)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    Ptr Offset2D -> Offset2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D)) (Offset2D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct TilePropertiesQCOM where
  peekCStruct :: ("pProperties" ::: Ptr TilePropertiesQCOM) -> IO TilePropertiesQCOM
peekCStruct "pProperties" ::: Ptr TilePropertiesQCOM
p = do
    Extent3D
tileSize <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Extent3D))
    Extent2D
apronSize <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D))
    Offset2D
origin <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset2D (("pProperties" ::: Ptr TilePropertiesQCOM
p ("pProperties" ::: Ptr TilePropertiesQCOM) -> Int -> Ptr Offset2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Offset2D))
    TilePropertiesQCOM -> IO TilePropertiesQCOM
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TilePropertiesQCOM -> IO TilePropertiesQCOM)
-> TilePropertiesQCOM -> IO TilePropertiesQCOM
forall a b. (a -> b) -> a -> b
$ Extent3D -> Extent2D -> Offset2D -> TilePropertiesQCOM
TilePropertiesQCOM
             Extent3D
tileSize Extent2D
apronSize Offset2D
origin

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

instance Zero TilePropertiesQCOM where
  zero :: TilePropertiesQCOM
zero = Extent3D -> Extent2D -> Offset2D -> TilePropertiesQCOM
TilePropertiesQCOM
           Extent3D
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero
           Offset2D
forall a. Zero a => a
zero


type QCOM_TILE_PROPERTIES_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_QCOM_TILE_PROPERTIES_SPEC_VERSION"
pattern QCOM_TILE_PROPERTIES_SPEC_VERSION :: forall a . Integral a => a
pattern $bQCOM_TILE_PROPERTIES_SPEC_VERSION :: forall a. Integral a => a
$mQCOM_TILE_PROPERTIES_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
QCOM_TILE_PROPERTIES_SPEC_VERSION = 1


type QCOM_TILE_PROPERTIES_EXTENSION_NAME = "VK_QCOM_tile_properties"

-- No documentation found for TopLevel "VK_QCOM_TILE_PROPERTIES_EXTENSION_NAME"
pattern QCOM_TILE_PROPERTIES_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bQCOM_TILE_PROPERTIES_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mQCOM_TILE_PROPERTIES_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
QCOM_TILE_PROPERTIES_EXTENSION_NAME = "VK_QCOM_tile_properties"