{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Vulkan.Marshal.Proc
( VulkanProc (..)
, vkGetInstanceProc, vkGetInstanceProcSafe
, vkLookupInstanceProc, vkLookupInstanceProcSafe
, vkGetDeviceProc, vkGetDeviceProcSafe
, vkLookupDeviceProc, vkLookupDeviceProcSafe
, vkGetProc, vkGetProcSafe
, vkLookupProc, 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
unwrapVkProcPtr :: FunPtr (VkProcType proc) -> VkProcType proc
unwrapVkProcPtrSafe :: FunPtr (VkProcType proc) -> VkProcType proc
vkGetInstanceProc :: forall proc . VulkanProc proc
=> VkInstance -> IO (VkProcType proc)
vkGetInstanceProc i
= unwrapVkProcPtr @proc
<$> c'vkGetInstanceProcAddr i (vkProcSymbol @proc)
{-# INLINE vkGetInstanceProc #-}
vkLookupInstanceProc :: forall proc . VulkanProc proc
=> VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProc i
= f <$> c'vkGetInstanceProcAddr i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtr @proc p)
{-# INLINE vkLookupInstanceProc #-}
vkGetDeviceProc :: forall proc . VulkanProc proc
=> VkDevice -> IO (VkProcType proc)
vkGetDeviceProc i
= unwrapVkProcPtr @proc
<$> c'vkGetDeviceProcAddr i (vkProcSymbol @proc)
{-# INLINE vkGetDeviceProc #-}
vkLookupDeviceProc :: forall proc . VulkanProc proc
=> VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProc i
= f <$> c'vkGetDeviceProcAddr i (vkProcSymbol @proc)
where
f p = if p == nullFunPtr then Nothing else Just (unwrapVkProcPtr @proc p)
{-# INLINE vkLookupDeviceProc #-}
vkGetProc :: forall proc . VulkanProc proc => IO (VkProcType proc)
vkGetProc = 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 $ unwrapVkProcPtr @proc fp
{-# INLINE vkGetProc #-}
vkLookupProc :: forall proc . VulkanProc proc => IO (Maybe (VkProcType proc))
vkLookupProc = alloca $ \errPtr -> do
fp <- withForeignPtr _vkDlHandle $ \h ->
c'vkdll_dlsym h (vkProcSymbol @proc) errPtr
return $ if fp == nullFunPtr then Nothing else Just (unwrapVkProcPtr @proc fp)
{-# INLINE vkLookupProc #-}
vkGetInstanceProcSafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (VkProcType proc)
vkGetInstanceProcSafe i
= unwrapVkProcPtrSafe @proc
<$> c'vkGetInstanceProcAddr i (vkProcSymbol @proc)
{-# INLINE vkGetInstanceProcSafe #-}
vkLookupInstanceProcSafe :: forall proc . VulkanProc proc
=> VkInstance -> IO (Maybe (VkProcType proc))
vkLookupInstanceProcSafe i
= f <$> c'vkGetInstanceProcAddr 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'vkGetDeviceProcAddr i (vkProcSymbol @proc)
{-# INLINE vkGetDeviceProcSafe #-}
vkLookupDeviceProcSafe :: forall proc . VulkanProc proc
=> VkDevice -> IO (Maybe (VkProcType proc))
vkLookupDeviceProcSafe i
= f <$> c'vkGetDeviceProcAddr 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 #-}
#ifdef VK_NO_PROTOTYPES
c'vkGetInstanceProcAddr :: VkInstance -> CString -> IO (FunPtr a)
c'vkGetInstanceProcAddr = 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 $ unwrap'vkGetInstanceProcAddr fp
c'vkGetDeviceProcAddr :: VkDevice -> CString -> IO (FunPtr a)
c'vkGetDeviceProcAddr = 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 $ unwrap'vkGetDeviceProcAddr fp
foreign import ccall unsafe "dynamic"
unwrap'vkGetInstanceProcAddr
:: FunPtr (VkInstance -> CString -> IO (FunPtr a))
-> VkInstance -> CString -> IO (FunPtr a)
foreign import ccall unsafe "dynamic"
unwrap'vkGetDeviceProcAddr
:: FunPtr (VkDevice -> CString -> IO (FunPtr a))
-> VkDevice -> CString -> IO (FunPtr a)
#else
foreign import ccall unsafe "vkGetInstanceProcAddr"
c'vkGetInstanceProcAddr :: VkInstance -> CString -> IO (FunPtr a)
foreign import ccall unsafe "vkGetDeviceProcAddr"
c'vkGetDeviceProcAddr :: 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 #-}