{-# LINE 1 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.RenderPass.Core (
create, destroy, R, CreateInfo, pattern CreateInfo,
createInfoSType, createInfoPNext, createInfoFlags,
createInfoAttachmentCount, createInfoPAttachments,
createInfoSubpassCount, createInfoPSubpasses,
createInfoDependencyCount, createInfoPDependencies,
BeginInfo, pattern BeginInfo,
beginInfoSType, beginInfoPNext,
beginInfoRenderPass, beginInfoFramebuffer, beginInfoRenderArea,
beginInfoClearValueCount, beginInfoPClearValues
) where
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Struct
import Foreign.C.Struct.TypeSynonyms
import Data.Word
import Data.Int
import Gpu.Vulkan.Core
import qualified Gpu.Vulkan.AllocationCallbacks.Core as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Core as Device
import qualified Gpu.Vulkan.Attachment.Core as Attachment
import qualified Gpu.Vulkan.Subpass.Core as Subpass
import qualified Gpu.Vulkan.Framebuffer.Core as Framebuffer
sTypeC, sTypeB :: Word32
{-# LINE 43 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
sTypeC = 38
{-# LINE 44 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
sTypeB = 43
{-# LINE 45 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
struct "CreateInfo" (64)
{-# LINE 47 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
8 [
{-# LINE 48 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sTypeC |]),
{-# LINE 50 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 52 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 53 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 54 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 55 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 56 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("attachmentCount", ''Word32,
{-# LINE 57 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 58 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 59 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pAttachments", ''Attachment.PtrDescription,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 61 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 62 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("subpassCount", ''Word32,
{-# LINE 63 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 64 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 65 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pSubpasses", ''Subpass.PtrDescription,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 67 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 68 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("dependencyCount", ''Word32,
{-# LINE 69 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 70 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 71 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pDependencies", ''Subpass.PtrDependency,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 73 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 74 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[''Show, ''Storable]
data RTag
type R = Ptr RTag
foreign import ccall "vkCreateRenderPass" create ::
Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A -> Ptr R ->
IO Int32
{-# LINE 82 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
foreign import ccall "vkDestroyRenderPass" destroy ::
Device.D -> R -> Ptr AllocationCallbacks.A -> IO ()
struct "BeginInfo" (64)
{-# LINE 87 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
8 [
{-# LINE 88 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sTypeB |]),
{-# LINE 90 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 92 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 93 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("renderPass", ''R,
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 95 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 96 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("framebuffer", ''Framebuffer.F,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 98 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 99 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("renderArea", ''Rect2d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 101 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 102 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("clearValueCount", ''Word32,
{-# LINE 103 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 104 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 105 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
("pClearValues", ''PtrClearValue,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 107 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 108 "src/Gpu/Vulkan/RenderPass/Core.hsc" #-}
[''Show, ''Storable]