{-# 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
) 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 54 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 56 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
(12 ::
{-# LINE 57 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
Word32) |]),
{-# LINE 58 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pNext", ''PtrVoid, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 59 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 60 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 61 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 62 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 63 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 64 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 65 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 66 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("usage", ''Word32,
{-# LINE 67 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 68 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 69 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sharingMode", ''Word32,
{-# LINE 70 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 36) |],
{-# LINE 71 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 36) |]),
{-# LINE 72 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("queueFamilyIndexCount", ''Word32,
{-# LINE 73 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 74 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 75 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pQueueFamilyIndices", ''PtrUint32T,
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 77 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]) ]
{-# LINE 78 "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 86 "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 95 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
IO Int32
{-# LINE 96 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
struct "Copy" (24) 8 [
{-# LINE 98 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcOffset", ''Word64,
{-# LINE 99 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 100 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 101 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstOffset", ''Word64,
{-# LINE 102 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 103 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 104 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 105 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 106 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]) ]
{-# LINE 107 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
mbType :: Word32
{-# LINE 110 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
mbType = 44
{-# LINE 111 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
struct "MemoryBarrier" (56)
{-# LINE 113 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
8 [
{-# LINE 114 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p mbType |]),
{-# LINE 116 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 118 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 119 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcAccessMask", ''Word32,
{-# LINE 120 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 121 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 122 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstAccessMask", ''Word32,
{-# LINE 123 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 124 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 125 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("srcQueueFamilyIndex", ''Word32,
{-# LINE 126 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 127 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 128 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("dstQueueFamilyIndex", ''Word32,
{-# LINE 129 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 28) |],
{-# LINE 130 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 28) |]),
{-# LINE 131 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("buffer", ''B,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 133 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 134 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("offset", ''Word64,
{-# LINE 135 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 136 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 137 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("size", ''Word64,
{-# LINE 138 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 139 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]) ]
{-# LINE 140 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]
struct "ImageCopy" (56) 8 [
{-# LINE 143 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferOffset", ''Word64,
{-# LINE 144 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 145 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 146 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferRowLength", ''Word32,
{-# LINE 147 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 148 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 149 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("bufferImageHeight", ''Word32,
{-# LINE 150 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 151 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 152 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageSubresource", ''Image.SubresourceLayers,
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 154 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 155 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageOffset", ''Offset3d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 157 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 158 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
("imageExtent", ''Extent3d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 44) |],
{-# LINE 160 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 44) |]) ]
{-# LINE 161 "src/Gpu/Vulkan/Buffer/Core.hsc" #-}
[''Show, ''Storable]