{-# 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,
SubmitInfo2, pattern SubmitInfo2,
submitInfo2SType, submitInfo2PNext, submitInfo2Flags,
submitInfo2WaitSemaphoreInfoCount, submitInfo2PWaitSemaphoreInfos,
submitInfo2CommandBufferInfoCount, submitInfo2PCommandBufferInfos,
submitInfo2SignalSemaphoreInfoCount, submitInfo2PSignalSemaphoreInfos,
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 154 "src/Gpu/Vulkan/Core.hsc" #-}
8 [
{-# LINE 155 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''Word32,
{-# LINE 156 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 157 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |] ),
{-# LINE 158 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 160 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 161 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type ApiVersion = Word32
{-# LINE 164 "src/Gpu/Vulkan/Core.hsc" #-}
struct "ApplicationInfo" (48)
{-# LINE 166 "src/Gpu/Vulkan/Core.hsc" #-}
8 [
{-# LINE 167 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 169 "src/Gpu/Vulkan/Core.hsc" #-}
(0 ::
{-# LINE 170 "src/Gpu/Vulkan/Core.hsc" #-}
Word32) |]),
{-# LINE 171 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 172 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 173 "src/Gpu/Vulkan/Core.hsc" #-}
("pApplicationName", ''CString,
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 175 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 176 "src/Gpu/Vulkan/Core.hsc" #-}
("applicationVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 178 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 179 "src/Gpu/Vulkan/Core.hsc" #-}
("pEngineName", ''CString,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 181 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 182 "src/Gpu/Vulkan/Core.hsc" #-}
("engineVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 184 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 185 "src/Gpu/Vulkan/Core.hsc" #-}
("apiVersion", ''ApiVersion,
[| (\hsc_ptr -> peekByteOff hsc_ptr 44) |],
{-# LINE 187 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 44) |]) ]
{-# LINE 188 "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 208 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 209 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 210 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 211 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 212 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Extent3d" (12) 4 [
{-# LINE 215 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 216 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 217 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 218 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 219 "src/Gpu/Vulkan/Core.hsc" #-}
("depth", ''Word32, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 220 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 221 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Viewport" (24) 4 [
{-# LINE 224 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 225 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 226 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 227 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 228 "src/Gpu/Vulkan/Core.hsc" #-}
("width", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 229 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 230 "src/Gpu/Vulkan/Core.hsc" #-}
("height", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 231 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 232 "src/Gpu/Vulkan/Core.hsc" #-}
("minDepth", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 233 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 234 "src/Gpu/Vulkan/Core.hsc" #-}
("maxDepth", ''Float, [| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 235 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]) ]
{-# LINE 236 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type PtrViewport = Ptr Viewport
struct "Offset2d" (8) 4 [
{-# LINE 241 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 242 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 243 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 244 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 245 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "Offset3d" (12) 4 [
{-# LINE 248 "src/Gpu/Vulkan/Core.hsc" #-}
("x", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 249 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 250 "src/Gpu/Vulkan/Core.hsc" #-}
("y", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 251 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 252 "src/Gpu/Vulkan/Core.hsc" #-}
("z", ''Int32, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 253 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 254 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type ListOffset3d = [Offset3d]
struct "Rect2d" (16) 4 [
{-# LINE 259 "src/Gpu/Vulkan/Core.hsc" #-}
("offset", ''Offset2d, [| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 260 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 261 "src/Gpu/Vulkan/Core.hsc" #-}
("extent", ''Extent2d, [| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 262 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 263 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
type PtrRect2d = Ptr Rect2d
type PtrPipelineStageFlags = Ptr Word32
{-# LINE 268 "src/Gpu/Vulkan/Core.hsc" #-}
sTypeS :: Word32
{-# LINE 270 "src/Gpu/Vulkan/Core.hsc" #-}
sTypeS = 4
{-# LINE 271 "src/Gpu/Vulkan/Core.hsc" #-}
struct "SubmitInfo" (72) 8 [
{-# LINE 273 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sTypeS |]),
{-# LINE 275 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 277 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 278 "src/Gpu/Vulkan/Core.hsc" #-}
("waitSemaphoreCount", ''Word32,
{-# LINE 279 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 280 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 281 "src/Gpu/Vulkan/Core.hsc" #-}
("pWaitSemaphores", ''Semaphore.PtrS,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 283 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 284 "src/Gpu/Vulkan/Core.hsc" #-}
("pWaitDstStageMask", ''PtrPipelineStageFlags,
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 286 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 287 "src/Gpu/Vulkan/Core.hsc" #-}
("commandBufferCount", ''Word32,
{-# LINE 288 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 289 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 290 "src/Gpu/Vulkan/Core.hsc" #-}
("pCommandBuffers", ''CommandBuffer.PtrC,
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 292 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 293 "src/Gpu/Vulkan/Core.hsc" #-}
("signalSemaphoreCount", ''Int32,
{-# LINE 294 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 295 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]),
{-# LINE 296 "src/Gpu/Vulkan/Core.hsc" #-}
("pSignalSemaphores", ''Semaphore.PtrS,
[| (\hsc_ptr -> peekByteOff hsc_ptr 64) |],
{-# LINE 298 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 64) |]) ]
{-# LINE 299 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
sTypeS2 :: Word32
{-# LINE 302 "src/Gpu/Vulkan/Core.hsc" #-}
sTypeS2 = 1000314004
{-# LINE 303 "src/Gpu/Vulkan/Core.hsc" #-}
struct "SubmitInfo2" (64) 8 [
{-# LINE 305 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sTypeS2 |]),
{-# LINE 307 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 309 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 310 "src/Gpu/Vulkan/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 311 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 312 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 313 "src/Gpu/Vulkan/Core.hsc" #-}
("waitSemaphoreInfoCount", ''Word32,
{-# LINE 314 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 315 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 316 "src/Gpu/Vulkan/Core.hsc" #-}
("pWaitSemaphoreInfos", ''Semaphore.PtrSubmitInfo,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 318 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]),
{-# LINE 319 "src/Gpu/Vulkan/Core.hsc" #-}
("commandBufferInfoCount", ''Word32,
{-# LINE 320 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 321 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 322 "src/Gpu/Vulkan/Core.hsc" #-}
("pCommandBufferInfos", ''CommandBuffer.PtrSubmitInfo,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 324 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 325 "src/Gpu/Vulkan/Core.hsc" #-}
("signalSemaphoreInfoCount", ''Word32,
{-# LINE 326 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 327 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 328 "src/Gpu/Vulkan/Core.hsc" #-}
("pSignalSemaphoreInfos", ''Semaphore.PtrSubmitInfo,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 330 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 331 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "ExtensionProperties" (260)
{-# LINE 334 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 335 "src/Gpu/Vulkan/Core.hsc" #-}
("extensionName", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 0) p,
{-# LINE 338 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 339 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) cs ln
{-# LINE 341 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 342 "src/Gpu/Vulkan/Core.hsc" #-}
|]
),
("specVersion", ''Word32,
{-# LINE 345 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 256) |],
{-# LINE 346 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 256) |]) ]
{-# LINE 347 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "LayerProperties" (520)
{-# LINE 350 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 351 "src/Gpu/Vulkan/Core.hsc" #-}
("layerName", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 0) p,
{-# LINE 354 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 355 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p) cs ln
{-# LINE 357 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 0) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 358 "src/Gpu/Vulkan/Core.hsc" #-}
|]),
("specVersion", ''Word32,
{-# LINE 360 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 256) |],
{-# LINE 361 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 256) |]),
{-# LINE 362 "src/Gpu/Vulkan/Core.hsc" #-}
("implementationVersion", ''Word32,
{-# LINE 363 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 260) |],
{-# LINE 364 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 260) |]),
{-# LINE 365 "src/Gpu/Vulkan/Core.hsc" #-}
("description", ''Txt.Text,
[| \p -> Txt.takeWhile (/= '\NUL') <$> Txt.peekCStringLen
((\hsc_ptr -> hsc_ptr `plusPtr` 264) p,
{-# LINE 368 "src/Gpu/Vulkan/Core.hsc" #-}
256) |],
{-# LINE 369 "src/Gpu/Vulkan/Core.hsc" #-}
[| \p bs -> Txt.withCStringLen bs \(cs, ln) -> do
copyBytes ((\hsc_ptr -> hsc_ptr `plusPtr` 264) p) cs ln
{-# LINE 371 "src/Gpu/Vulkan/Core.hsc" #-}
poke ((\hsc_ptr -> hsc_ptr `plusPtr` 264) p `plusPtr` ln :: Ptr CChar) 0
{-# LINE 372 "src/Gpu/Vulkan/Core.hsc" #-}
|]) ]
[''Show, ''Storable]
struct "StencilOpState" (28) 4 [
{-# LINE 376 "src/Gpu/Vulkan/Core.hsc" #-}
("failOp", ''Word32,
{-# 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" #-}
("passOp", ''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" #-}
("depthFailOp", ''Word32,
{-# LINE 383 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 384 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 385 "src/Gpu/Vulkan/Core.hsc" #-}
("compareOp", ''Word32,
{-# LINE 386 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 12) |],
{-# LINE 387 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 12) |]),
{-# LINE 388 "src/Gpu/Vulkan/Core.hsc" #-}
("compareMask", ''Word32,
{-# LINE 389 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 390 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]),
{-# LINE 391 "src/Gpu/Vulkan/Core.hsc" #-}
("writeMask", ''Word32,
{-# LINE 392 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 393 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |]),
{-# LINE 394 "src/Gpu/Vulkan/Core.hsc" #-}
("reference", ''Word32,
{-# LINE 395 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 396 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |]) ]
{-# LINE 397 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
data ClearValue
type PtrClearValue = Ptr ClearValue
data ClearColorValue
clearColorValueFromFloats :: Ptr Float -> Ptr ClearColorValue
{-# LINE 404 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromFloats = castPtr
clearColorValueFromInts :: Ptr Int32 -> Ptr ClearColorValue
{-# LINE 407 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromInts = castPtr
clearColorValueFromUints :: Ptr Word32 -> Ptr ClearColorValue
{-# LINE 410 "src/Gpu/Vulkan/Core.hsc" #-}
clearColorValueFromUints = castPtr
struct "ClearDepthStencilValue" (8)
{-# LINE 413 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 414 "src/Gpu/Vulkan/Core.hsc" #-}
("depth", ''Float,
{-# LINE 415 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 416 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 417 "src/Gpu/Vulkan/Core.hsc" #-}
("stencil", ''Word32,
{-# LINE 418 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 419 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]) ]
{-# LINE 420 "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 431 "src/Gpu/Vulkan/Core.hsc" #-}
4 [
{-# LINE 432 "src/Gpu/Vulkan/Core.hsc" #-}
("linearTilingFeatures", ''Word32,
{-# LINE 433 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 0) |],
{-# LINE 434 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 0) |]),
{-# LINE 435 "src/Gpu/Vulkan/Core.hsc" #-}
("optimalTilingFeatures", ''Word32,
{-# LINE 436 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 4) |],
{-# LINE 437 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 4) |]),
{-# LINE 438 "src/Gpu/Vulkan/Core.hsc" #-}
("bufferFeatures", ''Word32,
{-# LINE 439 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 440 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]) ]
{-# LINE 441 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]
struct "DependencyInfo" (64) 8 [
{-# LINE 444 "src/Gpu/Vulkan/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p
{-# LINE 446 "src/Gpu/Vulkan/Core.hsc" #-}
(1000314003 ::
{-# LINE 447 "src/Gpu/Vulkan/Core.hsc" #-}
Word32) |]),
{-# LINE 448 "src/Gpu/Vulkan/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 450 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 451 "src/Gpu/Vulkan/Core.hsc" #-}
("dependencyFlags", ''Word32,
{-# LINE 452 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 453 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |] ),
{-# LINE 454 "src/Gpu/Vulkan/Core.hsc" #-}
("memoryBarrierCount", ''Word32,
{-# LINE 455 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 20) |],
{-# LINE 456 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 20) |] ),
{-# LINE 457 "src/Gpu/Vulkan/Core.hsc" #-}
("pMemoryBarriers", ''Memory.PtrBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 24) |],
{-# LINE 459 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 24) |] ),
{-# LINE 460 "src/Gpu/Vulkan/Core.hsc" #-}
("bufferMemoryBarrierCount", ''Word32,
{-# LINE 461 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 32) |],
{-# LINE 462 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 32) |]),
{-# LINE 463 "src/Gpu/Vulkan/Core.hsc" #-}
("pBufferMemoryBarriers", ''Buffer.PtrMemoryBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 40) |],
{-# LINE 465 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 40) |]),
{-# LINE 466 "src/Gpu/Vulkan/Core.hsc" #-}
("imageMemoryBarrierCount", ''Word32,
{-# LINE 467 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 48) |],
{-# LINE 468 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 48) |]),
{-# LINE 469 "src/Gpu/Vulkan/Core.hsc" #-}
("pImageMemoryBarriers", ''Image.PtrMemoryBarrier2,
[| (\hsc_ptr -> peekByteOff hsc_ptr 56) |],
{-# LINE 471 "src/Gpu/Vulkan/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 56) |]) ]
{-# LINE 472 "src/Gpu/Vulkan/Core.hsc" #-}
[''Show, ''Storable]