{-# language CPP #-}
module Vulkan.Core10.Shader ( createShaderModule
, withShaderModule
, destroyShaderModule
, ShaderModuleCreateInfo(..)
, ShaderModule(..)
, ShaderModuleCreateFlags(..)
) where
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bits ((.&.))
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (ptrToWordPtr)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import qualified Data.ByteString (length)
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word64)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCreateShaderModule))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyShaderModule))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Handles (ShaderModule)
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlags (ShaderModuleCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_cache (ShaderModuleValidationCacheCreateInfoEXT)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Handles (ShaderModule(..))
import Vulkan.Core10.Enums.ShaderModuleCreateFlags (ShaderModuleCreateFlags(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateShaderModule
:: FunPtr (Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct ShaderModuleCreateInfo) -> Ptr AllocationCallbacks -> Ptr ShaderModule -> IO Result
createShaderModule :: forall a io
. ( Extendss ShaderModuleCreateInfo a
, PokeChain a
, MonadIO io )
=>
Device
->
(ShaderModuleCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (ShaderModule)
createShaderModule :: forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkCreateShaderModulePtr :: FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
pVkCreateShaderModule (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr 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 vkCreateShaderModule is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateShaderModule' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule' = FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
mkVkCreateShaderModule FunPtr
(Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result)
vkCreateShaderModulePtr
Ptr (ShaderModuleCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ShaderModuleCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pShaderModule" ::: Ptr ShaderModule
pPShaderModule <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @ShaderModule Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateShaderModule" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ShaderModuleCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pShaderModule" ::: Ptr ShaderModule)
-> IO Result
vkCreateShaderModule'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ShaderModuleCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pShaderModule" ::: Ptr ShaderModule
pPShaderModule))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
ShaderModule
pShaderModule <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @ShaderModule "pShaderModule" ::: Ptr ShaderModule
pPShaderModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ShaderModule
pShaderModule)
withShaderModule :: forall a io r . (Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) => Device -> ShaderModuleCreateInfo a -> Maybe AllocationCallbacks -> (io ShaderModule -> (ShaderModule -> io ()) -> r) -> r
withShaderModule :: forall (a :: [*]) (io :: * -> *) r.
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io ShaderModule -> (ShaderModule -> io ()) -> r)
-> r
withShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io ShaderModule -> (ShaderModule -> io ()) -> r
b =
io ShaderModule -> (ShaderModule -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss ShaderModuleCreateInfo a, PokeChain a, MonadIO io) =>
Device
-> ShaderModuleCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ShaderModule
createShaderModule Device
device ShaderModuleCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(ShaderModule
o0) -> forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyShaderModule
:: FunPtr (Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> ShaderModule -> Ptr AllocationCallbacks -> IO ()
destroyShaderModule :: forall io
. (MonadIO io)
=>
Device
->
ShaderModule
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule :: forall (io :: * -> *).
MonadIO io =>
Device
-> ShaderModule
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyShaderModule Device
device ShaderModule
shaderModule "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroyShaderModulePtr :: FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
pVkDestroyShaderModule (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr 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 vkDestroyShaderModule is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyShaderModule' :: Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyShaderModule' = FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
-> Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyShaderModule FunPtr
(Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ())
vkDestroyShaderModulePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyShaderModule" (Ptr Device_T
-> ShaderModule
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyShaderModule'
(Device -> Ptr Device_T
deviceHandle (Device
device))
(ShaderModule
shaderModule)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
data ShaderModuleCreateInfo (es :: [Type]) = ShaderModuleCreateInfo
{
forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
flags :: ShaderModuleCreateFlags
,
forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
code :: ByteString
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ShaderModuleCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ShaderModuleCreateInfo es)
instance Extensible ShaderModuleCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"ShaderModuleCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
ShaderModuleCreateInfo ds -> Chain es -> ShaderModuleCreateInfo es
setNext ShaderModuleCreateInfo{ByteString
Chain ds
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain ds
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} Chain es
next' = ShaderModuleCreateInfo{$sel:next:ShaderModuleCreateInfo :: Chain es
next = Chain es
next', ByteString
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
$sel:code:ShaderModuleCreateInfo :: ByteString
$sel:flags:ShaderModuleCreateInfo :: ShaderModuleCreateFlags
..}
getNext :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
getNext ShaderModuleCreateInfo{ByteString
Chain es
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain es
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends ShaderModuleCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends ShaderModuleCreateInfo e => b
f
| Just e :~: ShaderModuleValidationCacheCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ShaderModuleValidationCacheCreateInfoEXT = forall a. a -> Maybe a
Just Extends ShaderModuleCreateInfo e => b
f
| Bool
otherwise = forall a. Maybe a
Nothing
instance ( Extendss ShaderModuleCreateInfo es
, PokeChain es ) => ToCStruct (ShaderModuleCreateInfo es) where
withCStruct :: forall b.
ShaderModuleCreateInfo es
-> (Ptr (ShaderModuleCreateInfo es) -> IO b) -> IO b
withCStruct ShaderModuleCreateInfo es
x Ptr (ShaderModuleCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr (ShaderModuleCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo es
x (Ptr (ShaderModuleCreateInfo es) -> IO b
f Ptr (ShaderModuleCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (ShaderModuleCreateInfo es)
-> ShaderModuleCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (ShaderModuleCreateInfo es)
p ShaderModuleCreateInfo{ByteString
Chain es
ShaderModuleCreateFlags
code :: ByteString
flags :: ShaderModuleCreateFlags
next :: Chain es
$sel:code:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> ByteString
$sel:flags:ShaderModuleCreateInfo :: forall (es :: [*]).
ShaderModuleCreateInfo es -> ShaderModuleCreateFlags
$sel:next:ShaderModuleCreateInfo :: forall (es :: [*]). ShaderModuleCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderModuleCreateFlags)) (ShaderModuleCreateFlags
flags)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Data.ByteString.length (ByteString
code))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
Data.ByteString.length (ByteString
code) forall a. Bits a => a -> a -> a
.&. Int
3 forall a. Eq a => a -> a -> Bool
== Int
0) 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
"code size must be a multiple of 4" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
CString
unalignedCode <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString (ByteString
code)
Ptr Word32
pCode'' <- if forall a. Ptr a -> WordPtr
ptrToWordPtr CString
unalignedCode forall a. Bits a => a -> a -> a
.&. WordPtr
3 forall a. Eq a => a -> a -> Bool
== WordPtr
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode
else do
let len :: Int
len = ByteString -> Int
Data.ByteString.length (ByteString
code)
Ptr Word32
mem <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 Int
len
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word32
mem (forall a b. Ptr a -> Ptr b
castPtr @CChar @Word32 CString
unalignedCode) Int
len
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Word32
mem
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32))) Ptr Word32
pCode''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
40
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (ShaderModuleCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (ShaderModuleCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO)
Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance ( Extendss ShaderModuleCreateInfo es
, PeekChain es ) => FromCStruct (ShaderModuleCreateInfo es) where
peekCStruct :: Ptr (ShaderModuleCreateInfo es) -> IO (ShaderModuleCreateInfo es)
peekCStruct Ptr (ShaderModuleCreateInfo es)
p = do
Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
ShaderModuleCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @ShaderModuleCreateFlags ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ShaderModuleCreateFlags))
CSize
codeSize <- forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr CSize))
Ptr Word32
pCode <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (ShaderModuleCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Word32)))
ByteString
code <- CStringLen -> IO ByteString
packCStringLen ( forall a b. Ptr a -> Ptr b
castPtr @Word32 @CChar Ptr Word32
pCode
, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
codeSize) forall a. Num a => a -> a -> a
* Word64
4 )
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
Chain es
next ShaderModuleCreateFlags
flags ByteString
code
instance es ~ '[] => Zero (ShaderModuleCreateInfo es) where
zero :: ShaderModuleCreateInfo es
zero = forall (es :: [*]).
Chain es
-> ShaderModuleCreateFlags
-> ByteString
-> ShaderModuleCreateInfo es
ShaderModuleCreateInfo
()
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty