{-# language CPP #-}
module Graphics.Vulkan.Core10.ExtensionDiscovery ( enumerateInstanceExtensionProperties
, enumerateDeviceExtensionProperties
, ExtensionProperties(..)
) where
import Control.Exception.Base (bracket)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import Foreign.Ptr (castFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import Foreign.C.Types (CChar(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Ptr (Ptr(Ptr))
import Data.Word (Word32)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import qualified Data.Vector.Storable.Sized (Vector)
import Graphics.Vulkan.CStruct.Utils (advancePtrBytes)
import Graphics.Vulkan.Dynamic (getInstanceProcAddr')
import Graphics.Vulkan.CStruct.Utils (lowerArrayPtr)
import Graphics.Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Graphics.Vulkan.NamedType ((:::))
import Graphics.Vulkan.CStruct (FromCStruct)
import Graphics.Vulkan.CStruct (FromCStruct(..))
import Graphics.Vulkan.Dynamic (InstanceCmds(pVkEnumerateDeviceExtensionProperties))
import Graphics.Vulkan.Core10.APIConstants (MAX_EXTENSION_NAME_SIZE)
import Graphics.Vulkan.Core10.Handles (PhysicalDevice)
import Graphics.Vulkan.Core10.Handles (PhysicalDevice(..))
import Graphics.Vulkan.Core10.Handles (PhysicalDevice_T)
import Graphics.Vulkan.Core10.Enums.Result (Result)
import Graphics.Vulkan.Core10.Enums.Result (Result(..))
import Graphics.Vulkan.CStruct (ToCStruct)
import Graphics.Vulkan.CStruct (ToCStruct(..))
import Graphics.Vulkan.Exception (VulkanException(..))
import Graphics.Vulkan.Zero (Zero(..))
import Graphics.Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkEnumerateInstanceExtensionProperties
:: FunPtr (Ptr CChar -> Ptr Word32 -> Ptr ExtensionProperties -> IO Result) -> Ptr CChar -> Ptr Word32 -> Ptr ExtensionProperties -> IO Result
enumerateInstanceExtensionProperties :: forall io . MonadIO io => ("layerName" ::: Maybe ByteString) -> io (Result, ("properties" ::: Vector ExtensionProperties))
enumerateInstanceExtensionProperties layerName = liftIO . evalContT $ do
vkEnumerateInstanceExtensionProperties' <- lift $ mkVkEnumerateInstanceExtensionProperties . castFunPtr @_ @(("pLayerName" ::: Ptr CChar) -> ("pPropertyCount" ::: Ptr Word32) -> ("pProperties" ::: Ptr ExtensionProperties) -> IO Result) <$> getInstanceProcAddr' nullPtr (Ptr "vkEnumerateInstanceExtensionProperties"#)
pLayerName <- case (layerName) of
Nothing -> pure nullPtr
Just j -> ContT $ useAsCString (j)
pPPropertyCount <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ vkEnumerateInstanceExtensionProperties' pLayerName (pPPropertyCount) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPropertyCount <- lift $ peek @Word32 pPPropertyCount
pPProperties <- ContT $ bracket (callocBytes @ExtensionProperties ((fromIntegral (pPropertyCount)) * 260)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPProperties `advancePtrBytes` (i * 260) :: Ptr ExtensionProperties) . ($ ())) [0..(fromIntegral (pPropertyCount)) - 1]
r' <- lift $ vkEnumerateInstanceExtensionProperties' pLayerName (pPPropertyCount) ((pPProperties))
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pPropertyCount' <- lift $ peek @Word32 pPPropertyCount
pProperties' <- lift $ generateM (fromIntegral (pPropertyCount')) (\i -> peekCStruct @ExtensionProperties (((pPProperties) `advancePtrBytes` (260 * (i)) :: Ptr ExtensionProperties)))
pure $ ((r'), pProperties')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkEnumerateDeviceExtensionProperties
:: FunPtr (Ptr PhysicalDevice_T -> Ptr CChar -> Ptr Word32 -> Ptr ExtensionProperties -> IO Result) -> Ptr PhysicalDevice_T -> Ptr CChar -> Ptr Word32 -> Ptr ExtensionProperties -> IO Result
enumerateDeviceExtensionProperties :: forall io . MonadIO io => PhysicalDevice -> ("layerName" ::: Maybe ByteString) -> io (Result, ("properties" ::: Vector ExtensionProperties))
enumerateDeviceExtensionProperties physicalDevice layerName = liftIO . evalContT $ do
let vkEnumerateDeviceExtensionProperties' = mkVkEnumerateDeviceExtensionProperties (pVkEnumerateDeviceExtensionProperties (instanceCmds (physicalDevice :: PhysicalDevice)))
let physicalDevice' = physicalDeviceHandle (physicalDevice)
pLayerName <- case (layerName) of
Nothing -> pure nullPtr
Just j -> ContT $ useAsCString (j)
pPPropertyCount <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ vkEnumerateDeviceExtensionProperties' physicalDevice' pLayerName (pPPropertyCount) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPropertyCount <- lift $ peek @Word32 pPPropertyCount
pPProperties <- ContT $ bracket (callocBytes @ExtensionProperties ((fromIntegral (pPropertyCount)) * 260)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPProperties `advancePtrBytes` (i * 260) :: Ptr ExtensionProperties) . ($ ())) [0..(fromIntegral (pPropertyCount)) - 1]
r' <- lift $ vkEnumerateDeviceExtensionProperties' physicalDevice' pLayerName (pPPropertyCount) ((pPProperties))
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pPropertyCount' <- lift $ peek @Word32 pPPropertyCount
pProperties' <- lift $ generateM (fromIntegral (pPropertyCount')) (\i -> peekCStruct @ExtensionProperties (((pPProperties) `advancePtrBytes` (260 * (i)) :: Ptr ExtensionProperties)))
pure $ ((r'), pProperties')
data ExtensionProperties = ExtensionProperties
{
extensionName :: ByteString
,
specVersion :: Word32
}
deriving (Typeable)
deriving instance Show ExtensionProperties
instance ToCStruct ExtensionProperties where
withCStruct x f = allocaBytesAligned 260 4 $ \p -> pokeCStruct p x (f p)
pokeCStruct p ExtensionProperties{..} f = do
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 0 :: Ptr (Data.Vector.Storable.Sized.Vector MAX_EXTENSION_NAME_SIZE CChar))) (extensionName)
poke ((p `plusPtr` 256 :: Ptr Word32)) (specVersion)
f
cStructSize = 260
cStructAlignment = 4
pokeZeroCStruct p f = do
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 0 :: Ptr (Data.Vector.Storable.Sized.Vector MAX_EXTENSION_NAME_SIZE CChar))) (mempty)
poke ((p `plusPtr` 256 :: Ptr Word32)) (zero)
f
instance FromCStruct ExtensionProperties where
peekCStruct p = do
extensionName <- packCString (lowerArrayPtr ((p `plusPtr` 0 :: Ptr (Data.Vector.Storable.Sized.Vector MAX_EXTENSION_NAME_SIZE CChar))))
specVersion <- peek @Word32 ((p `plusPtr` 256 :: Ptr Word32))
pure $ ExtensionProperties
extensionName specVersion
instance Storable ExtensionProperties where
sizeOf ~_ = 260
alignment ~_ = 4
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero ExtensionProperties where
zero = ExtensionProperties
mempty
zero