{-# LINE 1 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.Buffer.Core (
create, destroy, getMemoryRequirements, bindMemory, B,
CreateInfo, pattern CreateInfo,
createInfoSType, createInfoPNext, createInfoFlags, createInfoSize,
createInfoUsage, createInfoSharingMode,
createInfoQueueFamilyIndexCount, createInfoPQueueFamilyIndices,
Copy, pattern Copy,
copySrcOffset, copyDstOffset, copySize,
ImageCopy, pattern ImageCopy,
imageCopyBufferOffset,
imageCopyBufferRowLength, imageCopyBufferImageHeight,
imageCopyImageSubresource, imageCopyImageOffset, imageCopyImageExtent,
MemoryBarrier, pattern MemoryBarrier,
memoryBarrierSType, memoryBarrierPNext,
memoryBarrierSrcAccessMask, memoryBarrierDstAccessMask,
memoryBarrierSrcQueueFamilyIndex, memoryBarrierDstQueueFamilyIndex,
memoryBarrierBuffer, memoryBarrierOffset, memoryBarrierSize,
MemoryBarrier2, PtrMemoryBarrier2, pattern MemoryBarrier2,
memoryBarrier2SType, memoryBarrier2PNext,
memoryBarrier2SrcStageMask, memoryBarrier2SrcAccessMask,
memoryBarrier2DstStageMask, memoryBarrier2DstAccessMask,
memoryBarrier2SrcQueueFamilyIndex, memoryBarrier2DstQueueFamilyIndex,
memoryBarrier2Buffer, memoryBarrier2Offset, memoryBarrier2Size
) 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 Gpu.Vulkan.TypeSynonyms.Core
import Gpu.Vulkan.AllocationCallbacks.Core qualified as AllocationCallbacks
import {-# SOURCE #-} Gpu.Vulkan.Device.Core qualified as Device
import Gpu.Vulkan.Memory.Core qualified as Memory
import Gpu.Vulkan.Image.Core qualified as Image
struct "CreateInfo" (56) 8 [
{-# LINE 61 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 63 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
(12 ::
{-# LINE 64 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
Word32) |]),
{-# LINE 65 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pNext", ''PtrVoid, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 66 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 67 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 68 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 69 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 70 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 71 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 72 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 73 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("usage", ''Word32,
{-# LINE 74 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 75 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 76 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sharingMode", ''Word32,
{-# LINE 77 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 36) |],
{-# LINE 78 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 36) |]),
{-# LINE 79 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("queueFamilyIndexCount", ''Word32,
{-# LINE 80 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 81 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 82 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pQueueFamilyIndices", ''PtrUint32T,
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 84 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]) ]
{-# LINE 85 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
data BTag
type B = Ptr BTag
foreign import ccall "vkCreateBuffer" create ::
Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A -> Ptr B ->
IO Int32
{-# LINE 93 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
foreign import ccall "vkDestroyBuffer" destroy ::
Device.D -> B -> Ptr AllocationCallbacks.A -> IO ()
foreign import ccall "vkGetBufferMemoryRequirements" getMemoryRequirements ::
Device.D -> B -> Ptr Memory.Requirements -> IO ()
foreign import ccall "vkBindBufferMemory" bindMemory ::
Device.D -> B -> Memory.M -> Word64 ->
{-# LINE 102 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
IO Int32
{-# LINE 103 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
struct "Copy" (24) 8 [
{-# LINE 105 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcOffset", ''Word64,
{-# LINE 106 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 107 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 108 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstOffset", ''Word64,
{-# LINE 109 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 110 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 111 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 112 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 113 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]) ]
{-# LINE 114 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
mbType :: Word32
{-# LINE 117 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
mbType = 44
{-# LINE 118 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
struct "MemoryBarrier" (56)
{-# LINE 120 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
8 [
{-# LINE 121 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p mbType |]),
{-# LINE 123 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 125 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 126 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcAccessMask", ''Word32,
{-# LINE 127 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 128 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 129 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstAccessMask", ''Word32,
{-# LINE 130 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 131 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 132 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcQueueFamilyIndex", ''Word32,
{-# LINE 133 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 134 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 135 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstQueueFamilyIndex", ''Word32,
{-# LINE 136 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 28) |],
{-# LINE 137 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 28) |]),
{-# LINE 138 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("buffer", ''B,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 140 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 141 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("offset", ''Word64,
{-# LINE 142 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 143 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 144 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 145 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 146 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]) ]
{-# LINE 147 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
mbType2 :: Word32
{-# LINE 150 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
mbType2 = 1000314001
{-# LINE 151 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
struct "MemoryBarrier2" (80)
{-# LINE 153 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
8 [
{-# LINE 154 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sType", ''(), [| const $ pure() |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p mbType2 |]),
{-# LINE 156 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 158 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 159 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcStageMask", ''Word64,
{-# LINE 160 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 161 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 162 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcAccessMask", ''Word64,
{-# LINE 163 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 164 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 165 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstStageMask", ''Word64,
{-# LINE 166 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 167 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 168 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstAccessMask", ''Word64,
{-# LINE 169 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 170 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 171 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcQueueFamilyIndex", ''Word32,
{-# LINE 172 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 173 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 174 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstQueueFamilyIndex", ''Word32,
{-# LINE 175 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 52) |],
{-# LINE 176 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 52) |]),
{-# LINE 177 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("buffer", ''B,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 179 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]),
{-# LINE 180 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("offset", ''Word64,
{-# LINE 181 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 64) |],
{-# LINE 182 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 64) |]),
{-# LINE 183 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 184 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 72) |],
{-# LINE 185 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 72) |]) ]
{-# LINE 186 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
type PtrMemoryBarrier2 = Ptr MemoryBarrier2
struct "ImageCopy" (56) 8 [
{-# LINE 191 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferOffset", ''Word64,
{-# LINE 192 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 193 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 194 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferRowLength", ''Word32,
{-# LINE 195 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 196 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 197 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferImageHeight", ''Word32,
{-# LINE 198 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 199 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 200 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageSubresource", ''Image.SubresourceLayers,
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 202 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 203 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageOffset", ''Offset3d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 205 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 206 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageExtent", ''Extent3d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 44) |],
{-# LINE 208 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 44) |]) ]
{-# LINE 209 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]