{-# language CPP #-}
module Vulkan.Core12.Promoted_From_VK_KHR_driver_properties ( ConformanceVersion(..)
, PhysicalDeviceDriverProperties(..)
, StructureType(..)
, DriverId(..)
, MAX_DRIVER_NAME_SIZE
, pattern MAX_DRIVER_NAME_SIZE
, MAX_DRIVER_INFO_SIZE
, pattern MAX_DRIVER_INFO_SIZE
) where
import Vulkan.CStruct.Utils (FixedArray)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.Core12.Enums.DriverId (DriverId)
import Vulkan.Core10.APIConstants (MAX_DRIVER_INFO_SIZE)
import Vulkan.Core10.APIConstants (MAX_DRIVER_NAME_SIZE)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DRIVER_PROPERTIES))
import Vulkan.Core12.Enums.DriverId (DriverId(..))
import Vulkan.Core10.APIConstants (MAX_DRIVER_INFO_SIZE)
import Vulkan.Core10.APIConstants (MAX_DRIVER_NAME_SIZE)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
import Vulkan.Core10.APIConstants (pattern MAX_DRIVER_INFO_SIZE)
import Vulkan.Core10.APIConstants (pattern MAX_DRIVER_NAME_SIZE)
data ConformanceVersion = ConformanceVersion
{
ConformanceVersion -> Word8
major :: Word8
,
ConformanceVersion -> Word8
minor :: Word8
,
ConformanceVersion -> Word8
subminor :: Word8
,
ConformanceVersion -> Word8
patch :: Word8
}
deriving (Typeable, ConformanceVersion -> ConformanceVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConformanceVersion -> ConformanceVersion -> Bool
$c/= :: ConformanceVersion -> ConformanceVersion -> Bool
== :: ConformanceVersion -> ConformanceVersion -> Bool
$c== :: ConformanceVersion -> ConformanceVersion -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ConformanceVersion)
#endif
deriving instance Show ConformanceVersion
instance ToCStruct ConformanceVersion where
withCStruct :: forall b.
ConformanceVersion -> (Ptr ConformanceVersion -> IO b) -> IO b
withCStruct ConformanceVersion
x Ptr ConformanceVersion -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
4 forall a b. (a -> b) -> a -> b
$ \Ptr ConformanceVersion
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ConformanceVersion
p ConformanceVersion
x (Ptr ConformanceVersion -> IO b
f Ptr ConformanceVersion
p)
pokeCStruct :: forall b.
Ptr ConformanceVersion -> ConformanceVersion -> IO b -> IO b
pokeCStruct Ptr ConformanceVersion
p ConformanceVersion{Word8
patch :: Word8
subminor :: Word8
minor :: Word8
major :: Word8
$sel:patch:ConformanceVersion :: ConformanceVersion -> Word8
$sel:subminor:ConformanceVersion :: ConformanceVersion -> Word8
$sel:minor:ConformanceVersion :: ConformanceVersion -> Word8
$sel:major:ConformanceVersion :: ConformanceVersion -> Word8
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word8)) (Word8
major)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 :: Ptr Word8)) (Word8
minor)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 :: Ptr Word8)) (Word8
subminor)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3 :: Ptr Word8)) (Word8
patch)
IO b
f
cStructSize :: Int
cStructSize = Int
4
cStructAlignment :: Int
cStructAlignment = Int
1
pokeZeroCStruct :: forall b. Ptr ConformanceVersion -> IO b -> IO b
pokeZeroCStruct Ptr ConformanceVersion
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word8)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 :: Ptr Word8)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 :: Ptr Word8)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3 :: Ptr Word8)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ConformanceVersion where
peekCStruct :: Ptr ConformanceVersion -> IO ConformanceVersion
peekCStruct Ptr ConformanceVersion
p = do
Word8
major <- forall a. Storable a => Ptr a -> IO a
peek @Word8 ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word8))
Word8
minor <- forall a. Storable a => Ptr a -> IO a
peek @Word8 ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1 :: Ptr Word8))
Word8
subminor <- forall a. Storable a => Ptr a -> IO a
peek @Word8 ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2 :: Ptr Word8))
Word8
patch <- forall a. Storable a => Ptr a -> IO a
peek @Word8 ((Ptr ConformanceVersion
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
3 :: Ptr Word8))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> ConformanceVersion
ConformanceVersion
Word8
major Word8
minor Word8
subminor Word8
patch
instance Storable ConformanceVersion where
sizeOf :: ConformanceVersion -> Int
sizeOf ~ConformanceVersion
_ = Int
4
alignment :: ConformanceVersion -> Int
alignment ~ConformanceVersion
_ = Int
1
peek :: Ptr ConformanceVersion -> IO ConformanceVersion
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr ConformanceVersion -> ConformanceVersion -> IO ()
poke Ptr ConformanceVersion
ptr ConformanceVersion
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ConformanceVersion
ptr ConformanceVersion
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ConformanceVersion where
zero :: ConformanceVersion
zero = Word8 -> Word8 -> Word8 -> Word8 -> ConformanceVersion
ConformanceVersion
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceDriverProperties = PhysicalDeviceDriverProperties
{
PhysicalDeviceDriverProperties -> DriverId
driverID :: DriverId
,
PhysicalDeviceDriverProperties -> ByteString
driverName :: ByteString
,
PhysicalDeviceDriverProperties -> ByteString
driverInfo :: ByteString
,
PhysicalDeviceDriverProperties -> ConformanceVersion
conformanceVersion :: ConformanceVersion
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDriverProperties)
#endif
deriving instance Show PhysicalDeviceDriverProperties
instance ToCStruct PhysicalDeviceDriverProperties where
withCStruct :: forall b.
PhysicalDeviceDriverProperties
-> (Ptr PhysicalDeviceDriverProperties -> IO b) -> IO b
withCStruct PhysicalDeviceDriverProperties
x Ptr PhysicalDeviceDriverProperties -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
536 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDriverProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDriverProperties
p PhysicalDeviceDriverProperties
x (Ptr PhysicalDeviceDriverProperties -> IO b
f Ptr PhysicalDeviceDriverProperties
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceDriverProperties
-> PhysicalDeviceDriverProperties -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDriverProperties
p PhysicalDeviceDriverProperties{ByteString
ConformanceVersion
DriverId
conformanceVersion :: ConformanceVersion
driverInfo :: ByteString
driverName :: ByteString
driverID :: DriverId
$sel:conformanceVersion:PhysicalDeviceDriverProperties :: PhysicalDeviceDriverProperties -> ConformanceVersion
$sel:driverInfo:PhysicalDeviceDriverProperties :: PhysicalDeviceDriverProperties -> ByteString
$sel:driverName:PhysicalDeviceDriverProperties :: PhysicalDeviceDriverProperties -> ByteString
$sel:driverID:PhysicalDeviceDriverProperties :: PhysicalDeviceDriverProperties -> DriverId
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DRIVER_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
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 PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DriverId)) (DriverId
driverID)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DRIVER_NAME_SIZE CChar))) (ByteString
driverName)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DRIVER_INFO_SIZE CChar))) (ByteString
driverInfo)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr ConformanceVersion)) (ConformanceVersion
conformanceVersion)
IO b
f
cStructSize :: Int
cStructSize = Int
536
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr PhysicalDeviceDriverProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDriverProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DRIVER_PROPERTIES)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
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 PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DriverId)) (forall a. Zero a => a
zero)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DRIVER_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ByteString -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DRIVER_INFO_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr ConformanceVersion)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceDriverProperties where
peekCStruct :: Ptr PhysicalDeviceDriverProperties
-> IO PhysicalDeviceDriverProperties
peekCStruct Ptr PhysicalDeviceDriverProperties
p = do
DriverId
driverID <- forall a. Storable a => Ptr a -> IO a
peek @DriverId ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DriverId))
ByteString
driverName <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_DRIVER_NAME_SIZE CChar))))
ByteString
driverInfo <- CString -> IO ByteString
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray MAX_DRIVER_INFO_SIZE CChar))))
ConformanceVersion
conformanceVersion <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ConformanceVersion ((Ptr PhysicalDeviceDriverProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
532 :: Ptr ConformanceVersion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DriverId
-> ByteString
-> ByteString
-> ConformanceVersion
-> PhysicalDeviceDriverProperties
PhysicalDeviceDriverProperties
DriverId
driverID ByteString
driverName ByteString
driverInfo ConformanceVersion
conformanceVersion
instance Storable PhysicalDeviceDriverProperties where
sizeOf :: PhysicalDeviceDriverProperties -> Int
sizeOf ~PhysicalDeviceDriverProperties
_ = Int
536
alignment :: PhysicalDeviceDriverProperties -> Int
alignment ~PhysicalDeviceDriverProperties
_ = Int
8
peek :: Ptr PhysicalDeviceDriverProperties
-> IO PhysicalDeviceDriverProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceDriverProperties
-> PhysicalDeviceDriverProperties -> IO ()
poke Ptr PhysicalDeviceDriverProperties
ptr PhysicalDeviceDriverProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDriverProperties
ptr PhysicalDeviceDriverProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceDriverProperties where
zero :: PhysicalDeviceDriverProperties
zero = DriverId
-> ByteString
-> ByteString
-> ConformanceVersion
-> PhysicalDeviceDriverProperties
PhysicalDeviceDriverProperties
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero