{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Vulkan.Marshal.Proc
( VulkanProc (..)
, vkGetInstanceProc, vkGetInstanceProcUnsafe, vkGetInstanceProcSafe
, vkLookupInstanceProc, vkLookupInstanceProcUnsafe, vkLookupInstanceProcSafe
, vkGetDeviceProc, vkGetDeviceProcUnsafe, vkGetDeviceProcSafe
, vkLookupDeviceProc, vkLookupDeviceProcUnsafe, vkLookupDeviceProcSafe
, vkGetProc, vkGetProcUnsafe, vkGetProcSafe
, vkLookupProc, vkLookupProcUnsafe, vkLookupProcSafe
, FunPtr, nullFunPtr
) where
import Control.Monad (when)
import Data.Void (Void)
import Foreign.C.String (CString, peekCString)
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr,
withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (FunPtr, nullFunPtr, nullPtr)
import Foreign.Storable (peek)
import GHC.Ptr (Ptr (..))
import GHC.TypeLits (Symbol)
import System.IO.Unsafe (unsafePerformIO)
import Graphics.Vulkan.Types.Handles (VkDevice, VkInstance)
class VulkanProc (proc :: Symbol) where
type VkProcType proc
vkProcSymbol :: CString
unwrapVkProcPtrUnsafe :: FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtrSafe :: FunPtr (VkProcType proc) -> VkProcType proc
vkGetInstanceProcUnsafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (VkProcType proc)
vkGetInstanceProcUnsafe i
= unwrapVkProcPtrUnsafe @proc
<$> c'vkGetInstanceProcAddrUnsafe i (vkProcSymbol @proc)
{-# INLINE vkGetInstanceProcUnsafe #-}
vkLookupInstanceProcUnsafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProcUnsafe i
= f <$> c'vkGetInstanceProcAddrUnsafe i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtrUnsafe @proc p)
{-# INLINE vkLookupInstanceProcUnsafe #-}
vkGetDeviceProcUnsafe :: forall proc . VulkanProc proc
=> VkDevice -> IO (VkProcType proc)
vkGetDeviceProcUnsafe i
= unwrapVkProcPtrUnsafe @proc
<$> c'vkGetDeviceProcAddrUnsafe i (vkProcSymbol @proc)
{-# INLINE vkGetDeviceProcUnsafe #-}
vkLookupDeviceProcUnsafe :: forall proc . VulkanProc proc
=> VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProcUnsafe i
= f <$> c'vkGetDeviceProcAddrUnsafe i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtrUnsafe @proc p)
{-# INLINE vkLookupDeviceProcUnsafe #-}
vkGetProcUnsafe :: forall proc . VulkanProc proc => IO (VkProcType proc)
vkGetProcUnsafe = alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (vkProcSymbol @proc) errPtr
when (fp == nullFunPtr) $ peek errPtr >>= peekCString >>= fail .
("An error happened while trying to load vulkan symbol dynamically: " ++)
return $ unwrapVkProcPtrUnsafe @proc fp
{-# INLINE vkGetProcUnsafe #-}
vkLookupProcUnsafe :: forall proc . VulkanProc proc => IO (Maybe (VkProcType proc))
vkLookupProcUnsafe = alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (vkProcSymbol @proc) errPtr
return $ if fp == nullFunPtr then Nothing else Just (unwrapVkProcPtrUnsafe @proc fp)
{-# INLINE vkLookupProcUnsafe #-}
vkGetInstanceProcSafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (VkProcType proc)
vkGetInstanceProcSafe i
= unwrapVkProcPtrSafe @proc
<$> c'vkGetInstanceProcAddrSafe i (vkProcSymbol @proc)
{-# INLINE vkGetInstanceProcSafe #-}
vkLookupInstanceProcSafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProcSafe i
= f <$> c'vkGetInstanceProcAddrSafe i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtrSafe @proc p)
{-# INLINE vkLookupInstanceProcSafe #-}
vkGetDeviceProcSafe :: forall proc . VulkanProc proc
=> VkDevice -> IO (VkProcType proc)
vkGetDeviceProcSafe i
= unwrapVkProcPtrSafe @proc
<$> c'vkGetDeviceProcAddrSafe i (vkProcSymbol @proc)
{-# INLINE vkGetDeviceProcSafe #-}
vkLookupDeviceProcSafe :: forall proc . VulkanProc proc
=> VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProcSafe i
= f <$> c'vkGetDeviceProcAddrSafe i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtrSafe @proc p)
{-# INLINE vkLookupDeviceProcSafe #-}
vkGetProcSafe :: forall proc . VulkanProc proc => IO (VkProcType proc)
vkGetProcSafe = alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (vkProcSymbol @proc) errPtr
when (fp == nullFunPtr) $ peek errPtr >>= peekCString >>= fail .
("An error happened while trying to load vulkan symbol dynamically: " ++)
return $ unwrapVkProcPtrSafe @proc fp
{-# INLINE vkGetProcSafe #-}
vkLookupProcSafe :: forall proc . VulkanProc proc => IO (Maybe (VkProcType proc))
vkLookupProcSafe = alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (vkProcSymbol @proc) errPtr
return $ if fp == nullFunPtr then Nothing else Just (unwrapVkProcPtrSafe @proc fp)
{-# INLINE vkLookupProcSafe #-}
vkGetInstanceProc :: forall proc . VulkanProc proc
=> VkInstance -> IO (VkProcType proc)
vkGetInstanceProc =
#ifdef UNSAFE_FFI_DEFAULT
vkGetInstanceProcUnsafe @proc
#else
vkGetInstanceProcSafe @proc
#endif
{-# INLINE vkGetInstanceProc #-}
vkLookupInstanceProc :: forall proc . VulkanProc proc
=> VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProc =
#ifdef UNSAFE_FFI_DEFAULT
vkLookupInstanceProcUnsafe @proc
#else
vkLookupInstanceProcSafe @proc
#endif
{-# INLINE vkLookupInstanceProc #-}
vkGetDeviceProc :: forall proc . VulkanProc proc
=> VkDevice -> IO (VkProcType proc)
vkGetDeviceProc =
#ifdef UNSAFE_FFI_DEFAULT
vkGetDeviceProcUnsafe @proc
#else
vkGetDeviceProcSafe @proc
#endif
{-# INLINE vkGetDeviceProc #-}
vkLookupDeviceProc :: forall proc . VulkanProc proc
=> VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProc =
#ifdef UNSAFE_FFI_DEFAULT
vkLookupDeviceProcUnsafe @proc
#else
vkLookupDeviceProcSafe @proc
#endif
{-# INLINE vkLookupDeviceProc #-}
vkGetProc :: forall proc . VulkanProc proc => IO (VkProcType proc)
vkGetProc =
#ifdef UNSAFE_FFI_DEFAULT
vkGetProcUnsafe @proc
#else
vkGetProcSafe @proc
#endif
{-# INLINE vkGetProc #-}
vkLookupProc :: forall proc . VulkanProc proc => IO (Maybe (VkProcType proc))
vkLookupProc =
#ifdef UNSAFE_FFI_DEFAULT
vkLookupProcUnsafe @proc
#else
vkLookupProcSafe @proc
#endif
{-# INLINE vkLookupProc #-}
#ifdef VK_NO_PROTOTYPES
c'vkGetInstanceProcAddrSafe :: VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddrSafe = c'vkGetInstanceProcAddr' unwrap'vkGetInstanceProcAddrSafe
c'vkGetInstanceProcAddrUnsafe :: VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddrUnsafe = c'vkGetInstanceProcAddr' unwrap'vkGetInstanceProcAddrUnsafe
c'vkGetDeviceProcAddrSafe :: VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddrSafe = c'vkGetDeviceProcAddr' unwrap'vkGetDeviceProcAddrSafe
c'vkGetDeviceProcAddrUnsafe :: VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddrUnsafe = c'vkGetDeviceProcAddr' unwrap'vkGetDeviceProcAddrUnsafe
c'vkGetInstanceProcAddr'
:: ( FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
)
-> VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr' k = unsafePerformIO $ alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (Ptr "vkGetInstanceProcAddr"#) errPtr
when (fp == nullFunPtr) $
peek errPtr >>= peekCString >>= fail .
("Could not load 'vkGetInstanceProcAddr' C function from vulkan library dynamically: " ++)
return $ k fp
c'vkGetDeviceProcAddr'
:: ( FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
)
-> VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr' k = unsafePerformIO $ alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (Ptr "vkGetDeviceProcAddr"#) errPtr
when (fp == nullFunPtr) $ peek errPtr >>= peekCString >>= fail .
("Could not load 'vkGetDeviceProcAddr' C function from vulkan library dynamically: " ++)
return $ k fp
foreign import ccall safe "dynamic"
unwrap'vkGetInstanceProcAddrSafe
:: FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
foreign import ccall safe "dynamic"
unwrap'vkGetDeviceProcAddrSafe
:: FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
foreign import ccall unsafe "dynamic"
unwrap'vkGetInstanceProcAddrUnsafe
:: FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
foreign import ccall unsafe "dynamic"
unwrap'vkGetDeviceProcAddrUnsafe
:: FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
#else
foreign import ccall safe "vkGetInstanceProcAddr"
c'vkGetInstanceProcAddrSafe :: VkInstance -> CString -> IO (FunPtr a)
foreign import ccall safe "vkGetDeviceProcAddr"
c'vkGetDeviceProcAddrSafe :: VkDevice -> CString -> IO (FunPtr a)
foreign import ccall unsafe "vkGetInstanceProcAddr"
c'vkGetInstanceProcAddrUnsafe :: VkInstance -> CString -> IO (FunPtr a)
foreign import ccall unsafe "vkGetDeviceProcAddr"
c'vkGetDeviceProcAddrUnsafe :: VkDevice -> CString -> IO (FunPtr a)
#endif
foreign import ccall safe "_vkdll_dlinit"
c'vkdll_dlinit :: Ptr CString -> IO (Ptr Void)
foreign import ccall safe "_vkdll_dlsym"
c'vkdll_dlsym :: Ptr Void -> CString -> Ptr CString -> IO (FunPtr a)
foreign import ccall safe "&_vkdll_dlclose"
p'vk_dlclose :: FunPtr (Ptr Void -> IO ())
_vkDlHandle :: ForeignPtr Void
_vkDlHandle = unsafePerformIO $ alloca $ \errPtr -> do
handle <- c'vkdll_dlinit errPtr
if handle == nullPtr
then
peek errPtr >>= peekCString >>= fail .
("An error happened while trying to load vulkan library dynamically: " ++)
else
newForeignPtr p'vk_dlclose handle
{-# NOINLINE _vkDlHandle #-}