{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
module Graphics.Vulkan.Marshal
( FlagType (..), FlagMask, FlagBit
, bitToMask, maskToBits
, VulkanMarshal (..)
, newVkData, mallocVkData, mallocVkDataArray, unsafePtr
, fromForeignPtr, toForeignPtr, toPlainForeignPtr, touchVkData
, VulkanPtr (..)
, VkPtr (..)
, pattern VK_ZERO_FLAGS
, pattern VK_NULL_HANDLE, pattern VK_NULL
, clearStorable, withPtr
, StructFields, CUnionType, ReturnedOnly, StructExtends
, StructFieldNames, HasField, FieldRep, FieldType
, FieldOptional, FieldOffset
, FieldIsArray, FieldArrayLength
, CanReadField, CanWriteField
, CanReadFieldArray, CanWriteFieldArray
, fieldOptional, fieldOffset, fieldArrayLength
, getField, readField, writeField
, getFieldArrayUnsafe, readFieldArrayUnsafe, writeFieldArrayUnsafe
, getFieldArray, readFieldArray, writeFieldArray
, IndexInBounds
, VulkanStruct (..), VulkanField (..), VulkanFields (..), KnownBool (..)
, FieldMeta (..), StructMeta (..)
, mallocForeignPtr, withForeignPtr, addForeignPtrFinalizer
, Int8, Int16, Int32, Int64
, Word8, Word16, Word32, Word64
, Ptr, FunPtr, Void, CString
, CInt (..), CSize (..), CChar (..), CWchar (..), CULong (..)
, withCStringField, unsafeCStringField
, getStringField, readStringField, writeStringField
, cmpCStrings, cmpCStringsN
) where
import Data.Bits (Bits (..))
import Data.Coerce
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Void (Void)
import Data.Word (Word16, Word32, Word64, Word8)
import Foreign.C.String (CString)
import Foreign.C.Types (CChar (..), CInt (..), CSize (..), CULong (..),
CWchar (..))
import Foreign.ForeignPtr (addForeignPtrFinalizer, mallocForeignPtr,
withForeignPtr)
import Foreign.Marshal.Utils (fillBytes)
import Foreign.Ptr (FunPtr, nullPtr)
import Foreign.Storable
import GHC.Ptr (Ptr (..))
import Graphics.Vulkan.Marshal.Internal
data FlagType = FlagMask | FlagBit
type FlagMask = 'FlagMask
type FlagBit = 'FlagBit
pattern VK_ZERO_FLAGS :: Bits a => a
pattern $bVK_ZERO_FLAGS :: forall a. Bits a => a
$mVK_ZERO_FLAGS :: forall {r} {a}. Bits a => a -> (Void# -> r) -> (Void# -> r) -> r
VK_ZERO_FLAGS <- (popCount -> 0)
where
VK_ZERO_FLAGS = a
forall a. Bits a => a
zeroBits
bitToMask :: Coercible (x FlagBit) (x FlagMask) => x FlagBit -> x FlagMask
bitToMask :: forall (x :: FlagType -> *).
Coercible (x FlagBit) (x FlagMask) =>
x FlagBit -> x FlagMask
bitToMask = x FlagBit -> x FlagMask
coerce
maskToBits :: (Bits (x FlagMask), Coercible (x FlagBit) (x FlagMask))
=> x FlagMask -> [x FlagBit]
maskToBits :: forall (x :: FlagType -> *).
(Bits (x FlagMask), Coercible (x FlagBit) (x FlagMask)) =>
x FlagMask -> [x FlagBit]
maskToBits x FlagMask
x = Int -> x FlagMask -> [x FlagBit]
go (x FlagMask -> Int
forall a. Bits a => a -> Int
popCount x FlagMask
x) (Int -> x FlagMask
forall a. Bits a => Int -> a
bit Int
0)
where
zero :: x FlagMask
zero = x FlagMask
forall a. Bits a => a
zeroBits
go :: Int -> x FlagMask -> [x FlagBit]
go Int
0 x FlagMask
_ = []
go Int
n x FlagMask
i = let b :: x FlagMask
b = x FlagMask
i x FlagMask -> x FlagMask -> x FlagMask
forall a. Bits a => a -> a -> a
.&. x FlagMask
x
i' :: x FlagMask
i' = x FlagMask -> Int -> x FlagMask
forall a. Bits a => a -> Int -> a
unsafeShiftL x FlagMask
i Int
1
in if x FlagMask
b x FlagMask -> x FlagMask -> Bool
forall a. Eq a => a -> a -> Bool
== x FlagMask
zero
then Int -> x FlagMask -> [x FlagBit]
go Int
n x FlagMask
i'
else x FlagMask -> x FlagBit
coerce x FlagMask
b x FlagBit -> [x FlagBit] -> [x FlagBit]
forall a. a -> [a] -> [a]
: Int -> x FlagMask -> [x FlagBit]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) x FlagMask
i'
newtype VkPtr a = VkPtr Word64
deriving (VkPtr a -> VkPtr a -> Bool
(VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool) -> Eq (VkPtr a)
forall a. VkPtr a -> VkPtr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkPtr a -> VkPtr a -> Bool
$c/= :: forall a. VkPtr a -> VkPtr a -> Bool
== :: VkPtr a -> VkPtr a -> Bool
$c== :: forall a. VkPtr a -> VkPtr a -> Bool
Eq, Eq (VkPtr a)
Eq (VkPtr a)
-> (VkPtr a -> VkPtr a -> Ordering)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> Bool)
-> (VkPtr a -> VkPtr a -> VkPtr a)
-> (VkPtr a -> VkPtr a -> VkPtr a)
-> Ord (VkPtr a)
VkPtr a -> VkPtr a -> Bool
VkPtr a -> VkPtr a -> Ordering
VkPtr a -> VkPtr a -> VkPtr a
forall a. Eq (VkPtr a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. VkPtr a -> VkPtr a -> Bool
forall a. VkPtr a -> VkPtr a -> Ordering
forall a. VkPtr a -> VkPtr a -> VkPtr a
min :: VkPtr a -> VkPtr a -> VkPtr a
$cmin :: forall a. VkPtr a -> VkPtr a -> VkPtr a
max :: VkPtr a -> VkPtr a -> VkPtr a
$cmax :: forall a. VkPtr a -> VkPtr a -> VkPtr a
>= :: VkPtr a -> VkPtr a -> Bool
$c>= :: forall a. VkPtr a -> VkPtr a -> Bool
> :: VkPtr a -> VkPtr a -> Bool
$c> :: forall a. VkPtr a -> VkPtr a -> Bool
<= :: VkPtr a -> VkPtr a -> Bool
$c<= :: forall a. VkPtr a -> VkPtr a -> Bool
< :: VkPtr a -> VkPtr a -> Bool
$c< :: forall a. VkPtr a -> VkPtr a -> Bool
compare :: VkPtr a -> VkPtr a -> Ordering
$ccompare :: forall a. VkPtr a -> VkPtr a -> Ordering
Ord, Int -> VkPtr a -> ShowS
[VkPtr a] -> ShowS
VkPtr a -> String
(Int -> VkPtr a -> ShowS)
-> (VkPtr a -> String) -> ([VkPtr a] -> ShowS) -> Show (VkPtr a)
forall a. Int -> VkPtr a -> ShowS
forall a. [VkPtr a] -> ShowS
forall a. VkPtr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VkPtr a] -> ShowS
$cshowList :: forall a. [VkPtr a] -> ShowS
show :: VkPtr a -> String
$cshow :: forall a. VkPtr a -> String
showsPrec :: Int -> VkPtr a -> ShowS
$cshowsPrec :: forall a. Int -> VkPtr a -> ShowS
Show, Ptr (VkPtr a) -> IO (VkPtr a)
Ptr (VkPtr a) -> Int -> IO (VkPtr a)
Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
Ptr (VkPtr a) -> VkPtr a -> IO ()
VkPtr a -> Int
(VkPtr a -> Int)
-> (VkPtr a -> Int)
-> (Ptr (VkPtr a) -> Int -> IO (VkPtr a))
-> (Ptr (VkPtr a) -> Int -> VkPtr a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkPtr a))
-> (forall b. Ptr b -> Int -> VkPtr a -> IO ())
-> (Ptr (VkPtr a) -> IO (VkPtr a))
-> (Ptr (VkPtr a) -> VkPtr a -> IO ())
-> Storable (VkPtr a)
forall b. Ptr b -> Int -> IO (VkPtr a)
forall b. Ptr b -> Int -> VkPtr a -> IO ()
forall a. Ptr (VkPtr a) -> IO (VkPtr a)
forall a. Ptr (VkPtr a) -> Int -> IO (VkPtr a)
forall a. Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
forall a. Ptr (VkPtr a) -> VkPtr a -> IO ()
forall a. VkPtr a -> Int
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a b. Ptr b -> Int -> IO (VkPtr a)
forall a b. Ptr b -> Int -> VkPtr a -> IO ()
poke :: Ptr (VkPtr a) -> VkPtr a -> IO ()
$cpoke :: forall a. Ptr (VkPtr a) -> VkPtr a -> IO ()
peek :: Ptr (VkPtr a) -> IO (VkPtr a)
$cpeek :: forall a. Ptr (VkPtr a) -> IO (VkPtr a)
pokeByteOff :: forall b. Ptr b -> Int -> VkPtr a -> IO ()
$cpokeByteOff :: forall a b. Ptr b -> Int -> VkPtr a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkPtr a)
$cpeekByteOff :: forall a b. Ptr b -> Int -> IO (VkPtr a)
pokeElemOff :: Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
$cpokeElemOff :: forall a. Ptr (VkPtr a) -> Int -> VkPtr a -> IO ()
peekElemOff :: Ptr (VkPtr a) -> Int -> IO (VkPtr a)
$cpeekElemOff :: forall a. Ptr (VkPtr a) -> Int -> IO (VkPtr a)
alignment :: VkPtr a -> Int
$calignment :: forall a. VkPtr a -> Int
sizeOf :: VkPtr a -> Int
$csizeOf :: forall a. VkPtr a -> Int
Storable)
type role VkPtr phantom
class VulkanPtr ptr where
vkNullPtr :: ptr a
instance VulkanPtr Ptr where
vkNullPtr :: forall a. Ptr a
vkNullPtr = Ptr a
forall a. Ptr a
nullPtr
{-# INLINE vkNullPtr #-}
instance VulkanPtr VkPtr where
vkNullPtr :: forall a. VkPtr a
vkNullPtr = Word64 -> VkPtr a
forall a. Word64 -> VkPtr a
VkPtr Word64
0
{-# INLINE vkNullPtr #-}
isNullPtr :: (Eq (ptr a), VulkanPtr ptr) => ptr a -> Bool
isNullPtr :: forall (ptr :: * -> *) a.
(Eq (ptr a), VulkanPtr ptr) =>
ptr a -> Bool
isNullPtr = (ptr a
forall (ptr :: * -> *) a. VulkanPtr ptr => ptr a
vkNullPtr ptr a -> ptr a -> Bool
forall a. Eq a => a -> a -> Bool
==)
{-# INLINE isNullPtr #-}
pattern VK_NULL :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL :: forall (ptr :: * -> *) a. (Eq (ptr a), VulkanPtr ptr) => ptr a
$mVK_NULL :: forall {r} {ptr :: * -> *} {a}.
(Eq (ptr a), VulkanPtr ptr) =>
ptr a -> (Void# -> r) -> (Void# -> r) -> r
VK_NULL <- (isNullPtr -> True)
where VK_NULL = ptr a
forall (ptr :: * -> *) a. VulkanPtr ptr => ptr a
vkNullPtr
pattern VK_NULL_HANDLE :: (Eq (ptr a), VulkanPtr ptr) => ptr a
pattern $bVK_NULL_HANDLE :: forall (ptr :: * -> *) a. (Eq (ptr a), VulkanPtr ptr) => ptr a
$mVK_NULL_HANDLE :: forall {r} {ptr :: * -> *} {a}.
(Eq (ptr a), VulkanPtr ptr) =>
ptr a -> (Void# -> r) -> (Void# -> r) -> r
VK_NULL_HANDLE = VK_NULL
withPtr :: VulkanMarshal a => a -> (Ptr a -> IO b) -> IO b
withPtr :: forall a b. VulkanMarshal a => a -> (Ptr a -> IO b) -> IO b
withPtr a
x Ptr a -> IO b
k = do
b
b <- Ptr a -> IO b
k (a -> Ptr a
forall a. IsVkStruct a => a -> Ptr a
unsafePtr a
x)
a -> IO ()
forall a. IsVkStruct a => a -> IO ()
touchVkData a
x
b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
clearStorable :: Storable a => Ptr a -> IO ()
clearStorable :: forall a. Storable a => Ptr a -> IO ()
clearStorable Ptr a
p = Ptr a -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr a
p Word8
0 (a -> Int
forall a. Storable a => a -> Int
sizeOf (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ Ptr a -> a
forall b. Ptr b -> b
unptr Ptr a
p)
where
unptr :: Ptr b -> b
unptr :: forall b. Ptr b -> b
unptr ~Ptr b
_ = b
forall a. HasCallStack => a
undefined