{-# language CPP #-}
-- | = Name
--
-- XR_KHR_vulkan_swapchain_format_list - instance extension
--
-- = Specification
--
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_vulkan_swapchain_format_list  XR_KHR_vulkan_swapchain_format_list>
-- in the main specification for complete information.
--
-- = Registered Extension Number
--
-- 15
--
-- = Revision
--
-- 3
--
-- = Extension and Version Dependencies
--
-- -   Requires OpenXR 1.0
--
-- -   Requires @@
--
-- = See Also
--
-- 'VulkanSwapchainFormatListCreateInfoKHR'
--
-- = Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XR_KHR_vulkan_swapchain_format_list OpenXR Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module OpenXR.Extensions.XR_KHR_vulkan_swapchain_format_list  ( VulkanSwapchainFormatListCreateInfoKHR(..)
                                                              , KHR_vulkan_swapchain_format_list_SPEC_VERSION
                                                              , pattern KHR_vulkan_swapchain_format_list_SPEC_VERSION
                                                              , KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME
                                                              , pattern KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME
                                                              ) where

import qualified OpenXR.VulkanTypes (Format)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_VULKAN_SWAPCHAIN_FORMAT_LIST_CREATE_INFO_KHR))
-- | XrVulkanSwapchainFormatListCreateInfoKHR - A list of Vulkan view formats
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrVulkanSwapchainFormatListCreateInfoKHR-extension-notenabled#
--     The @@ extension /must/ be enabled prior to using
--     'VulkanSwapchainFormatListCreateInfoKHR'
--
-- -   #VUID-XrVulkanSwapchainFormatListCreateInfoKHR-type-type# @type@
--     /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_VULKAN_SWAPCHAIN_FORMAT_LIST_CREATE_INFO_KHR'
--
-- -   #VUID-XrVulkanSwapchainFormatListCreateInfoKHR-next-next# @next@
--     /must/ be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrVulkanSwapchainFormatListCreateInfoKHR-viewFormats-parameter#
--     If @viewFormatCount@ is not @0@, @viewFormats@ /must/ be a pointer
--     to an array of @viewFormatCount@ valid @VkFormat@ values
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'OpenXR.Core10.Image.createSwapchain'
data VulkanSwapchainFormatListCreateInfoKHR = VulkanSwapchainFormatListCreateInfoKHR
  { -- | @viewFormats@ is an array of @VkFormat@.
    VulkanSwapchainFormatListCreateInfoKHR -> Vector Format
viewFormats :: Vector OpenXR.VulkanTypes.Format }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (VulkanSwapchainFormatListCreateInfoKHR)
#endif
deriving instance Show VulkanSwapchainFormatListCreateInfoKHR

instance ToCStruct VulkanSwapchainFormatListCreateInfoKHR where
  withCStruct :: VulkanSwapchainFormatListCreateInfoKHR
-> (Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b) -> IO b
withCStruct x :: VulkanSwapchainFormatListCreateInfoKHR
x f :: Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b
f = Int
-> Int
-> (Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b) -> IO b)
-> (Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr VulkanSwapchainFormatListCreateInfoKHR
p -> Ptr VulkanSwapchainFormatListCreateInfoKHR
-> VulkanSwapchainFormatListCreateInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr VulkanSwapchainFormatListCreateInfoKHR
p VulkanSwapchainFormatListCreateInfoKHR
x (Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b
f Ptr VulkanSwapchainFormatListCreateInfoKHR
p)
  pokeCStruct :: Ptr VulkanSwapchainFormatListCreateInfoKHR
-> VulkanSwapchainFormatListCreateInfoKHR -> IO b -> IO b
pokeCStruct p :: Ptr VulkanSwapchainFormatListCreateInfoKHR
p VulkanSwapchainFormatListCreateInfoKHR{..} f :: 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 VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VULKAN_SWAPCHAIN_FORMAT_LIST_CREATE_INFO_KHR)
    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 VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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 VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format -> Int) -> Vector Format -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Format
viewFormats)) :: Word32))
    Ptr Format
pViewFormats' <- ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format))
-> ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Format -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @OpenXR.VulkanTypes.Format ((Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format
viewFormats)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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 -> Format -> IO ()) -> Vector Format -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Format
e -> Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Format
pViewFormats' Ptr Format -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr OpenXR.VulkanTypes.Format) (Format
e)) (Vector Format
viewFormats)
    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 Format) -> Ptr Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR
-> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr OpenXR.VulkanTypes.Format))) (Ptr Format
pViewFormats')
    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 = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr VulkanSwapchainFormatListCreateInfoKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr VulkanSwapchainFormatListCreateInfoKHR
p f :: 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 VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_VULKAN_SWAPCHAIN_FORMAT_LIST_CREATE_INFO_KHR)
    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 VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Format
pViewFormats' <- ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format))
-> ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Format -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @OpenXR.VulkanTypes.Format ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    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 -> Format -> IO ()) -> Vector Format -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Format
e -> Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Format
pViewFormats' Ptr Format -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr OpenXR.VulkanTypes.Format) (Format
e)) (Vector Format
forall a. Monoid a => a
mempty)
    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 Format) -> Ptr Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR
-> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr OpenXR.VulkanTypes.Format))) (Ptr Format
pViewFormats')
    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 VulkanSwapchainFormatListCreateInfoKHR where
  peekCStruct :: Ptr VulkanSwapchainFormatListCreateInfoKHR
-> IO VulkanSwapchainFormatListCreateInfoKHR
peekCStruct p :: Ptr VulkanSwapchainFormatListCreateInfoKHR
p = do
    Word32
viewFormatCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr Format
viewFormats <- Ptr (Ptr Format) -> IO (Ptr Format)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr OpenXR.VulkanTypes.Format) ((Ptr VulkanSwapchainFormatListCreateInfoKHR
p Ptr VulkanSwapchainFormatListCreateInfoKHR
-> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr OpenXR.VulkanTypes.Format)))
    Vector Format
viewFormats' <- Int -> (Int -> IO Format) -> IO (Vector Format)
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
viewFormatCount) (\i :: Int
i -> Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @OpenXR.VulkanTypes.Format ((Ptr Format
viewFormats Ptr Format -> Int -> Ptr Format
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr OpenXR.VulkanTypes.Format)))
    VulkanSwapchainFormatListCreateInfoKHR
-> IO VulkanSwapchainFormatListCreateInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VulkanSwapchainFormatListCreateInfoKHR
 -> IO VulkanSwapchainFormatListCreateInfoKHR)
-> VulkanSwapchainFormatListCreateInfoKHR
-> IO VulkanSwapchainFormatListCreateInfoKHR
forall a b. (a -> b) -> a -> b
$ Vector Format -> VulkanSwapchainFormatListCreateInfoKHR
VulkanSwapchainFormatListCreateInfoKHR
             Vector Format
viewFormats'

instance Zero VulkanSwapchainFormatListCreateInfoKHR where
  zero :: VulkanSwapchainFormatListCreateInfoKHR
zero = Vector Format -> VulkanSwapchainFormatListCreateInfoKHR
VulkanSwapchainFormatListCreateInfoKHR
           Vector Format
forall a. Monoid a => a
mempty


type KHR_vulkan_swapchain_format_list_SPEC_VERSION = 3

-- No documentation found for TopLevel "XR_KHR_vulkan_swapchain_format_list_SPEC_VERSION"
pattern KHR_vulkan_swapchain_format_list_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_vulkan_swapchain_format_list_SPEC_VERSION :: a
$mKHR_vulkan_swapchain_format_list_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_vulkan_swapchain_format_list_SPEC_VERSION = 3


type KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME = "XR_KHR_vulkan_swapchain_format_list"

-- No documentation found for TopLevel "XR_KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME"
pattern KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME :: a
$mKHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_VULKAN_SWAPCHAIN_FORMAT_LIST_EXTENSION_NAME = "XR_KHR_vulkan_swapchain_format_list"