{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_image_format_list"
module Vulkan.Core12.Promoted_From_VK_KHR_image_format_list  ( ImageFormatListCreateInfo(..)
                                                             , StructureType(..)
                                                             ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import 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 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 Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkImageFormatListCreateInfo - Specify that an image /can/ be used with a
-- particular set of formats
--
-- = Description
--
-- If @viewFormatCount@ is zero, @pViewFormats@ is ignored and the image is
-- created as if the 'ImageFormatListCreateInfo' structure were not
-- included in the @pNext@ chain of 'Vulkan.Core10.Image.ImageCreateInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageFormatListCreateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO'
--
-- -   #VUID-VkImageFormatListCreateInfo-pViewFormats-parameter# If
--     @viewFormatCount@ is not @0@, @pViewFormats@ /must/ be a valid
--     pointer to an array of @viewFormatCount@ valid
--     'Vulkan.Core10.Enums.Format.Format' values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_image_format_list VK_KHR_image_format_list>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageFormatListCreateInfo = ImageFormatListCreateInfo
  { -- | @pViewFormats@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.Format.Format' values specifying all formats which
    -- /can/ be used when creating views of this image.
    ImageFormatListCreateInfo -> Vector Format
viewFormats :: Vector Format }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageFormatListCreateInfo)
#endif
deriving instance Show ImageFormatListCreateInfo

instance ToCStruct ImageFormatListCreateInfo where
  withCStruct :: forall b.
ImageFormatListCreateInfo
-> (Ptr ImageFormatListCreateInfo -> IO b) -> IO b
withCStruct ImageFormatListCreateInfo
x Ptr ImageFormatListCreateInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr ImageFormatListCreateInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageFormatListCreateInfo
p ImageFormatListCreateInfo
x (Ptr ImageFormatListCreateInfo -> IO b
f Ptr ImageFormatListCreateInfo
p)
  pokeCStruct :: forall b.
Ptr ImageFormatListCreateInfo
-> ImageFormatListCreateInfo -> IO b -> IO b
pokeCStruct Ptr ImageFormatListCreateInfo
p ImageFormatListCreateInfo{Vector Format
viewFormats :: Vector Format
$sel:viewFormats:ImageFormatListCreateInfo :: ImageFormatListCreateInfo -> Vector Format
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Format
viewFormats)) :: Word32))
    Ptr Format
pPViewFormats' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Format ((forall a. Vector a -> Int
Data.Vector.length (Vector Format
viewFormats)) forall a. Num a => a -> a -> a
* Int
4)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Format
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Format
pPViewFormats' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format) (Format
e)) (Vector Format
viewFormats)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Format))) (Ptr Format
pPViewFormats')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImageFormatListCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr ImageFormatListCreateInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ImageFormatListCreateInfo where
  peekCStruct :: Ptr ImageFormatListCreateInfo -> IO ImageFormatListCreateInfo
peekCStruct Ptr ImageFormatListCreateInfo
p = do
    Word32
viewFormatCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr Format
pViewFormats <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Format) ((Ptr ImageFormatListCreateInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Format)))
    Vector Format
pViewFormats' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
viewFormatCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr Format
pViewFormats forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Format -> ImageFormatListCreateInfo
ImageFormatListCreateInfo
             Vector Format
pViewFormats'

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