{-# language CPP #-}
module Graphics.Vulkan.Core10.LayerDiscovery ( enumerateInstanceLayerProperties
, enumerateDeviceLayerProperties
, LayerProperties(..)
) where
import Graphics.Vulkan.CStruct.Utils (FixedArray)
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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
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 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(pVkEnumerateDeviceLayerProperties))
import Graphics.Vulkan.Core10.APIConstants (MAX_DESCRIPTION_SIZE)
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" mkVkEnumerateInstanceLayerProperties
:: FunPtr (Ptr Word32 -> Ptr LayerProperties -> IO Result) -> Ptr Word32 -> Ptr LayerProperties -> IO Result
enumerateInstanceLayerProperties :: forall io . MonadIO io => io (Result, ("properties" ::: Vector LayerProperties))
enumerateInstanceLayerProperties = liftIO . evalContT $ do
vkEnumerateInstanceLayerProperties' <- lift $ mkVkEnumerateInstanceLayerProperties . castFunPtr @_ @(("pPropertyCount" ::: Ptr Word32) -> ("pProperties" ::: Ptr LayerProperties) -> IO Result) <$> getInstanceProcAddr' nullPtr (Ptr "vkEnumerateInstanceLayerProperties"#)
pPPropertyCount <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ vkEnumerateInstanceLayerProperties' (pPPropertyCount) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPropertyCount <- lift $ peek @Word32 pPPropertyCount
pPProperties <- ContT $ bracket (callocBytes @LayerProperties ((fromIntegral (pPropertyCount)) * 520)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPProperties `advancePtrBytes` (i * 520) :: Ptr LayerProperties) . ($ ())) [0..(fromIntegral (pPropertyCount)) - 1]
r' <- lift $ vkEnumerateInstanceLayerProperties' (pPPropertyCount) ((pPProperties))
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pPropertyCount' <- lift $ peek @Word32 pPPropertyCount
pProperties' <- lift $ generateM (fromIntegral (pPropertyCount')) (\i -> peekCStruct @LayerProperties (((pPProperties) `advancePtrBytes` (520 * (i)) :: Ptr LayerProperties)))
pure $ ((r'), pProperties')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkEnumerateDeviceLayerProperties
:: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr LayerProperties -> IO Result) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr LayerProperties -> IO Result
enumerateDeviceLayerProperties :: forall io . MonadIO io => PhysicalDevice -> io (Result, ("properties" ::: Vector LayerProperties))
enumerateDeviceLayerProperties physicalDevice = liftIO . evalContT $ do
let vkEnumerateDeviceLayerProperties' = mkVkEnumerateDeviceLayerProperties (pVkEnumerateDeviceLayerProperties (instanceCmds (physicalDevice :: PhysicalDevice)))
let physicalDevice' = physicalDeviceHandle (physicalDevice)
pPPropertyCount <- ContT $ bracket (callocBytes @Word32 4) free
r <- lift $ vkEnumerateDeviceLayerProperties' physicalDevice' (pPPropertyCount) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pPropertyCount <- lift $ peek @Word32 pPPropertyCount
pPProperties <- ContT $ bracket (callocBytes @LayerProperties ((fromIntegral (pPropertyCount)) * 520)) free
_ <- traverse (\i -> ContT $ pokeZeroCStruct (pPProperties `advancePtrBytes` (i * 520) :: Ptr LayerProperties) . ($ ())) [0..(fromIntegral (pPropertyCount)) - 1]
r' <- lift $ vkEnumerateDeviceLayerProperties' physicalDevice' (pPPropertyCount) ((pPProperties))
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pPropertyCount' <- lift $ peek @Word32 pPPropertyCount
pProperties' <- lift $ generateM (fromIntegral (pPropertyCount')) (\i -> peekCStruct @LayerProperties (((pPProperties) `advancePtrBytes` (520 * (i)) :: Ptr LayerProperties)))
pure $ ((r'), pProperties')
data LayerProperties = LayerProperties
{
layerName :: ByteString
,
specVersion :: Word32
,
implementationVersion :: Word32
,
description :: ByteString
}
deriving (Typeable)
deriving instance Show LayerProperties
instance ToCStruct LayerProperties where
withCStruct x f = allocaBytesAligned 520 4 $ \p -> pokeCStruct p x (f p)
pokeCStruct p LayerProperties{..} f = do
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (layerName)
poke ((p `plusPtr` 256 :: Ptr Word32)) (specVersion)
poke ((p `plusPtr` 260 :: Ptr Word32)) (implementationVersion)
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (description)
f
cStructSize = 520
cStructAlignment = 4
pokeZeroCStruct p f = do
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))) (mempty)
poke ((p `plusPtr` 256 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 260 :: Ptr Word32)) (zero)
pokeFixedLengthNullTerminatedByteString ((p `plusPtr` 264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))) (mempty)
f
instance FromCStruct LayerProperties where
peekCStruct p = do
layerName <- packCString (lowerArrayPtr ((p `plusPtr` 0 :: Ptr (FixedArray MAX_EXTENSION_NAME_SIZE CChar))))
specVersion <- peek @Word32 ((p `plusPtr` 256 :: Ptr Word32))
implementationVersion <- peek @Word32 ((p `plusPtr` 260 :: Ptr Word32))
description <- packCString (lowerArrayPtr ((p `plusPtr` 264 :: Ptr (FixedArray MAX_DESCRIPTION_SIZE CChar))))
pure $ LayerProperties
layerName specVersion implementationVersion description
instance Storable LayerProperties where
sizeOf ~_ = 520
alignment ~_ = 4
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero LayerProperties where
zero = LayerProperties
mempty
zero
zero
mempty