{-# LINE 1 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Gpu.Vulkan.Semaphore.Core (
create, destroy, S, PtrS, CreateInfo, pattern CreateInfo,
createInfoSType, createInfoPNext, createInfoFlags,
) where
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Struct
import Foreign.C.Struct.TypeSynonyms
import Data.Word
import Data.Int
import qualified Gpu.Vulkan.AllocationCallbacks.Core as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Core as Device
sType :: Word32
{-# LINE 28 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
sType = 9
{-# LINE 29 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
struct "CreateInfo" (24)
{-# LINE 31 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
8 [
{-# LINE 32 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
("sType", ''(), [| const $ pure () |],
[| \p _ -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sType |]),
{-# LINE 34 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
("pNext", ''PtrVoid,
[| (\hsc_ptr -> peekByteOff hsc_ptr 8) |],
{-# LINE 36 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 8) |]),
{-# LINE 37 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
("flags", ''Word32,
{-# LINE 38 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
[| (\hsc_ptr -> peekByteOff hsc_ptr 16) |],
{-# LINE 39 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
[| (\hsc_ptr -> pokeByteOff hsc_ptr 16) |]) ]
{-# LINE 40 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
[''Show, ''Storable]
data STag
type S = Ptr STag
type PtrS = Ptr S
foreign import ccall "vkCreateSemaphore" create ::
Device.D -> Ptr CreateInfo -> Ptr AllocationCallbacks.A ->
Ptr S -> IO Int32
{-# LINE 49 "src/Gpu/Vulkan/Semaphore/Core.hsc" #-}
foreign import ccall "vkDestroySemaphore" destroy ::
Device.D -> S -> Ptr AllocationCallbacks.A -> IO ()