{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_KHR_image_format_list  ( ImageFormatListCreateInfo(..)
                                                             , StructureType(..)
                                                             ) where

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 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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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@ list of 'Vulkan.Core10.Image.ImageCreateInfo'.
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO'
--
-- -   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
--
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageFormatListCreateInfo = ImageFormatListCreateInfo
  { -- | @pViewFormats@ is an array which lists of 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 :: ImageFormatListCreateInfo
-> (Ptr ImageFormatListCreateInfo -> IO b) -> IO b
withCStruct x :: ImageFormatListCreateInfo
x f :: Ptr ImageFormatListCreateInfo -> IO b
f = Int -> Int -> (Ptr ImageFormatListCreateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr ImageFormatListCreateInfo -> IO b) -> IO b)
-> (Ptr ImageFormatListCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ImageFormatListCreateInfo
p -> Ptr ImageFormatListCreateInfo
-> ImageFormatListCreateInfo -> IO b -> IO b
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 :: Ptr ImageFormatListCreateInfo
-> ImageFormatListCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr ImageFormatListCreateInfo
p ImageFormatListCreateInfo{..} 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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO)
    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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> 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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> 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
pPViewFormats' <- ((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 @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
pPViewFormats' 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 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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Format))) (Ptr Format
pPViewFormats')
    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 ImageFormatListCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ImageFormatListCreateInfo
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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_FORMAT_LIST_CREATE_INFO)
    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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Format
pPViewFormats' <- ((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 @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
pPViewFormats' 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 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 ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Format))) (Ptr Format
pPViewFormats')
    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 ImageFormatListCreateInfo where
  peekCStruct :: Ptr ImageFormatListCreateInfo -> IO ImageFormatListCreateInfo
peekCStruct p :: Ptr ImageFormatListCreateInfo
p = do
    Word32
viewFormatCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr Format
pViewFormats <- Ptr (Ptr Format) -> IO (Ptr Format)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Format) ((Ptr ImageFormatListCreateInfo
p Ptr ImageFormatListCreateInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Format)))
    Vector Format
pViewFormats' <- 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 @Format ((Ptr Format
pViewFormats 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 Format)))
    ImageFormatListCreateInfo -> IO ImageFormatListCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFormatListCreateInfo -> IO ImageFormatListCreateInfo)
-> ImageFormatListCreateInfo -> IO ImageFormatListCreateInfo
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
           Vector Format
forall a. Monoid a => a
mempty