{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_pageable_device_local_memory ( setDeviceMemoryPriorityEXT
, PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT(..)
, EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION
, pattern EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION
, EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME
, pattern EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Foreign.C.Types (CFloat(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkSetDeviceMemoryPriorityEXT))
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.Handles (DeviceMemory(..))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PAGEABLE_DEVICE_LOCAL_MEMORY_FEATURES_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkSetDeviceMemoryPriorityEXT
:: FunPtr (Ptr Device_T -> DeviceMemory -> CFloat -> IO ()) -> Ptr Device_T -> DeviceMemory -> CFloat -> IO ()
setDeviceMemoryPriorityEXT :: forall io
. (MonadIO io)
=>
Device
->
DeviceMemory
->
("priority" ::: Float)
-> io ()
setDeviceMemoryPriorityEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> DeviceMemory -> ("priority" ::: Float) -> io ()
setDeviceMemoryPriorityEXT Device
device DeviceMemory
memory "priority" ::: Float
priority = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let vkSetDeviceMemoryPriorityEXTPtr :: FunPtr
(Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ())
vkSetDeviceMemoryPriorityEXTPtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ())
pVkSetDeviceMemoryPriorityEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ())
vkSetDeviceMemoryPriorityEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkSetDeviceMemoryPriorityEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkSetDeviceMemoryPriorityEXT' :: Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ()
vkSetDeviceMemoryPriorityEXT' = FunPtr
(Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ())
-> Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ()
mkVkSetDeviceMemoryPriorityEXT FunPtr
(Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ())
vkSetDeviceMemoryPriorityEXTPtr
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkSetDeviceMemoryPriorityEXT" (Ptr Device_T -> DeviceMemory -> ("priority" ::: CFloat) -> IO ()
vkSetDeviceMemoryPriorityEXT'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(DeviceMemory
memory)
(("priority" ::: Float) -> "priority" ::: CFloat
CFloat ("priority" ::: Float
priority)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
data PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT = PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
{
PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
pageableDeviceLocalMemory :: Bool }
deriving (Typeable, PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
$c/= :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
== :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
$c== :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT)
#endif
deriving instance Show PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
instance ToCStruct PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT where
withCStruct :: forall b.
PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> (Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> IO b)
-> IO b
withCStruct PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
x Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
x (Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> IO b
f Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT{Bool
pageableDeviceLocalMemory :: Bool
$sel:pageableDeviceLocalMemory:PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PAGEABLE_DEVICE_LOCAL_MEMORY_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
pageableDeviceLocalMemory))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PAGEABLE_DEVICE_LOCAL_MEMORY_FEATURES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT where
peekCStruct :: Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> IO PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
peekCStruct Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p = do
Bool32
pageableDeviceLocalMemory <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
(Bool32 -> Bool
bool32ToBool Bool32
pageableDeviceLocalMemory)
instance Storable PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT where
sizeOf :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Int
sizeOf ~PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
_ = Int
24
alignment :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> Int
alignment ~PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
_ = Int
8
peek :: Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> IO PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
-> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT -> IO ()
poke Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
ptr PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT where
zero :: PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
zero = Bool -> PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
PhysicalDevicePageableDeviceLocalMemoryFeaturesEXT
forall a. Zero a => a
zero
type EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION = 1
pattern EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION :: forall a. Integral a => a
$mEXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_SPEC_VERSION = 1
type EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME = "VK_EXT_pageable_device_local_memory"
pattern EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_PAGEABLE_DEVICE_LOCAL_MEMORY_EXTENSION_NAME = "VK_EXT_pageable_device_local_memory"