{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_imageless_framebuffer"
module Vulkan.Core12.Promoted_From_VK_KHR_imageless_framebuffer  ( PhysicalDeviceImagelessFramebufferFeatures(..)
                                                                 , FramebufferAttachmentsCreateInfo(..)
                                                                 , FramebufferAttachmentImageInfo(..)
                                                                 , RenderPassAttachmentBeginInfo(..)
                                                                 , StructureType(..)
                                                                 , FramebufferCreateFlagBits(..)
                                                                 , FramebufferCreateFlags
                                                                 ) 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)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
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.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Handles (ImageView)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENTS_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENT_IMAGE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGELESS_FRAMEBUFFER_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDER_PASS_ATTACHMENT_BEGIN_INFO))
import Vulkan.Core10.Enums.FramebufferCreateFlagBits (FramebufferCreateFlagBits(..))
import Vulkan.Core10.Enums.FramebufferCreateFlagBits (FramebufferCreateFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkPhysicalDeviceImagelessFramebufferFeatures - Structure indicating
-- support for imageless framebuffers
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceImagelessFramebufferFeatures' 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. 'PhysicalDeviceImagelessFramebufferFeatures' /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_KHR_imageless_framebuffer VK_KHR_imageless_framebuffer>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceImagelessFramebufferFeatures = PhysicalDeviceImagelessFramebufferFeatures
  { -- | #extension-features-imagelessFramebuffer# @imagelessFramebuffer@
    -- indicates that the implementation supports specifying the image view for
    -- attachments at render pass begin time via
    -- 'RenderPassAttachmentBeginInfo'.
    PhysicalDeviceImagelessFramebufferFeatures -> Bool
imagelessFramebuffer :: Bool }
  deriving (Typeable, PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> Bool
(PhysicalDeviceImagelessFramebufferFeatures
 -> PhysicalDeviceImagelessFramebufferFeatures -> Bool)
-> (PhysicalDeviceImagelessFramebufferFeatures
    -> PhysicalDeviceImagelessFramebufferFeatures -> Bool)
-> Eq PhysicalDeviceImagelessFramebufferFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> Bool
$c/= :: PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> Bool
== :: PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> Bool
$c== :: PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceImagelessFramebufferFeatures)
#endif
deriving instance Show PhysicalDeviceImagelessFramebufferFeatures

instance ToCStruct PhysicalDeviceImagelessFramebufferFeatures where
  withCStruct :: forall b.
PhysicalDeviceImagelessFramebufferFeatures
-> (Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b) -> IO b
withCStruct PhysicalDeviceImagelessFramebufferFeatures
x Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b
f = Int
-> (Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceImagelessFramebufferFeatures
p -> Ptr PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImagelessFramebufferFeatures
p PhysicalDeviceImagelessFramebufferFeatures
x (Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b
f Ptr PhysicalDeviceImagelessFramebufferFeatures
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceImagelessFramebufferFeatures
-> PhysicalDeviceImagelessFramebufferFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceImagelessFramebufferFeatures
p PhysicalDeviceImagelessFramebufferFeatures{Bool
imagelessFramebuffer :: Bool
$sel:imagelessFramebuffer:PhysicalDeviceImagelessFramebufferFeatures :: PhysicalDeviceImagelessFramebufferFeatures -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGELESS_FRAMEBUFFER_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures
-> 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 PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imagelessFramebuffer))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceImagelessFramebufferFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceImagelessFramebufferFeatures
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_IMAGELESS_FRAMEBUFFER_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures
-> 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 PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures -> 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 PhysicalDeviceImagelessFramebufferFeatures where
  peekCStruct :: Ptr PhysicalDeviceImagelessFramebufferFeatures
-> IO PhysicalDeviceImagelessFramebufferFeatures
peekCStruct Ptr PhysicalDeviceImagelessFramebufferFeatures
p = do
    Bool32
imagelessFramebuffer <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceImagelessFramebufferFeatures
p Ptr PhysicalDeviceImagelessFramebufferFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceImagelessFramebufferFeatures
-> IO PhysicalDeviceImagelessFramebufferFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceImagelessFramebufferFeatures
 -> IO PhysicalDeviceImagelessFramebufferFeatures)
-> PhysicalDeviceImagelessFramebufferFeatures
-> IO PhysicalDeviceImagelessFramebufferFeatures
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceImagelessFramebufferFeatures
PhysicalDeviceImagelessFramebufferFeatures
             (Bool32 -> Bool
bool32ToBool Bool32
imagelessFramebuffer)

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

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


-- | VkFramebufferAttachmentsCreateInfo - Structure specifying parameters of
-- images that will be used with a framebuffer
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkFramebufferAttachmentsCreateInfo-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENTS_CREATE_INFO'
--
-- -   #VUID-VkFramebufferAttachmentsCreateInfo-pAttachmentImageInfos-parameter#
--     If @attachmentImageInfoCount@ is not @0@, @pAttachmentImageInfos@
--     /must/ be a valid pointer to an array of @attachmentImageInfoCount@
--     valid 'FramebufferAttachmentImageInfo' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'FramebufferAttachmentImageInfo',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data FramebufferAttachmentsCreateInfo = FramebufferAttachmentsCreateInfo
  { -- | @pAttachmentImageInfos@ is a pointer to an array of
    -- 'FramebufferAttachmentImageInfo' structures, each structure describing a
    -- number of parameters of the corresponding attachment in a render pass
    -- instance.
    FramebufferAttachmentsCreateInfo
-> Vector FramebufferAttachmentImageInfo
attachmentImageInfos :: Vector FramebufferAttachmentImageInfo }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FramebufferAttachmentsCreateInfo)
#endif
deriving instance Show FramebufferAttachmentsCreateInfo

instance ToCStruct FramebufferAttachmentsCreateInfo where
  withCStruct :: forall b.
FramebufferAttachmentsCreateInfo
-> (Ptr FramebufferAttachmentsCreateInfo -> IO b) -> IO b
withCStruct FramebufferAttachmentsCreateInfo
x Ptr FramebufferAttachmentsCreateInfo -> IO b
f = Int -> (Ptr FramebufferAttachmentsCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr FramebufferAttachmentsCreateInfo -> IO b) -> IO b)
-> (Ptr FramebufferAttachmentsCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr FramebufferAttachmentsCreateInfo
p -> Ptr FramebufferAttachmentsCreateInfo
-> FramebufferAttachmentsCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FramebufferAttachmentsCreateInfo
p FramebufferAttachmentsCreateInfo
x (Ptr FramebufferAttachmentsCreateInfo -> IO b
f Ptr FramebufferAttachmentsCreateInfo
p)
  pokeCStruct :: forall b.
Ptr FramebufferAttachmentsCreateInfo
-> FramebufferAttachmentsCreateInfo -> IO b -> IO b
pokeCStruct Ptr FramebufferAttachmentsCreateInfo
p FramebufferAttachmentsCreateInfo{Vector FramebufferAttachmentImageInfo
attachmentImageInfos :: Vector FramebufferAttachmentImageInfo
$sel:attachmentImageInfos:FramebufferAttachmentsCreateInfo :: FramebufferAttachmentsCreateInfo
-> Vector FramebufferAttachmentImageInfo
..} 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 FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENTS_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 FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> 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 FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> 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 FramebufferAttachmentImageInfo -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector FramebufferAttachmentImageInfo -> Int)
-> Vector FramebufferAttachmentImageInfo -> Int
forall a b. (a -> b) -> a -> b
$ (Vector FramebufferAttachmentImageInfo
attachmentImageInfos)) :: Word32))
    Ptr FramebufferAttachmentImageInfo
pPAttachmentImageInfos' <- ((Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b)
-> ContT b IO (Ptr FramebufferAttachmentImageInfo)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b)
 -> ContT b IO (Ptr FramebufferAttachmentImageInfo))
-> ((Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b)
-> ContT b IO (Ptr FramebufferAttachmentImageInfo)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @FramebufferAttachmentImageInfo ((Vector FramebufferAttachmentImageInfo -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector FramebufferAttachmentImageInfo
attachmentImageInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)
    (Int -> FramebufferAttachmentImageInfo -> ContT b IO ())
-> Vector FramebufferAttachmentImageInfo -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i FramebufferAttachmentImageInfo
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 FramebufferAttachmentImageInfo
-> FramebufferAttachmentImageInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr FramebufferAttachmentImageInfo
pPAttachmentImageInfos' Ptr FramebufferAttachmentImageInfo
-> Int -> Ptr FramebufferAttachmentImageInfo
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr FramebufferAttachmentImageInfo) (FramebufferAttachmentImageInfo
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 FramebufferAttachmentImageInfo
attachmentImageInfos)
    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 FramebufferAttachmentImageInfo)
-> Ptr FramebufferAttachmentImageInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo
-> Int -> Ptr (Ptr FramebufferAttachmentImageInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr FramebufferAttachmentImageInfo))) (Ptr FramebufferAttachmentImageInfo
pPAttachmentImageInfos')
    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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr FramebufferAttachmentsCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr FramebufferAttachmentsCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENTS_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> 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 FramebufferAttachmentsCreateInfo where
  peekCStruct :: Ptr FramebufferAttachmentsCreateInfo
-> IO FramebufferAttachmentsCreateInfo
peekCStruct Ptr FramebufferAttachmentsCreateInfo
p = do
    Word32
attachmentImageInfoCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr FramebufferAttachmentImageInfo
pAttachmentImageInfos <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr FramebufferAttachmentImageInfo) ((Ptr FramebufferAttachmentsCreateInfo
p Ptr FramebufferAttachmentsCreateInfo
-> Int -> Ptr (Ptr FramebufferAttachmentImageInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr FramebufferAttachmentImageInfo)))
    Vector FramebufferAttachmentImageInfo
pAttachmentImageInfos' <- Int
-> (Int -> IO FramebufferAttachmentImageInfo)
-> IO (Vector FramebufferAttachmentImageInfo)
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
attachmentImageInfoCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @FramebufferAttachmentImageInfo ((Ptr FramebufferAttachmentImageInfo
pAttachmentImageInfos Ptr FramebufferAttachmentImageInfo
-> Int -> Ptr FramebufferAttachmentImageInfo
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr FramebufferAttachmentImageInfo)))
    FramebufferAttachmentsCreateInfo
-> IO FramebufferAttachmentsCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FramebufferAttachmentsCreateInfo
 -> IO FramebufferAttachmentsCreateInfo)
-> FramebufferAttachmentsCreateInfo
-> IO FramebufferAttachmentsCreateInfo
forall a b. (a -> b) -> a -> b
$ Vector FramebufferAttachmentImageInfo
-> FramebufferAttachmentsCreateInfo
FramebufferAttachmentsCreateInfo
             Vector FramebufferAttachmentImageInfo
pAttachmentImageInfos'

instance Zero FramebufferAttachmentsCreateInfo where
  zero :: FramebufferAttachmentsCreateInfo
zero = Vector FramebufferAttachmentImageInfo
-> FramebufferAttachmentsCreateInfo
FramebufferAttachmentsCreateInfo
           Vector FramebufferAttachmentImageInfo
forall a. Monoid a => a
mempty


-- | VkFramebufferAttachmentImageInfo - Structure specifying parameters of an
-- image that will be used with a framebuffer
--
-- = Description
--
-- Images that /can/ be used with the framebuffer when beginning a render
-- pass, as specified by 'RenderPassAttachmentBeginInfo', /must/ be created
-- with parameters that are identical to those specified here.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENT_IMAGE_INFO'
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-pNext-pNext# @pNext@ /must/
--     be @NULL@
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-flags-parameter# @flags@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits' values
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-usage-parameter# @usage@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits' values
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-usage-requiredbitmask#
--     @usage@ /must/ not be @0@
--
-- -   #VUID-VkFramebufferAttachmentImageInfo-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_imageless_framebuffer VK_KHR_imageless_framebuffer>,
-- <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', 'FramebufferAttachmentsCreateInfo',
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlags',
-- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data FramebufferAttachmentImageInfo = FramebufferAttachmentImageInfo
  { -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits', matching
    -- the value of 'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ used to
    -- create an image that will be used with this framebuffer.
    FramebufferAttachmentImageInfo -> ImageCreateFlags
flags :: ImageCreateFlags
  , -- | @usage@ is a bitmask of
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits', matching
    -- the value of 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@ used to
    -- create an image used with this framebuffer.
    FramebufferAttachmentImageInfo -> ImageUsageFlags
usage :: ImageUsageFlags
  , -- | @width@ is the width of the image view used for rendering.
    FramebufferAttachmentImageInfo -> Word32
width :: Word32
  , -- | @height@ is the height of the image view used for rendering.
    FramebufferAttachmentImageInfo -> Word32
height :: Word32
  , -- | @layerCount@ is the number of array layers of the image view used for
    -- rendering.
    FramebufferAttachmentImageInfo -> Word32
layerCount :: Word32
  , -- | @pViewFormats@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.Format.Format' values specifying all of the formats
    -- which /can/ be used when creating views of the image, matching the value
    -- of
    -- 'Vulkan.Core12.Promoted_From_VK_KHR_image_format_list.ImageFormatListCreateInfo'::@pViewFormats@
    -- used to create an image used with this framebuffer.
    FramebufferAttachmentImageInfo -> Vector Format
viewFormats :: Vector Format
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FramebufferAttachmentImageInfo)
#endif
deriving instance Show FramebufferAttachmentImageInfo

instance ToCStruct FramebufferAttachmentImageInfo where
  withCStruct :: forall b.
FramebufferAttachmentImageInfo
-> (Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b
withCStruct FramebufferAttachmentImageInfo
x Ptr FramebufferAttachmentImageInfo -> IO b
f = Int -> (Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b)
-> (Ptr FramebufferAttachmentImageInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr FramebufferAttachmentImageInfo
p -> Ptr FramebufferAttachmentImageInfo
-> FramebufferAttachmentImageInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FramebufferAttachmentImageInfo
p FramebufferAttachmentImageInfo
x (Ptr FramebufferAttachmentImageInfo -> IO b
f Ptr FramebufferAttachmentImageInfo
p)
  pokeCStruct :: forall b.
Ptr FramebufferAttachmentImageInfo
-> FramebufferAttachmentImageInfo -> IO b -> IO b
pokeCStruct Ptr FramebufferAttachmentImageInfo
p FramebufferAttachmentImageInfo{Word32
Vector Format
ImageCreateFlags
ImageUsageFlags
viewFormats :: Vector Format
layerCount :: Word32
height :: Word32
width :: Word32
usage :: ImageUsageFlags
flags :: ImageCreateFlags
$sel:viewFormats:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> Vector Format
$sel:layerCount:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> Word32
$sel:height:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> Word32
$sel:width:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> Word32
$sel:usage:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> ImageUsageFlags
$sel:flags:FramebufferAttachmentImageInfo :: FramebufferAttachmentImageInfo -> ImageCreateFlags
..} 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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENT_IMAGE_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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> 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 ImageCreateFlags -> ImageCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr ImageCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageCreateFlags)) (ImageCreateFlags
flags)
    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 ImageUsageFlags -> ImageUsageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr ImageUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ImageUsageFlags)) (ImageUsageFlags
usage)
    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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
width)
    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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
height)
    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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
layerCount)
    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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: 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
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @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
* Int
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_ (\Int
i 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` (Int
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 FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: 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 = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr FramebufferAttachmentImageInfo -> IO b -> IO b
pokeZeroCStruct Ptr FramebufferAttachmentImageInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FRAMEBUFFER_ATTACHMENT_IMAGE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageUsageFlags -> ImageUsageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr ImageUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ImageUsageFlags)) (ImageUsageFlags
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct FramebufferAttachmentImageInfo where
  peekCStruct :: Ptr FramebufferAttachmentImageInfo
-> IO FramebufferAttachmentImageInfo
peekCStruct Ptr FramebufferAttachmentImageInfo
p = do
    ImageCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @ImageCreateFlags ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr ImageCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageCreateFlags))
    ImageUsageFlags
usage <- forall a. Storable a => Ptr a -> IO a
peek @ImageUsageFlags ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr ImageUsageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ImageUsageFlags))
    Word32
width <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Word32
height <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    Word32
layerCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Word32
viewFormatCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Ptr Format
pViewFormats <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Format) ((Ptr FramebufferAttachmentImageInfo
p Ptr FramebufferAttachmentImageInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: 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) (\Int
i -> 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` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format)))
    FramebufferAttachmentImageInfo -> IO FramebufferAttachmentImageInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FramebufferAttachmentImageInfo
 -> IO FramebufferAttachmentImageInfo)
-> FramebufferAttachmentImageInfo
-> IO FramebufferAttachmentImageInfo
forall a b. (a -> b) -> a -> b
$ ImageCreateFlags
-> ImageUsageFlags
-> Word32
-> Word32
-> Word32
-> Vector Format
-> FramebufferAttachmentImageInfo
FramebufferAttachmentImageInfo
             ImageCreateFlags
flags ImageUsageFlags
usage Word32
width Word32
height Word32
layerCount Vector Format
pViewFormats'

instance Zero FramebufferAttachmentImageInfo where
  zero :: FramebufferAttachmentImageInfo
zero = ImageCreateFlags
-> ImageUsageFlags
-> Word32
-> Word32
-> Word32
-> Vector Format
-> FramebufferAttachmentImageInfo
FramebufferAttachmentImageInfo
           ImageCreateFlags
forall a. Zero a => a
zero
           ImageUsageFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector Format
forall a. Monoid a => a
mempty


-- | VkRenderPassAttachmentBeginInfo - Structure specifying images to be used
-- as framebuffer attachments
--
-- == Valid Usage
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-pAttachments-03218# Each
--     element of @pAttachments@ /must/ only specify a single mip level
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-pAttachments-03219# Each
--     element of @pAttachments@ /must/ have been created with the identity
--     swizzle
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-pAttachments-04114# Each
--     element of @pAttachments@ /must/ have been created with
--     'Vulkan.Core10.ImageView.ImageViewCreateInfo'::@viewType@ not equal
--     to 'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D'
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-pAttachments-07010# If
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#subpass-multisampledrendertosinglesampled multisampled-render-to-single-sampled>
--     is enabled for any subpass, all element of @pAttachments@ which have
--     a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT' /must/
--     have a format that supports the sample count specified in
--     'Vulkan.Extensions.VK_EXT_multisampled_render_to_single_sampled.MultisampledRenderToSingleSampledInfoEXT'::@rasterizationSamples@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDER_PASS_ATTACHMENT_BEGIN_INFO'
--
-- -   #VUID-VkRenderPassAttachmentBeginInfo-pAttachments-parameter# If
--     @attachmentCount@ is not @0@, @pAttachments@ /must/ be a valid
--     pointer to an array of @attachmentCount@ valid
--     'Vulkan.Core10.Handles.ImageView' handles
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_imageless_framebuffer VK_KHR_imageless_framebuffer>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Handles.ImageView',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderPassAttachmentBeginInfo = RenderPassAttachmentBeginInfo
  { -- | @pAttachments@ is a pointer to an array of
    -- 'Vulkan.Core10.Handles.ImageView' handles, each of which will be used as
    -- the corresponding attachment in the render pass instance.
    RenderPassAttachmentBeginInfo -> Vector ImageView
attachments :: Vector ImageView }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderPassAttachmentBeginInfo)
#endif
deriving instance Show RenderPassAttachmentBeginInfo

instance ToCStruct RenderPassAttachmentBeginInfo where
  withCStruct :: forall b.
RenderPassAttachmentBeginInfo
-> (Ptr RenderPassAttachmentBeginInfo -> IO b) -> IO b
withCStruct RenderPassAttachmentBeginInfo
x Ptr RenderPassAttachmentBeginInfo -> IO b
f = Int -> (Ptr RenderPassAttachmentBeginInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr RenderPassAttachmentBeginInfo -> IO b) -> IO b)
-> (Ptr RenderPassAttachmentBeginInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderPassAttachmentBeginInfo
p -> Ptr RenderPassAttachmentBeginInfo
-> RenderPassAttachmentBeginInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderPassAttachmentBeginInfo
p RenderPassAttachmentBeginInfo
x (Ptr RenderPassAttachmentBeginInfo -> IO b
f Ptr RenderPassAttachmentBeginInfo
p)
  pokeCStruct :: forall b.
Ptr RenderPassAttachmentBeginInfo
-> RenderPassAttachmentBeginInfo -> IO b -> IO b
pokeCStruct Ptr RenderPassAttachmentBeginInfo
p RenderPassAttachmentBeginInfo{Vector ImageView
attachments :: Vector ImageView
$sel:attachments:RenderPassAttachmentBeginInfo :: RenderPassAttachmentBeginInfo -> Vector ImageView
..} 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 RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_ATTACHMENT_BEGIN_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 RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> 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 RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> 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 ImageView -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ImageView -> Int) -> Vector ImageView -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ImageView
attachments)) :: Word32))
    Ptr ImageView
pPAttachments' <- ((Ptr ImageView -> IO b) -> IO b) -> ContT b IO (Ptr ImageView)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ImageView -> IO b) -> IO b) -> ContT b IO (Ptr ImageView))
-> ((Ptr ImageView -> IO b) -> IO b) -> ContT b IO (Ptr ImageView)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageView ((Vector ImageView -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ImageView
attachments)) 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 -> ImageView -> IO ()) -> Vector ImageView -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageView
e -> Ptr ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageView
pPAttachments' Ptr ImageView -> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageView) (ImageView
e)) (Vector ImageView
attachments)
    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 ImageView) -> Ptr ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> Int -> Ptr (Ptr ImageView)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageView))) (Ptr ImageView
pPAttachments')
    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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr RenderPassAttachmentBeginInfo -> IO b -> IO b
pokeZeroCStruct Ptr RenderPassAttachmentBeginInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_ATTACHMENT_BEGIN_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> 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 RenderPassAttachmentBeginInfo where
  peekCStruct :: Ptr RenderPassAttachmentBeginInfo
-> IO RenderPassAttachmentBeginInfo
peekCStruct Ptr RenderPassAttachmentBeginInfo
p = do
    Word32
attachmentCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr ImageView
pAttachments <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageView) ((Ptr RenderPassAttachmentBeginInfo
p Ptr RenderPassAttachmentBeginInfo -> Int -> Ptr (Ptr ImageView)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageView)))
    Vector ImageView
pAttachments' <- Int -> (Int -> IO ImageView) -> IO (Vector ImageView)
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
attachmentCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @ImageView ((Ptr ImageView
pAttachments Ptr ImageView -> Int -> Ptr ImageView
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageView)))
    RenderPassAttachmentBeginInfo -> IO RenderPassAttachmentBeginInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderPassAttachmentBeginInfo -> IO RenderPassAttachmentBeginInfo)
-> RenderPassAttachmentBeginInfo
-> IO RenderPassAttachmentBeginInfo
forall a b. (a -> b) -> a -> b
$ Vector ImageView -> RenderPassAttachmentBeginInfo
RenderPassAttachmentBeginInfo
             Vector ImageView
pAttachments'

instance Zero RenderPassAttachmentBeginInfo where
  zero :: RenderPassAttachmentBeginInfo
zero = Vector ImageView -> RenderPassAttachmentBeginInfo
RenderPassAttachmentBeginInfo
           Vector ImageView
forall a. Monoid a => a
mempty