{-# LINE 1 "src/Gpu/Vulkan/Image/Core.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.Image.Core (
create, destroy, I, CreateInfo, pattern CreateInfo,
createInfoSType, createInfoPNext, createInfoFlags,
createInfoImageType, createInfoFormat, createInfoExtent,
createInfoMipLevels, createInfoArrayLayers, createInfoSamples,
createInfoTiling, createInfoUsage, createInfoSharingMode,
createInfoQueueFamilyIndexCount, createInfoPQueueFamilyIndices,
createInfoInitialLayout,
getMemoryRequirements, bindMemory,
MemoryBarrier, pattern MemoryBarrier,
memoryBarrierSType, memoryBarrierPNext,
memoryBarrierSrcAccessMask, memoryBarrierDstAccessMask,
memoryBarrierOldLayout, memoryBarrierNewLayout,
memoryBarrierSrcQueueFamilyIndex, memoryBarrierDstQueueFamilyIndex,
memoryBarrierImage, memoryBarrierSubresourceRange,
SubresourceRange, pattern SubresourceRange,
subresourceRangeAspectMask, subresourceRangeBaseMipLevel,
subresourceRangeLevelCount, subresourceRangeBaseArrayLayer,
subresourceRangeLayerCount,
Blit, pattern Blit,
blitSrcSubresource, blitSrcOffsets, blitDstSubresource, blitDstOffsets,
SubresourceLayers, pattern SubresourceLayers,
subresourceLayersAspectMask, subresourceLayersMipLevel,
subresourceLayersBaseArrayLayer, subresourceLayersLayerCount,
) where
import Foreign.Ptr
import Foreign.Marshal.Array
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 Gpu.Vulkan.Device.Core qualified as Device
import Gpu.Vulkan.Memory.Core qualified as Memory
struct "SubresourceRange" (20)
{-# LINE 68 "src/Gpu/Vulkan/Image/Core.hsc" #-}
4 [
{-# LINE 69 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("aspectMask", ''Word32,
{-# LINE 70 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 71 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 72 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("baseMipLevel", ''Word32,
{-# LINE 73 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 74 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 75 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("levelCount", ''Word32,
{-# LINE 76 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 77 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 78 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("baseArrayLayer", ''Word32,
{-# LINE 79 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 80 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 81 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("layerCount", ''Word32,
{-# LINE 82 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 83 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]) ]
{-# LINE 84 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[''Show, ''Storable]
data ITag
type I = Ptr ITag
sType :: Word32
{-# LINE 90 "src/Gpu/Vulkan/Image/Core.hsc" #-}
sType = 14
{-# LINE 91 "src/Gpu/Vulkan/Image/Core.hsc" #-}
struct "CreateInfo" (88) 8 [
{-# LINE 93 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sType |]),
{-# LINE 95 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 97 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 98 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 99 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 100 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 101 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("imageType", ''Word32,
{-# LINE 102 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 103 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 104 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("format", ''Word32,
{-# LINE 105 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 106 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 107 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("extent", ''Extent3d,
[| (\hsc_ptr -> peekByteOff hsc_ptr 28) |],
{-# LINE 109 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 28) |]),
{-# LINE 110 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("mipLevels", ''Word32,
{-# LINE 111 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 112 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 113 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("arrayLayers", ''Word32,
{-# LINE 114 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 44) |],
{-# LINE 115 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 44) |]),
{-# LINE 116 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("samples", ''Word32,
{-# LINE 117 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 118 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 119 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("tiling", ''Word32,
{-# LINE 120 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 52) |],
{-# LINE 121 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 52) |]),
{-# LINE 122 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("usage", ''Word32,
{-# LINE 123 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 124 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]),
{-# LINE 125 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("sharingMode", ''Word32,
{-# LINE 126 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 60) |],
{-# LINE 127 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 60) |]),
{-# LINE 128 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("queueFamilyIndexCount", ''Word32,
{-# LINE 129 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 64) |],
{-# LINE 130 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 64) |]),
{-# LINE 131 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("pQueueFamilyIndices", ''PtrUint32T,
[| (\hsc_ptr -> peekByteOff hsc_ptr 72) |],
{-# LINE 133 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 72) |]),
{-# LINE 134 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("initialLayout", ''Word32,
{-# LINE 135 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 80) |],
{-# LINE 136 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 80) |]) ]
{-# LINE 137 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[''Show, ''Storable]
foreign import ccall "vkCreateImage" create ::
Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A -> Ptr I ->
IO Int32
{-# LINE 142 "src/Gpu/Vulkan/Image/Core.hsc" #-}
foreign import ccall "vkGetImageMemoryRequirements" getMemoryRequirements ::
Device.D -> I -> Ptr Memory.Requirements -> IO ()
foreign import ccall "vkBindImageMemory" bindMemory ::
Device.D -> I -> Memory.M -> Word64 ->
{-# LINE 148 "src/Gpu/Vulkan/Image/Core.hsc" #-}
IO Int32
{-# LINE 149 "src/Gpu/Vulkan/Image/Core.hsc" #-}
mbType :: Word32
{-# LINE 151 "src/Gpu/Vulkan/Image/Core.hsc" #-}
mbType = 45
{-# LINE 152 "src/Gpu/Vulkan/Image/Core.hsc" #-}
struct "MemoryBarrier" (72)
{-# LINE 154 "src/Gpu/Vulkan/Image/Core.hsc" #-}
8 [
{-# LINE 155 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p mbType |]),
{-# LINE 157 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 159 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 160 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("srcAccessMask", ''Word32,
{-# LINE 161 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 162 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 163 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("dstAccessMask", ''Word32,
{-# LINE 164 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 165 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 166 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("oldLayout", ''Word32,
{-# LINE 167 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 168 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 169 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("newLayout", ''Word32,
{-# LINE 170 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 28) |],
{-# LINE 171 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 28) |]),
{-# LINE 172 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("srcQueueFamilyIndex", ''Word32,
{-# LINE 173 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 174 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 175 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("dstQueueFamilyIndex", ''Word32,
{-# LINE 176 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 36) |],
{-# LINE 177 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 36) |]),
{-# LINE 178 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("image", ''I,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 180 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 181 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("subresourceRange", ''SubresourceRange,
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 183 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]) ]
{-# LINE 184 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[''Show, ''Storable]
struct "SubresourceLayers" (16)
{-# LINE 187 "src/Gpu/Vulkan/Image/Core.hsc" #-}
4 [
{-# LINE 188 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("aspectMask", ''Word32,
{-# LINE 189 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 190 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 191 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("mipLevel", ''Word32,
{-# LINE 192 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 193 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 194 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("baseArrayLayer", ''Word32,
{-# LINE 195 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 196 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 197 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("layerCount", ''Word32,
{-# LINE 198 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 199 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]) ]
{-# LINE 200 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[''Show, ''Storable]
foreign import ccall "vkDestroyImage" destroy ::
Device.D -> I -> Ptr AllocationCallbacks.A -> IO ()
struct "Blit" (80) 4 [
{-# LINE 206 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("srcSubresource", ''SubresourceLayers,
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 208 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 209 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("srcOffsets", ''ListOffset3d,
[| \p -> peekArray 2 ((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) |],
{-# LINE 211 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| \p os -> pokeArray
((\hsc_ptr -> hsc_ptr `plusPtr` 16) p) $ take 2 os |]),
{-# LINE 213 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("dstSubresource", ''SubresourceLayers,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 215 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 216 "src/Gpu/Vulkan/Image/Core.hsc" #-}
("dstOffsets", ''ListOffset3d,
[| \p -> peekArray 2 ((\hsc_ptr -> hsc_ptr `plusPtr` 56) p) |],
{-# LINE 218 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[| \p os -> pokeArray
((\hsc_ptr -> hsc_ptr `plusPtr` 56) p) $ take 2 os |]) ]
{-# LINE 220 "src/Gpu/Vulkan/Image/Core.hsc" #-}
[''Show, ''Storable]