{-# LINE 1 "src/Gpu/Vulkan/Core.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments, TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.Core (
ApplicationInfo, PtrApplicationInfo, pattern ApplicationInfo,
applicationInfoSType, applicationInfoPNext,
applicationInfoPApplicationName, applicationInfoApplicationVersion,
applicationInfoPEngineName, applicationInfoEngineVersion,
applicationInfoApiVersion,
ApiVersion, makeApiVersion,
apiVersion_1_0, apiVersion_1_1, apiVersion_1_2, apiVersion_1_3,
SubmitInfo, pattern SubmitInfo,
submitInfoSType, submitInfoPNext,
submitInfoWaitSemaphoreCount, submitInfoPWaitSemaphores,
submitInfoPWaitDstStageMask, PtrPipelineStageFlags,
submitInfoCommandBufferCount, submitInfoPCommandBuffers,
submitInfoSignalSemaphoreCount, submitInfoPSignalSemaphores,
ExtensionProperties, pattern ExtensionProperties,
extensionPropertiesExtensionName, extensionPropertiesSpecVersion,
LayerProperties, pattern LayerProperties,
layerPropertiesLayerName, layerPropertiesSpecVersion,
layerPropertiesImplementationVersion, layerPropertiesDescription,
FormatProperties, pattern FormatProperties,
formatPropertiesLinearTilingFeatures,
formatPropertiesOptimalTilingFeatures, formatPropertiesBufferFeatures,
Viewport, PtrViewport, pattern Viewport,
viewportX, viewportY, viewportWidth, viewportHeight,
viewportMinDepth, viewportMaxDepth,
StencilOpState, pattern StencilOpState,
stencilOpStateFailOp, stencilOpStatePassOp, stencilOpStateDepthFailOp,
stencilOpStateCompareOp, stencilOpStateCompareMask,
stencilOpStateWriteMask, stencilOpStateReference,
ClearValue, PtrClearValue,
clearValueFromClearColorValue, clearValueFromClearDepthStencilValue,
ClearColorValue,
clearColorValueFromUints, clearColorValueFromInts,
clearColorValueFromFloats,
ClearDepthStencilValue, pattern ClearDepthStencilValue,
clearDepthStencilValueDepth, clearDepthStencilValueStencil,
StructCommon, pattern StructCommon,
structCommonSType, structCommonPNext,
Rect2d, PtrRect2d, pattern Rect2d,
rect2dExtent, rect2dOffset,
Offset2d, pattern Offset2d,
offset2dX, offset2dY,
Offset3d, ListOffset3d, pattern Offset3d,
offset3dX, offset3dY, offset3dZ,
Extent2d, pattern Extent2d,
extent2dWidth, extent2dHeight,
Extent3d, pattern Extent3d,
extent3dWidth, extent3dHeight, extent3dDepth,
DependencyInfo, pattern DependencyInfo,
dependencyInfoSType, dependencyInfoPNext, dependencyInfoDependencyFlags,
dependencyInfoMemoryBarrierCount, dependencyInfoPMemoryBarriers,
dependencyInfoBufferMemoryBarrierCount,
dependencyInfoPBufferMemoryBarriers,
dependencyInfoImageMemoryBarrierCount,
dependencyInfoPImageMemoryBarriers
) where
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Utils
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Foreign.C.Struct
import Foreign.C.Struct.TypeSynonyms
import Data.Word
import Data.Int
import qualified Data.Text as Txt
import qualified Data.Text.Foreign as Txt
import {-# SOURCE #-} qualified Gpu.Vulkan.CommandBuffer.Core as CommandBuffer
import {-# SOURCE #-} qualified Gpu.Vulkan.Semaphore.Core as Semaphore
import qualified Gpu.Vulkan.Memory.Core as Memory
import {-# SOURCE #-} qualified Gpu.Vulkan.Buffer.Core as Buffer
import {-# SOURCE #-} qualified Gpu.Vulkan.Image.Core as Image
struct "StructCommon" (48)
{-# LINE 148 "src/Gpu/Vulkan/Core.hsc" #-}
8 [
{-# LINE 149 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''Word32,
{-# LINE 150 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 151 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |] ),
{-# LINE 152 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 154 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 155 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type ApiVersion = Word32
{-# LINE 158 "src/Gpu/Vulkan/Core.hsc" #-}
struct "ApplicationInfo" (48)
{-# LINE 160 "src/Gpu/Vulkan/Core.hsc" #-}
8 [
{-# LINE 161 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 163 "src/Gpu/Vulkan/Core.hsc" #-}
(0 ::
{-# LINE 164 "src/Gpu/Vulkan/Core.hsc" #-}
Word32) |]),
{-# LINE 165 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 166 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 167 "src/Gpu/Vulkan/Core.hsc" #-}
("pApplicationName", ''CString,
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 169 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 170 "src/Gpu/Vulkan/Core.hsc" #-}
("applicationVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 172 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 173 "src/Gpu/Vulkan/Core.hsc" #-}
("pEngineName", ''CString,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 175 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 176 "src/Gpu/Vulkan/Core.hsc" #-}
("engineVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 178 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 179 "src/Gpu/Vulkan/Core.hsc" #-}
("apiVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 44) |],
{-# LINE 181 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 44) |]) ]
{-# LINE 182 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
foreign import capi "vulkan/vulkan.h VK_MAKE_API_VERSION" makeApiVersion ::
Word8 -> Word8 -> Word16 -> Word16 -> ApiVersion
foreign import capi "vulkan/vulkan.h value VK_API_VERSION_1_0" apiVersion_1_0 ::
ApiVersion
foreign import capi "vulkan/vulkan.h value VK_API_VERSION_1_1" apiVersion_1_1 ::
ApiVersion
foreign import capi "vulkan/vulkan.h value VK_API_VERSION_1_2" apiVersion_1_2 ::
ApiVersion
foreign import capi "vulkan/vulkan.h value VK_API_VERSION_1_3" apiVersion_1_3 ::
ApiVersion
type PtrApplicationInfo = Ptr ApplicationInfo
struct "Extent2d" (8) 4 [
{-# LINE 202 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 203 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 204 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 205 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 206 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Extent3d" (12) 4 [
{-# LINE 209 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 210 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 211 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 212 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 213 "src/Gpu/Vulkan/Core.hsc" #-}
("depth", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 214 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 215 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Viewport" (24) 4 [
{-# LINE 218 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 219 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 220 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 221 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 222 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 223 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 224 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 225 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 226 "src/Gpu/Vulkan/Core.hsc" #-}
("minDepth", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 227 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 228 "src/Gpu/Vulkan/Core.hsc" #-}
("maxDepth", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 229 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]) ]
{-# LINE 230 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type PtrViewport = Ptr Viewport
struct "Offset2d" (8) 4 [
{-# LINE 235 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 236 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 237 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 238 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 239 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Offset3d" (12) 4 [
{-# LINE 242 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 243 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 244 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 245 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 246 "src/Gpu/Vulkan/Core.hsc" #-}
("z", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 247 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 248 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type ListOffset3d = [Offset3d]
struct "Rect2d" (16) 4 [
{-# LINE 253 "src/Gpu/Vulkan/Core.hsc" #-}
("offset", ''Offset2d, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 254 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 255 "src/Gpu/Vulkan/Core.hsc" #-}
("extent", ''Extent2d, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 256 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 257 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type PtrRect2d = Ptr Rect2d
type PtrPipelineStageFlags = Ptr Word32
{-# LINE 262 "src/Gpu/Vulkan/Core.hsc" #-}
sTypeS :: Word32
{-# LINE 264 "src/Gpu/Vulkan/Core.hsc" #-}
sTypeS = 4
{-# LINE 265 "src/Gpu/Vulkan/Core.hsc" #-}
struct "SubmitInfo" (72) 8 [
{-# LINE 267 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sTypeS |]),
{-# LINE 269 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 271 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 272 "src/Gpu/Vulkan/Core.hsc" #-}
("waitSemaphoreCount", ''Word32,
{-# LINE 273 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 274 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 275 "src/Gpu/Vulkan/Core.hsc" #-}
("pWaitSemaphores", ''Semaphore.PtrS,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 277 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 278 "src/Gpu/Vulkan/Core.hsc" #-}
("pWaitDstStageMask", ''PtrPipelineStageFlags,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 280 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 281 "src/Gpu/Vulkan/Core.hsc" #-}
("commandBufferCount", ''Word32,
{-# LINE 282 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 283 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 284 "src/Gpu/Vulkan/Core.hsc" #-}
("pCommandBuffers", ''CommandBuffer.PtrC,
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 286 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 287 "src/Gpu/Vulkan/Core.hsc" #-}
("signalSemaphoreCount", ''Int32,
{-# LINE 288 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 289 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]),
{-# LINE 290 "src/Gpu/Vulkan/Core.hsc" #-}
("pSignalSemaphores", ''Semaphore.PtrS,
[| (\hsc_ptr -> peekByteOff hsc_ptr 64) |],
{-# LINE 292 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 64) |]) ]
{-# LINE 293 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "ExtensionProperties" (260)
{-# LINE 296 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 297 "src/Gpu/Vulkan/Core.hsc" #-}
("extensionName", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 0) p,
{-# LINE 300 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 301 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) cs ln
{-# LINE 303 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 304 "src/Gpu/Vulkan/Core.hsc" #-}
|]
),
("specVersion", ''Word32,
{-# LINE 307 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 256) |],
{-# LINE 308 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 256) |]) ]
{-# LINE 309 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "LayerProperties" (520)
{-# LINE 312 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 313 "src/Gpu/Vulkan/Core.hsc" #-}
("layerName", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 0) p,
{-# LINE 316 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 317 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) cs ln
{-# LINE 319 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 320 "src/Gpu/Vulkan/Core.hsc" #-}
|]),
("specVersion", ''Word32,
{-# LINE 322 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 256) |],
{-# LINE 323 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 256) |]),
{-# LINE 324 "src/Gpu/Vulkan/Core.hsc" #-}
("implementationVersion", ''Word32,
{-# LINE 325 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 260) |],
{-# LINE 326 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 260) |]),
{-# LINE 327 "src/Gpu/Vulkan/Core.hsc" #-}
("description", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 264) p,
{-# LINE 330 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 331 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 264) p) cs ln
{-# LINE 333 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 264) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 334 "src/Gpu/Vulkan/Core.hsc" #-}
|]) ]
[''Show, ''Storable]
struct "StencilOpState" (28) 4 [
{-# LINE 338 "src/Gpu/Vulkan/Core.hsc" #-}
("failOp", ''Word32,
{-# LINE 339 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 340 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 341 "src/Gpu/Vulkan/Core.hsc" #-}
("passOp", ''Word32,
{-# LINE 342 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 343 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 344 "src/Gpu/Vulkan/Core.hsc" #-}
("depthFailOp", ''Word32,
{-# LINE 345 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 346 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 347 "src/Gpu/Vulkan/Core.hsc" #-}
("compareOp", ''Word32,
{-# LINE 348 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 349 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 350 "src/Gpu/Vulkan/Core.hsc" #-}
("compareMask", ''Word32,
{-# LINE 351 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 352 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 353 "src/Gpu/Vulkan/Core.hsc" #-}
("writeMask", ''Word32,
{-# LINE 354 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 355 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 356 "src/Gpu/Vulkan/Core.hsc" #-}
("reference", ''Word32,
{-# LINE 357 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 358 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]) ]
{-# LINE 359 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
data ClearValue
type PtrClearValue = Ptr ClearValue
data ClearColorValue
clearColorValueFromFloats :: Ptr Float -> Ptr ClearColorValue
{-# LINE 366 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromFloats = castPtr
clearColorValueFromInts :: Ptr Int32 -> Ptr ClearColorValue
{-# LINE 369 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromInts = castPtr
clearColorValueFromUints :: Ptr Word32 -> Ptr ClearColorValue
{-# LINE 372 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromUints = castPtr
struct "ClearDepthStencilValue" (8)
{-# LINE 375 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 376 "src/Gpu/Vulkan/Core.hsc" #-}
("depth", ''Float,
{-# LINE 377 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 378 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 379 "src/Gpu/Vulkan/Core.hsc" #-}
("stencil", ''Word32,
{-# LINE 380 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 381 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 382 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
clearValueFromClearColorValue :: Ptr ClearColorValue -> Ptr ClearValue
clearValueFromClearColorValue :: Ptr ClearColorValue -> Ptr ClearValue
clearValueFromClearColorValue = Ptr ClearColorValue -> Ptr ClearValue
forall a b. Ptr a -> Ptr b
castPtr
clearValueFromClearDepthStencilValue ::
ClearDepthStencilValue -> (Ptr ClearValue -> IO a) -> IO a
clearValueFromClearDepthStencilValue :: forall a.
ClearDepthStencilValue -> (Ptr ClearValue -> IO a) -> IO a
clearValueFromClearDepthStencilValue (ClearDepthStencilValue_ ForeignPtr ClearDepthStencilValue
fp) Ptr ClearValue -> IO a
f =
ForeignPtr ClearDepthStencilValue
-> (Ptr ClearDepthStencilValue -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ClearDepthStencilValue
fp ((Ptr ClearDepthStencilValue -> IO a) -> IO a)
-> (Ptr ClearDepthStencilValue -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr ClearValue -> IO a
f (Ptr ClearValue -> IO a)
-> (Ptr ClearDepthStencilValue -> Ptr ClearValue)
-> Ptr ClearDepthStencilValue
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ClearDepthStencilValue -> Ptr ClearValue
forall a b. Ptr a -> Ptr b
castPtr
struct "FormatProperties" (12)
{-# LINE 393 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 394 "src/Gpu/Vulkan/Core.hsc" #-}
("linearTilingFeatures", ''Word32,
{-# LINE 395 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 396 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 397 "src/Gpu/Vulkan/Core.hsc" #-}
("optimalTilingFeatures", ''Word32,
{-# LINE 398 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 399 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 400 "src/Gpu/Vulkan/Core.hsc" #-}
("bufferFeatures", ''Word32,
{-# LINE 401 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 402 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 403 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "DependencyInfo" (64) 8 [
{-# LINE 406 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 408 "src/Gpu/Vulkan/Core.hsc" #-}
(1000314003 ::
{-# LINE 409 "src/Gpu/Vulkan/Core.hsc" #-}
Word32) |]),
{-# LINE 410 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 412 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 413 "src/Gpu/Vulkan/Core.hsc" #-}
("dependencyFlags", ''Word32,
{-# LINE 414 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 415 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |] ),
{-# LINE 416 "src/Gpu/Vulkan/Core.hsc" #-}
("memoryBarrierCount", ''Word32,
{-# LINE 417 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 418 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |] ),
{-# LINE 419 "src/Gpu/Vulkan/Core.hsc" #-}
("pMemoryBarriers", ''Memory.PtrBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 421 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |] ),
{-# LINE 422 "src/Gpu/Vulkan/Core.hsc" #-}
("bufferMemoryBarrierCount", ''Word32,
{-# LINE 423 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 424 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 425 "src/Gpu/Vulkan/Core.hsc" #-}
("pBufferMemoryBarriers", ''Buffer.PtrMemoryBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 427 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 428 "src/Gpu/Vulkan/Core.hsc" #-}
("imageMemoryBarrierCount", ''Word32,
{-# LINE 429 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 430 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 431 "src/Gpu/Vulkan/Core.hsc" #-}
("pImageMemoryBarriers", ''Image.PtrMemoryBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 433 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 434 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]