{-# LINE 1 "src/Gpu/Vulkan/Device/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RankNTypes, TypeApplications #-}
{-# LANGUAGE GADTs, TypeFamilies #-}
{-# LANGUAGE DataKinds, PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Device.Middle.Internal (

	-- * CREATE AND DESTROY

	create, destroy, D(..), CreateInfo(..), CreateFlags, CreateFlagBits,
	QueueCreateInfo(..),

	-- * GET QUEUE AND WAIT IDLE

	getQueue, waitIdle,

	-- * SIZE

	Size(..)

	) where

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Foreign.Storable.PeekPoke (
	WithPoked, withPoked', withPtrS, pattern NullPtr )
import Foreign.Storable.HeteroList
import Foreign.C.Enum
import Control.Arrow
import Control.Monad.Cont
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Default
import Data.Bits
import Data.List (genericLength)
import Data.HeteroParList qualified as HeteroParList
import Data.Word
import Data.Ix

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

import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.Device.Enum

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.PhysicalDevice.Middle.Internal as PhysicalDevice
import qualified Gpu.Vulkan.PhysicalDevice.Struct as PhysicalDevice
import qualified Gpu.Vulkan.Device.Core as C
import {-# SOURCE #-} qualified Gpu.Vulkan.Queue.Middle.Internal as Queue

import qualified Gpu.Vulkan.QueueFamily.EnumManual as QueueFamily

import Gpu.Vulkan.Device.Middle.Types



enum "CreateFlagBits" ''Word32
{-# LINE 70 "src/Gpu/Vulkan/Device/Middle/Internal.hsc" #-}
	[''Eq, ''Show, ''Storable, ''Bits] [("CreateFlagsZero", 0)]

type CreateFlags = CreateFlagBits

instance Default CreateFlags where def :: CreateFlagBits
def = CreateFlagBits
CreateFlagsZero

data CreateInfo mn qcis = CreateInfo {
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> CreateFlagBits
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> PL QueueCreateInfo qcis
createInfoQueueCreateInfos :: HeteroParList.PL QueueCreateInfo qcis,
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> [Text]
createInfoEnabledLayerNames :: [T.Text],
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> [Text]
createInfoEnabledExtensionNames :: [T.Text],
	forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> Maybe Features
createInfoEnabledFeatures :: Maybe PhysicalDevice.Features }

deriving instance (Show (TMaybe.M mn), Show (HeteroParList.PL QueueCreateInfo qcis)) =>
	Show (CreateInfo mn qcis)

type family Map (f :: j -> k) xs where
	Map _f '[] = '[]
	Map f (x ': xs) = f x ': Map f xs

createInfoToCore :: (
	WithPoked (TMaybe.M mn), HeteroParList.ToListWithCM' WithPoked TMaybe.M qcis) =>
	CreateInfo mn qcis -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]) a.
(WithPoked (M mn), ToListWithCM' WithPoked M qcis) =>
CreateInfo mn qcis -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> CreateFlagBits
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoQueueCreateInfos :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> PL QueueCreateInfo qcis
createInfoQueueCreateInfos = PL QueueCreateInfo qcis
qcis,
	createInfoEnabledLayerNames :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> [Text]
createInfoEnabledLayerNames = ([Text] -> [Text]
forall a. a -> a
id ([Text] -> [Text]) -> ([Text] -> Int) -> [Text] -> ([Text], Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) -> ([Text]
elns, Int
elnc),
	createInfoEnabledExtensionNames :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> [Text]
createInfoEnabledExtensionNames = ([Text] -> [Text]
forall a. a -> a
id ([Text] -> [Text]) -> ([Text] -> Int) -> [Text] -> ([Text], Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) -> ([Text]
eens, Int
eenc),
	createInfoEnabledFeatures :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]).
CreateInfo mn qcis -> Maybe Features
createInfoEnabledFeatures = Maybe Features
mef } Ptr CreateInfo -> IO a
f =
	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
mnxt \PtrS s (M mn)
pnxt -> 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 CreateInfo -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CreateInfo
pci ->
		ContT () IO [QueueCreateInfo]
-> ([QueueCreateInfo] -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (forall k k' (c :: k' -> Constraint) (t' :: k -> k') (ss :: [k])
       (m :: * -> *) (t :: k -> *) a.
(ToListWithCM' c t' ss, Applicative m) =>
(forall (s :: k). c (t' s) => t s -> m a) -> PL t ss -> m [a]
HeteroParList.toListWithCM' @_ @_ @WithPoked @TMaybe.M (((QueueCreateInfo -> IO ()) -> IO ())
-> ContT () IO QueueCreateInfo
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((QueueCreateInfo -> IO ()) -> IO ())
 -> ContT () IO QueueCreateInfo)
-> (QueueCreateInfo s -> (QueueCreateInfo -> IO ()) -> IO ())
-> QueueCreateInfo s
-> ContT () IO QueueCreateInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueCreateInfo s -> (QueueCreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
QueueCreateInfo mn -> (QueueCreateInfo -> IO a) -> IO ()
queueCreateInfoToCore) PL QueueCreateInfo qcis
qcis) \[QueueCreateInfo]
cqcis ->
		let	qcic :: Int
qcic = [QueueCreateInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [QueueCreateInfo]
cqcis in
		Int -> (Ptr QueueCreateInfo -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
qcic \Ptr QueueCreateInfo
pcqcis ->
		Ptr QueueCreateInfo -> [QueueCreateInfo] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr QueueCreateInfo
pcqcis [QueueCreateInfo]
cqcis IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		[Text] -> (Ptr CString -> IO ()) -> IO ()
forall a. [Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray [Text]
elns \Ptr CString
pcelns ->
		[Text] -> (Ptr CString -> IO ()) -> IO ()
forall a. [Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray [Text]
eens \Ptr CString
pceens -> do
		let mk :: PtrFeatures -> CreateInfo
mk PtrFeatures
pef = C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoQueueCreateInfoCount :: Word32
C.createInfoQueueCreateInfoCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
qcic,
			createInfoPQueueCreateInfos :: Ptr QueueCreateInfo
C.createInfoPQueueCreateInfos = Ptr QueueCreateInfo
pcqcis,
			createInfoEnabledLayerCount :: Word32
C.createInfoEnabledLayerCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elnc,
			createInfoPpEnabledLayerNames :: Ptr CString
C.createInfoPpEnabledLayerNames = Ptr CString
pcelns,
			createInfoEnabledExtensionCount :: Word32
C.createInfoEnabledExtensionCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
eenc,
			createInfoPpEnabledExtensionNames :: Ptr CString
C.createInfoPpEnabledExtensionNames = Ptr CString
pceens,
			createInfoPEnabledFeatures :: PtrFeatures
C.createInfoPEnabledFeatures = PtrFeatures
pef }
		case Maybe Features
mef of
			Maybe Features
Nothing -> Ptr CreateInfo -> CreateInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CreateInfo
pci (PtrFeatures -> CreateInfo
mk PtrFeatures
forall a. Ptr a
NullPtr)
			Just Features
ef -> (PtrFeatures -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \PtrFeatures
p -> do
				PtrFeatures -> Features -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke PtrFeatures
p (Features -> IO ()) -> Features -> IO ()
forall a b. (a -> b) -> a -> b
$ Features -> Features
PhysicalDevice.featuresToCore Features
ef
				Ptr CreateInfo -> CreateInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CreateInfo
pci (PtrFeatures -> CreateInfo
mk PtrFeatures
p)
		() () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Ptr CreateInfo -> IO a
f Ptr CreateInfo
pci

create :: (WithPoked (TMaybe.M mn), HeteroParList.ToListWithCM' WithPoked TMaybe.M qcis) =>
	PhysicalDevice.P -> CreateInfo mn qcis -> TPMaybe.M AllocationCallbacks.A mc ->
	IO D
create :: forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]) (mc :: Maybe (*)).
(WithPoked (M mn), ToListWithCM' WithPoked M qcis) =>
P -> CreateInfo mn qcis -> M A mc -> IO D
create (PhysicalDevice.P P
phdvc) CreateInfo mn qcis
ci M A mc
mac = D -> D
D (D -> D) -> IO D -> IO D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr D -> IO D) -> IO D
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr D
pdvc -> do
	CreateInfo mn qcis -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (qcis :: [Maybe (*)]) a.
(WithPoked (M mn), ToListWithCM' WithPoked M qcis) =>
CreateInfo mn qcis -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo mn qcis
ci \Ptr CreateInfo
pcci ->
		M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
			Int32
r <- P -> Ptr CreateInfo -> Ptr A -> Ptr D -> IO Int32
C.create P
phdvc Ptr CreateInfo
pcci Ptr A
pac Ptr D
pdvc
			Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> Result -> IO ()
forall a b. (a -> b) -> a -> b
$ Int32 -> Result
Result Int32
r
	Ptr D -> IO D
forall a. Storable a => Ptr a -> IO a
peek Ptr D
pdvc

destroy :: D -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> M A md -> IO ()
destroy (D D
cdvc) M A md
mac = M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ D -> Ptr A -> IO ()
C.destroy D
cdvc

getQueue :: D -> Word32 -> Word32 -> IO Queue.Q
getQueue :: D -> Word32 -> Word32 -> IO Q
getQueue (D D
cdvc) Word32
qfi Word32
qi = Q -> Q
Queue.Q (Q -> Q) -> IO Q -> IO Q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Q -> IO Q) -> IO Q
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Q
pQueue -> do
	D -> Word32 -> Word32 -> Ptr Q -> IO ()
C.getQueue D
cdvc Word32
qfi Word32
qi Ptr Q
pQueue
	Ptr Q -> IO Q
forall a. Storable a => Ptr a -> IO a
peek Ptr Q
pQueue

waitIdle :: D -> IO ()
waitIdle :: D -> IO ()
waitIdle (D D
d) = Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< D -> IO Int32
C.waitIdle D
d

data QueueCreateInfo mn = QueueCreateInfo {
	forall (mn :: Maybe (*)). QueueCreateInfo mn -> M mn
queueCreateInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). QueueCreateInfo mn -> QueueCreateFlags
queueCreateInfoFlags :: QueueCreateFlags,
	forall (mn :: Maybe (*)). QueueCreateInfo mn -> Index
queueCreateInfoQueueFamilyIndex :: QueueFamily.Index,
	forall (mn :: Maybe (*)). QueueCreateInfo mn -> [Float]
queueCreateInfoQueuePriorities :: [Float] }

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

queueCreateInfoToCore :: WithPoked (TMaybe.M mn) =>
	QueueCreateInfo mn -> (C.QueueCreateInfo -> IO a) -> IO ()
queueCreateInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
QueueCreateInfo mn -> (QueueCreateInfo -> IO a) -> IO ()
queueCreateInfoToCore QueueCreateInfo {
	queueCreateInfoNext :: forall (mn :: Maybe (*)). QueueCreateInfo mn -> M mn
queueCreateInfoNext = M mn
mnxt,
	queueCreateInfoFlags :: forall (mn :: Maybe (*)). QueueCreateInfo mn -> QueueCreateFlags
queueCreateInfoFlags = QueueCreateFlagBits Word32
flgs,
	queueCreateInfoQueueFamilyIndex :: forall (mn :: Maybe (*)). QueueCreateInfo mn -> Index
queueCreateInfoQueueFamilyIndex = QueueFamily.Index Word32
qfi,
	queueCreateInfoQueuePriorities :: forall (mn :: Maybe (*)). QueueCreateInfo mn -> [Float]
queueCreateInfoQueuePriorities = [Float]
qps
	} QueueCreateInfo -> IO a
f = Int -> (Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([Float] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
qps) \Ptr Float
pqps -> do
	Ptr Float -> [Float] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Float
pqps [Float]
qps
	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
mnxt \PtrS s (M mn)
pnxt -> 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') ->
		() () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ QueueCreateInfo -> IO a
f C.QueueCreateInfo {
			queueCreateInfoSType :: ()
C.queueCreateInfoSType = (),
			queueCreateInfoPNext :: Ptr ()
C.queueCreateInfoPNext = Ptr ()
pnxt',
			queueCreateInfoFlags :: Word32
C.queueCreateInfoFlags = Word32
flgs,
			queueCreateInfoQueueFamilyIndex :: Word32
C.queueCreateInfoQueueFamilyIndex = Word32
qfi,
			queueCreateInfoQueueCount :: Word32
C.queueCreateInfoQueueCount = [Float] -> Word32
forall i a. Num i => [a] -> i
genericLength [Float]
qps,
			queueCreateInfoPQueuePriorities :: Ptr Float
C.queueCreateInfoPQueuePriorities = Ptr Float
pqps }