{-# LINE 1 "src/Gpu/Vulkan/PhysicalDevice/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.PhysicalDevice.Middle.Internal (

	-- * ENUMERATE, PROPERTIES AND FEATURES

	enumerate, P(..), getProperties, Properties(..), getFeatures,

	-- ** Get Properties 2

	getProperties2ExtensionName,
	getFeatures2, Features2(..),

	-- * OTHER PROPERTIES

	getQueueFamilyProperties,
	enumerateExtensionProperties,
	getFormatProperties,
	getMemoryProperties, MemoryProperties(..),

	-- * OTHER FEATURES

	ShaderDrawParametersFeatures(..),

	-- * OTHER EXTENSIONS

	maintenance3ExtensionName

	) where

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.Maybe
import Data.List.Length
import Data.Word
import Data.UUID

import qualified Data.ByteString.Lazy as LBS

import Data.Text qualified as T
import Data.Text.Foreign.MiscYj

import Gpu.Vulkan.Enum
import Gpu.Vulkan.Middle.Internal
import Gpu.Vulkan.Base.Middle.Internal
import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.PhysicalDevice.Enum
import Gpu.Vulkan.PhysicalDevice.Struct

import qualified Gpu.Vulkan.Instance.Middle.Internal as Instance.M
import qualified Gpu.Vulkan.PhysicalDevice.Core as C
import qualified Gpu.Vulkan.QueueFamily.Middle.Internal as QueueFamily
import qualified Gpu.Vulkan.QueueFamily.EnumManual as QueueFamily
import qualified Gpu.Vulkan.Memory.Middle.Internal as Memory.M

import Gpu.Vulkan.PNext.Middle.Internal



newtype P = P C.P deriving (Int -> P -> ShowS
[P] -> ShowS
P -> String
(Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P -> ShowS
showsPrec :: Int -> P -> ShowS
$cshow :: P -> String
show :: P -> String
$cshowList :: [P] -> ShowS
showList :: [P] -> ShowS
Show, Ptr P -> IO P
Ptr P -> Int -> IO P
Ptr P -> Int -> P -> IO ()
Ptr P -> P -> IO ()
P -> Int
(P -> Int)
-> (P -> Int)
-> (Ptr P -> Int -> IO P)
-> (Ptr P -> Int -> P -> IO ())
-> (forall b. Ptr b -> Int -> IO P)
-> (forall b. Ptr b -> Int -> P -> IO ())
-> (Ptr P -> IO P)
-> (Ptr P -> P -> IO ())
-> Storable P
forall b. Ptr b -> Int -> IO P
forall b. Ptr b -> Int -> P -> IO ()
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
$csizeOf :: P -> Int
sizeOf :: P -> Int
$calignment :: P -> Int
alignment :: P -> Int
$cpeekElemOff :: Ptr P -> Int -> IO P
peekElemOff :: Ptr P -> Int -> IO P
$cpokeElemOff :: Ptr P -> Int -> P -> IO ()
pokeElemOff :: Ptr P -> Int -> P -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO P
peekByteOff :: forall b. Ptr b -> Int -> IO P
$cpokeByteOff :: forall b. Ptr b -> Int -> P -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> P -> IO ()
$cpeek :: Ptr P -> IO P
peek :: Ptr P -> IO P
$cpoke :: Ptr P -> P -> IO ()
poke :: Ptr P -> P -> IO ()
Storable)

enumerate :: Instance.M.I -> IO [P]
enumerate :: I -> IO [P]
enumerate (Instance.M.I I
ist) = (P -> P) -> [P] -> [P]
forall a b. (a -> b) -> [a] -> [b]
map P -> P
P ([P] -> [P]) -> IO [P] -> IO [P]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO [P]) -> IO [P]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pdvcc ->
	I -> Ptr Word32 -> Ptr P -> IO Int32
C.enumerate I
ist Ptr Word32
pdvcc Ptr P
forall a. Ptr a
NullPtr IO Int32 -> (Int32 -> IO [P]) -> IO [P]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pdvcc IO Word32 -> (Word32 -> IO [P]) -> IO [P]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
dvcc) ->
	Int -> (Ptr P -> IO [P]) -> IO [P]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
dvcc \Ptr P
pdvcs ->
	I -> Ptr Word32 -> Ptr P -> IO Int32
C.enumerate I
ist Ptr Word32
pdvcc Ptr P
pdvcs IO Int32 -> (Int32 -> IO [P]) -> IO [P]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r' ->
	Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r') IO () -> IO [P] -> IO [P]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> Ptr P -> IO [P]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
dvcc Ptr P
pdvcs

data Properties = Properties {
	Properties -> ApiVersion
propertiesApiVersion :: ApiVersion,
	Properties -> Word32
propertiesDriverVersion :: Word32,
	Properties -> Word32
propertiesVendorId :: Word32,
	Properties -> Word32
propertiesDeviceId :: Word32,
	Properties -> Type
propertiesDeviceType :: Type,
	Properties -> Text
propertiesDeviceName :: T.Text,
	Properties -> UUID
propertiesPipelineCacheUuid :: UUID,
	Properties -> Limits
propertiesLimits :: Limits,
	Properties -> SparseProperties
propertiesSparseProperties :: SparseProperties }
	deriving Int -> Properties -> ShowS
[Properties] -> ShowS
Properties -> String
(Int -> Properties -> ShowS)
-> (Properties -> String)
-> ([Properties] -> ShowS)
-> Show Properties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Properties -> ShowS
showsPrec :: Int -> Properties -> ShowS
$cshow :: Properties -> String
show :: Properties -> String
$cshowList :: [Properties] -> ShowS
showList :: [Properties] -> ShowS
Show

propertiesFromCore :: C.Properties -> Properties
propertiesFromCore :: Properties -> Properties
propertiesFromCore C.Properties {
	propertiesApiVersion :: Properties -> Word32
C.propertiesApiVersion = Word32
av,
	propertiesDriverVersion :: Properties -> Word32
C.propertiesDriverVersion = Word32
dv,
	propertiesVendorId :: Properties -> Word32
C.propertiesVendorId = Word32
vi,
	propertiesDeviceId :: Properties -> Word32
C.propertiesDeviceId = Word32
di,
	propertiesDeviceType :: Properties -> Word32
C.propertiesDeviceType = Word32
dt,
	propertiesDeviceName :: Properties -> Text
C.propertiesDeviceName = Text
dn,
	propertiesPipelineCacheUuid :: Properties -> ListUint8T
C.propertiesPipelineCacheUuid = ListUint8T
pcu,
	propertiesLimits :: Properties -> Limits
C.propertiesLimits = Limits
l,
	propertiesSparseProperties :: Properties -> SparseProperties
C.propertiesSparseProperties = SparseProperties
sp } = Properties {
	propertiesApiVersion :: ApiVersion
propertiesApiVersion = Word32 -> ApiVersion
ApiVersion Word32
av,
	propertiesDriverVersion :: Word32
propertiesDriverVersion = Word32
dv,
	propertiesVendorId :: Word32
propertiesVendorId = Word32
vi,
	propertiesDeviceId :: Word32
propertiesDeviceId = Word32
di,
	propertiesDeviceType :: Type
propertiesDeviceType = Word32 -> Type
Type Word32
dt,
	propertiesDeviceName :: Text
propertiesDeviceName = Text
dn,
	propertiesPipelineCacheUuid :: UUID
propertiesPipelineCacheUuid = ListUint8T -> UUID
word8listToUuid ListUint8T
pcu,
	propertiesLimits :: Limits
propertiesLimits = Limits -> Limits
limitsFromCore Limits
l,
	propertiesSparseProperties :: SparseProperties
propertiesSparseProperties = SparseProperties -> SparseProperties
sparsePropertiesFromCore SparseProperties
sp }

word8listToUuid :: [Word8] -> UUID
word8listToUuid :: ListUint8T -> UUID
word8listToUuid ListUint8T
ws = Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID)
-> (ByteString -> Maybe UUID) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UUID
fromByteString (ByteString -> UUID) -> ByteString -> UUID
forall a b. (a -> b) -> a -> b
$ ListUint8T -> ByteString
LBS.pack ListUint8T
ws

data SparseProperties = SparseProperties {
	SparseProperties -> Bool
sparsePropertiesResidencyStandard2DBlockShape :: Bool,
	SparseProperties -> Bool
sparsePropertiesResidencyStandard2DMultisampleBlockShape :: Bool,
	SparseProperties -> Bool
sparsePropertiesResidencyStandard3DBlockShape :: Bool,
	SparseProperties -> Bool
sparsePropertiesResidencyAlignedMipSize :: Bool,
	SparseProperties -> Bool
sparsePropertiesResidencyNonResidentStrict :: Bool }
	deriving Int -> SparseProperties -> ShowS
[SparseProperties] -> ShowS
SparseProperties -> String
(Int -> SparseProperties -> ShowS)
-> (SparseProperties -> String)
-> ([SparseProperties] -> ShowS)
-> Show SparseProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SparseProperties -> ShowS
showsPrec :: Int -> SparseProperties -> ShowS
$cshow :: SparseProperties -> String
show :: SparseProperties -> String
$cshowList :: [SparseProperties] -> ShowS
showList :: [SparseProperties] -> ShowS
Show

sparsePropertiesFromCore :: C.SparseProperties -> SparseProperties
sparsePropertiesFromCore :: SparseProperties -> SparseProperties
sparsePropertiesFromCore C.SparseProperties {
	sparsePropertiesResidencyStandard2DBlockShape :: SparseProperties -> Word32
C.sparsePropertiesResidencyStandard2DBlockShape = Word32
crs2bs,
	sparsePropertiesResidencyStandard2DMultisampleBlockShape :: SparseProperties -> Word32
C.sparsePropertiesResidencyStandard2DMultisampleBlockShape = Word32
crs2mbs,
	sparsePropertiesResidencyStandard3DBlockShape :: SparseProperties -> Word32
C.sparsePropertiesResidencyStandard3DBlockShape = Word32
crs3bs,
	sparsePropertiesResidencyAlignedMipSize :: SparseProperties -> Word32
C.sparsePropertiesResidencyAlignedMipSize = Word32
crams,
	sparsePropertiesResidencyNonResidentStrict :: SparseProperties -> Word32
C.sparsePropertiesResidencyNonResidentStrict = Word32
cnrs } =
	SparseProperties {
		sparsePropertiesResidencyStandard2DBlockShape :: Bool
sparsePropertiesResidencyStandard2DBlockShape = Bool
rs2bs,
		sparsePropertiesResidencyStandard2DMultisampleBlockShape :: Bool
sparsePropertiesResidencyStandard2DMultisampleBlockShape =
			Bool
rs2mbs,
		sparsePropertiesResidencyStandard3DBlockShape :: Bool
sparsePropertiesResidencyStandard3DBlockShape = Bool
rs3bs,
		sparsePropertiesResidencyAlignedMipSize :: Bool
sparsePropertiesResidencyAlignedMipSize = Bool
rams,
		sparsePropertiesResidencyNonResidentStrict :: Bool
sparsePropertiesResidencyNonResidentStrict = Bool
nrs }
	where
	(Bool
rs2bs :. Bool
rs2mbs :. Bool
rs3bs :. Bool
rams :. Bool
nrs :. RangeL
  (((((5 - 1) - 1) - 1) - 1) - 1)
  (((((5 - 1) - 1) - 1) - 1) - 1)
  Bool
NilL :: LengthL 5 Bool) =
		Word32 -> Bool
bool32ToBool (Word32 -> Bool) -> RangeL 5 5 Word32 -> LengthL 5 Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
			(Word32
crs2bs Word32 -> RangeL (5 - 1) (5 - 1) Word32 -> RangeL 5 5 Word32
forall (a :: Natural) (b :: Natural) c.
(1 <= a, 1 <= b) =>
c -> RangeL (a - 1) (b - 1) c -> RangeL a b c
:. Word32
crs2mbs Word32 -> RangeL (4 - 1) (4 - 1) Word32 -> RangeL 4 4 Word32
forall (a :: Natural) (b :: Natural) c.
(1 <= a, 1 <= b) =>
c -> RangeL (a - 1) (b - 1) c -> RangeL a b c
:. Word32
crs3bs Word32 -> RangeL (3 - 1) (3 - 1) Word32 -> RangeL 3 3 Word32
forall (a :: Natural) (b :: Natural) c.
(1 <= a, 1 <= b) =>
c -> RangeL (a - 1) (b - 1) c -> RangeL a b c
:. Word32
crams Word32 -> RangeL (2 - 1) (2 - 1) Word32 -> RangeL 2 2 Word32
forall (a :: Natural) (b :: Natural) c.
(1 <= a, 1 <= b) =>
c -> RangeL (a - 1) (b - 1) c -> RangeL a b c
:. Word32
cnrs Word32 -> RangeL (1 - 1) (1 - 1) Word32 -> RangeL 1 1 Word32
forall (a :: Natural) (b :: Natural) c.
(1 <= a, 1 <= b) =>
c -> RangeL (a - 1) (b - 1) c -> RangeL a b c
:. RangeL 0 0 Word32
RangeL (1 - 1) (1 - 1) Word32
forall (b :: Natural) c. (0 <= b) => RangeL 0 b c
NilL)

getProperties :: P -> IO Properties
getProperties :: P -> IO Properties
getProperties (P P
pdvc) = Properties -> Properties
propertiesFromCore (Properties -> Properties) -> IO Properties -> IO Properties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Properties -> IO Properties) -> IO Properties
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Properties
pppts -> do
	P -> Ptr Properties -> IO ()
C.getProperties P
pdvc Ptr Properties
pppts
	Ptr Properties -> IO Properties
forall a. Storable a => Ptr a -> IO a
peek Ptr Properties
pppts

getFeatures :: P -> IO Features
getFeatures :: P -> IO Features
getFeatures (P P
pdvc) = Features -> Features
featuresFromCore (Features -> Features) -> IO Features -> IO Features
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Features -> IO Features) -> IO Features
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Features
pfts -> do
	P -> Ptr Features -> IO ()
C.getFeatures P
pdvc Ptr Features
pfts
	Ptr Features -> IO Features
forall a. Storable a => Ptr a -> IO a
peek Ptr Features
pfts

getFeatures2 :: forall mn . ReadChain mn => P -> IO (Features2 mn)
getFeatures2 :: forall (mn :: Maybe (*)). ReadChain mn => P -> IO (Features2 mn)
getFeatures2 (P P
pdvc) = forall (mn :: Maybe (*)) a.
ReadChain mn =>
(Ptr () -> IO a) -> IO a
clearedChain @mn \Ptr ()
pn ->
	Features2 -> IO (Features2 mn)
forall (mn :: Maybe (*)).
ReadChain mn =>
Features2 -> IO (Features2 mn)
features2FromCore (Features2 -> IO (Features2 mn))
-> IO Features2 -> IO (Features2 mn)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Ptr Features2 -> IO Features2) -> IO Features2
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Features2
pfts -> do
		cfs <- IO Features
C.getClearedFeatures
		poke pfts $ C.Features2 {
			C.features2SType = (),
			C.features2PNext = pn,
			C.features2Features = cfs }
		C.getFeatures2 pdvc pfts
		peek pfts

data Features2 mn = Features2 {
	forall (mn :: Maybe (*)). Features2 mn -> M mn
features2Next :: TMaybe.M mn,
	forall (mn :: Maybe (*)). Features2 mn -> Features
features2Features :: Features }

deriving instance Show (TMaybe.M mn) => Show (Features2 mn)

instance WithPoked (TMaybe.M mn) => WithPoked (Features2 mn) where
	withPoked' :: forall b.
Features2 mn -> (forall s. PtrS s (Features2 mn) -> IO b) -> IO b
withPoked' (Features2 M mn
mn Features
fs) forall s. PtrS s (Features2 mn) -> IO b
f = (Ptr Features2 -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Features2
pfs2 -> do
		M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mn \PtrS s (M mn)
spn -> PtrS s (M mn) -> (Ptr (M mn) -> IO ()) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
spn \Ptr (M mn)
pn ->
			Ptr Features2 -> Features2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Features2
pfs2 (Features2 -> IO ()) -> Features2 -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> Ptr () -> Features -> Features2
C.Features2 () (Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (M mn)
pn) (Features -> Features
featuresToCore Features
fs)
		PtrS Any (Features2 mn) -> IO b
forall s. PtrS s (Features2 mn) -> IO b
f (PtrS Any (Features2 mn) -> IO b)
-> (Ptr (Features2 mn) -> PtrS Any (Features2 mn))
-> Ptr (Features2 mn)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Features2 mn) -> PtrS Any (Features2 mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (Features2 mn) -> IO b) -> Ptr (Features2 mn) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Features2 -> Ptr (Features2 mn)
forall a b. Ptr a -> Ptr b
castPtr Ptr Features2
pfs2

features2FromCore :: ReadChain mn => C.Features2 -> IO (Features2 mn)
features2FromCore :: forall (mn :: Maybe (*)).
ReadChain mn =>
Features2 -> IO (Features2 mn)
features2FromCore C.Features2 {
	features2PNext :: Features2 -> Ptr ()
C.features2PNext = Ptr ()
pnxt,
	features2Features :: Features2 -> Features
C.features2Features = Features
ftrs } = do
	nxts <- Ptr () -> IO (M mn)
forall (mn :: Maybe (*)). ReadChain mn => Ptr () -> IO (M mn)
readChain Ptr ()
pnxt
	let	ftrs' = Features -> Features
featuresFromCore Features
ftrs
	pure Features2 {
		features2Next = nxts, features2Features = ftrs' }

getQueueFamilyProperties :: P -> IO [(QueueFamily.Index, QueueFamily.Properties)]
getQueueFamilyProperties :: P -> IO [(Index, Properties)]
getQueueFamilyProperties (P P
pdvc) =
	([Index]
QueueFamily.indices [Index] -> [Properties] -> [(Index, Properties)]
forall a b. [a] -> [b] -> [(a, b)]
`zip`)
		([Properties] -> [(Index, Properties)])
-> ([Properties] -> [Properties])
-> [Properties]
-> [(Index, Properties)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Properties -> Properties) -> [Properties] -> [Properties]
forall a b. (a -> b) -> [a] -> [b]
map Properties -> Properties
QueueFamily.propertiesFromCore ([Properties] -> [(Index, Properties)])
-> IO [Properties] -> IO [(Index, Properties)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word32 -> IO [Properties]) -> IO [Properties]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
ppptc ->
	P -> Ptr Word32 -> Ptr Properties -> IO ()
C.getQueueFamilyProperties P
pdvc Ptr Word32
ppptc Ptr Properties
forall a. Ptr a
NullPtr IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ppptc IO Word32 -> (Word32 -> IO [Properties]) -> IO [Properties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
pptc) ->
	Int -> (Ptr Properties -> IO [Properties]) -> IO [Properties]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
pptc \Ptr Properties
pppts ->
	P -> Ptr Word32 -> Ptr Properties -> IO ()
C.getQueueFamilyProperties P
pdvc Ptr Word32
ppptc Ptr Properties
pppts IO () -> IO [Properties] -> IO [Properties]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> Ptr Properties -> IO [Properties]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
pptc Ptr Properties
pppts

enumerateExtensionProperties ::
	P -> Maybe T.Text -> IO [ExtensionProperties]
enumerateExtensionProperties :: P -> Maybe Text -> IO [ExtensionProperties]
enumerateExtensionProperties (P P
pdvc) Maybe Text
mlnm =
	(ExtensionProperties -> ExtensionProperties)
-> [ExtensionProperties] -> [ExtensionProperties]
forall a b. (a -> b) -> [a] -> [b]
map ExtensionProperties -> ExtensionProperties
extensionPropertiesFromCore ([ExtensionProperties] -> [ExtensionProperties])
-> IO [ExtensionProperties] -> IO [ExtensionProperties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Text
mlnm of
		Maybe Text
Nothing -> CString -> IO [ExtensionProperties]
go CString
forall a. Ptr a
NullPtr
		Just Text
lnm -> Text
-> (CString -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a. Text -> (CString -> IO a) -> IO a
textToCString Text
lnm CString -> IO [ExtensionProperties]
go
	where
	go :: CString -> IO [ExtensionProperties]
go CString
cmlnm = (Ptr Word32 -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Word32
pExtensionCount ->
		P -> CString -> Ptr Word32 -> Ptr ExtensionProperties -> IO Int32
C.enumerateExtensionProperties
			P
pdvc CString
cmlnm Ptr Word32
pExtensionCount Ptr ExtensionProperties
forall a. Ptr a
NullPtr IO Int32
-> (Int32 -> IO [ExtensionProperties]) -> IO [ExtensionProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
r ->
		Result -> IO ()
throwUnlessSuccess (Int32 -> Result
Result Int32
r) IO () -> IO Word32 -> IO Word32
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
pExtensionCount IO Word32
-> (Word32 -> IO [ExtensionProperties]) -> IO [ExtensionProperties]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
extensionCount) ->
		Int
-> (Ptr ExtensionProperties -> IO [ExtensionProperties])
-> IO [ExtensionProperties]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
extensionCount \Ptr ExtensionProperties
pAvailableExtensions -> do
			r' <- P -> CString -> Ptr Word32 -> Ptr ExtensionProperties -> IO Int32
C.enumerateExtensionProperties P
pdvc CString
cmlnm
				Ptr Word32
pExtensionCount Ptr ExtensionProperties
pAvailableExtensions
			throwUnlessSuccess $ Result r'
			peekArray extensionCount pAvailableExtensions

data MemoryProperties = MemoryProperties {
	MemoryProperties -> [(TypeIndex, MType)]
memoryPropertiesMemoryTypes :: [(Memory.M.TypeIndex, Memory.M.MType)],
	MemoryProperties -> [Heap]
memoryPropertiesMemoryHeaps :: [Memory.M.Heap] }
	deriving Int -> MemoryProperties -> ShowS
[MemoryProperties] -> ShowS
MemoryProperties -> String
(Int -> MemoryProperties -> ShowS)
-> (MemoryProperties -> String)
-> ([MemoryProperties] -> ShowS)
-> Show MemoryProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryProperties -> ShowS
showsPrec :: Int -> MemoryProperties -> ShowS
$cshow :: MemoryProperties -> String
show :: MemoryProperties -> String
$cshowList :: [MemoryProperties] -> ShowS
showList :: [MemoryProperties] -> ShowS
Show

memoryPropertiesFromCore :: C.MemoryProperties -> MemoryProperties
memoryPropertiesFromCore :: MemoryProperties -> MemoryProperties
memoryPropertiesFromCore C.MemoryProperties {
	memoryPropertiesMemoryTypeCount :: MemoryProperties -> Word32
C.memoryPropertiesMemoryTypeCount = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
mtc,
	memoryPropertiesMemoryTypes :: MemoryProperties -> ListMType
C.memoryPropertiesMemoryTypes = (MType -> MType
Memory.M.mTypeFromCore (MType -> MType) -> ListMType -> [MType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> [MType]
mts,
	memoryPropertiesMemoryHeapCount :: MemoryProperties -> Word32
C.memoryPropertiesMemoryHeapCount = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
mhc,
	memoryPropertiesMemoryHeaps :: MemoryProperties -> ListHeap
C.memoryPropertiesMemoryHeaps = (Heap -> Heap
Memory.M.heapFromCore (Heap -> Heap) -> ListHeap -> [Heap]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> [Heap]
mhs } =
	MemoryProperties {
		memoryPropertiesMemoryTypes :: [(TypeIndex, MType)]
memoryPropertiesMemoryTypes = [TypeIndex
0 ..] [TypeIndex] -> [MType] -> [(TypeIndex, MType)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` Int -> [MType] -> [MType]
forall a. Int -> [a] -> [a]
take Int
mtc [MType]
mts,
		memoryPropertiesMemoryHeaps :: [Heap]
memoryPropertiesMemoryHeaps = Int -> [Heap] -> [Heap]
forall a. Int -> [a] -> [a]
take Int
mhc [Heap]
mhs }

getMemoryProperties :: P -> IO MemoryProperties
getMemoryProperties :: P -> IO MemoryProperties
getMemoryProperties (P P
p) = MemoryProperties -> MemoryProperties
memoryPropertiesFromCore (MemoryProperties -> MemoryProperties)
-> IO MemoryProperties -> IO MemoryProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr MemoryProperties -> IO MemoryProperties)
-> IO MemoryProperties
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr MemoryProperties
pmps -> do
	P -> Ptr MemoryProperties -> IO ()
C.getMemoryProperties P
p Ptr MemoryProperties
pmps
	Ptr MemoryProperties -> IO MemoryProperties
forall a. Storable a => Ptr a -> IO a
peek Ptr MemoryProperties
pmps

getFormatProperties :: P -> Format -> IO FormatProperties
getFormatProperties :: P -> Format -> IO FormatProperties
getFormatProperties (P P
pdvc) (Format Word32
fmt) = FormatProperties -> FormatProperties
formatPropertiesFromCore (FormatProperties -> FormatProperties)
-> IO FormatProperties -> IO FormatProperties
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr FormatProperties -> IO FormatProperties)
-> IO FormatProperties
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr FormatProperties
pp -> do
	P -> Word32 -> Ptr FormatProperties -> IO ()
C.getFormatProperties P
pdvc Word32
fmt Ptr FormatProperties
pp
	Ptr FormatProperties -> IO FormatProperties
forall a. Storable a => Ptr a -> IO a
peek Ptr FormatProperties
pp

data ShaderDrawParametersFeatures mn = ShaderDrawParametersFeatures {
	forall (mn :: Maybe (*)). ShaderDrawParametersFeatures mn -> M mn
shaderDrawParametersFeaturesNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). ShaderDrawParametersFeatures mn -> Bool
shaderDrawParametersFeaturesShaderDrawParameters :: Bool }

deriving instance Show (TMaybe.M mn) => Show (ShaderDrawParametersFeatures mn)

shaderDrawParametersFeaturesToCore :: WithPoked (TMaybe.M mn) =>
	ShaderDrawParametersFeatures mn ->
	(Ptr C.ShaderDrawParametersFeatures -> IO a) -> IO a
shaderDrawParametersFeaturesToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
ShaderDrawParametersFeatures mn
-> (Ptr ShaderDrawParametersFeatures -> IO a) -> IO a
shaderDrawParametersFeaturesToCore ShaderDrawParametersFeatures {
	shaderDrawParametersFeaturesNext :: forall (mn :: Maybe (*)). ShaderDrawParametersFeatures mn -> M mn
shaderDrawParametersFeaturesNext = M mn
mnxt,
	shaderDrawParametersFeaturesShaderDrawParameters :: forall (mn :: Maybe (*)). ShaderDrawParametersFeatures mn -> Bool
shaderDrawParametersFeaturesShaderDrawParameters = Bool
sdp } Ptr ShaderDrawParametersFeatures -> IO a
f =
	(Ptr ShaderDrawParametersFeatures -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr ShaderDrawParametersFeatures
pfs -> M mn -> (forall s. PtrS s (M mn) -> IO a) -> IO a
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> do
		PtrS s (M mn) -> (Ptr (M mn) -> IO ()) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') -> Ptr ShaderDrawParametersFeatures
-> ShaderDrawParametersFeatures -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr ShaderDrawParametersFeatures
pfs
			C.ShaderDrawParametersFeatures {
				shaderDrawParametersFeaturesSType :: ()
C.shaderDrawParametersFeaturesSType = (),
				shaderDrawParametersFeaturesPNext :: Ptr ()
C.shaderDrawParametersFeaturesPNext = Ptr ()
pnxt',
				shaderDrawParametersFeaturesShaderDrawParameters :: Word32
C.shaderDrawParametersFeaturesShaderDrawParameters =
					Bool -> Word32
boolToBool32 Bool
sdp }
		Ptr ShaderDrawParametersFeatures -> IO a
f Ptr ShaderDrawParametersFeatures
pfs

instance WithPoked (TMaybe.M mn) => WithPoked (ShaderDrawParametersFeatures mn) where
	withPoked' :: forall b.
ShaderDrawParametersFeatures mn
-> (forall s. PtrS s (ShaderDrawParametersFeatures mn) -> IO b)
-> IO b
withPoked' ShaderDrawParametersFeatures mn
sdpfs forall s. PtrS s (ShaderDrawParametersFeatures mn) -> IO b
f =
		ShaderDrawParametersFeatures mn
-> (Ptr ShaderDrawParametersFeatures -> IO b) -> IO b
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
ShaderDrawParametersFeatures mn
-> (Ptr ShaderDrawParametersFeatures -> IO a) -> IO a
shaderDrawParametersFeaturesToCore ShaderDrawParametersFeatures mn
sdpfs ((Ptr ShaderDrawParametersFeatures -> IO b) -> IO b)
-> (Ptr ShaderDrawParametersFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ PtrS Any (ShaderDrawParametersFeatures mn) -> IO b
forall s. PtrS s (ShaderDrawParametersFeatures mn) -> IO b
f (PtrS Any (ShaderDrawParametersFeatures mn) -> IO b)
-> (Ptr ShaderDrawParametersFeatures
    -> PtrS Any (ShaderDrawParametersFeatures mn))
-> Ptr ShaderDrawParametersFeatures
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (ShaderDrawParametersFeatures mn)
-> PtrS Any (ShaderDrawParametersFeatures mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (ShaderDrawParametersFeatures mn)
 -> PtrS Any (ShaderDrawParametersFeatures mn))
-> (Ptr ShaderDrawParametersFeatures
    -> Ptr (ShaderDrawParametersFeatures mn))
-> Ptr ShaderDrawParametersFeatures
-> PtrS Any (ShaderDrawParametersFeatures mn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ShaderDrawParametersFeatures
-> Ptr (ShaderDrawParametersFeatures mn)
forall a b. Ptr a -> Ptr b
castPtr

maintenance3ExtensionName :: T.Text
maintenance3ExtensionName :: Text
maintenance3ExtensionName = Text
"VK_KHR_maintenance3"
{-# LINE 269 "src/Gpu/Vulkan/PhysicalDevice/Middle/Internal.hsc" #-}

getProperties2ExtensionName :: T.Text
getProperties2ExtensionName :: Text
getProperties2ExtensionName =
	Text
"VK_KHR_get_physical_device_properties2"
{-# LINE 273 "src/Gpu/Vulkan/PhysicalDevice/Middle/Internal.hsc" #-}