{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Cmd.Middle (

	-- * BEGIN AND END RENDER PASS

	beginRenderPass, endRenderPass,

	-- * DRAW AND DISPATCH

	-- ** Draw

	bindPipelineGraphics, bindVertexBuffers, bindIndexBuffer, draw, drawIndexed,

	-- ** Dispatch

	bindPipelineCompute, dispatch,

	-- * PUSH CONSTANTS AND BIND DESCRIPTOR SETS

	pushConstants, bindDescriptorSets,

	-- * COPY BUFFERS AND IMAGES

	copyBuffer, copyBufferToImage, copyImageToBuffer, blitImage, blitImage2,

	-- * CLEAR COLOR IMAGE

	clearColorImage,

	-- * MEMORY DEPENDENCY

	pipelineBarrier, pipelineBarrier2,

	-- * QUERY

	resetQueryPool, beginQuery, endQuery, writeTimestamp

	) where

import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke (WithPoked)
import Foreign.Storable.HeteroList
import Control.Arrow
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Cont
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.List qualified as TList
import Data.List qualified as L
import Data.HeteroParList qualified as HPList
import Data.HeteroParList qualified as HeteroParList
import Data.Word
import Data.Int
import Data.IORef

import Gpu.Vulkan.Middle.Internal
import Gpu.Vulkan.Enum

import qualified Gpu.Vulkan.CommandBuffer.Middle.Internal as CommandBuffer.M
import qualified Gpu.Vulkan.Buffer.Middle.Internal as Buffer
import qualified Gpu.Vulkan.Buffer.Core as Buffer.C
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.Cmd.Core as C

import qualified Gpu.Vulkan.RenderPass.Middle.Internal as RenderPass
import qualified Gpu.Vulkan.Subpass.Enum as Subpass
import qualified Gpu.Vulkan.Pipeline.Graphics.Middle.Internal as Pipeline
import qualified Gpu.Vulkan.Pipeline.Compute.Middle.Internal as Pipeline.Compute
import qualified Gpu.Vulkan.Pipeline.Enum as Pipeline
import qualified Gpu.Vulkan.PipelineLayout.Middle.Internal as Pipeline.Layout

import qualified Gpu.Vulkan.DescriptorSet.Middle.Internal as Descriptor.Set

import qualified Gpu.Vulkan.Image.Enum as Image
import qualified Gpu.Vulkan.Image.Middle.Internal as Image
import qualified Gpu.Vulkan.Buffer.Middle.Internal as Buffer.M
import qualified Gpu.Vulkan.Memory.Middle.Internal as Memory.M

import Gpu.Vulkan.Query.Enum qualified as Query
import Gpu.Vulkan.QueryPool.Middle.Internal qualified as QueryPool

beginRenderPass :: (WithPoked (TMaybe.M mn), ClearValueListToCore cts) => CommandBuffer.M.C ->
	RenderPass.BeginInfo mn cts -> Subpass.Contents -> IO ()
beginRenderPass :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
(WithPoked (M mn), ClearValueListToCore cts) =>
C -> BeginInfo mn cts -> Contents -> IO ()
beginRenderPass (CommandBuffer.M.C IORef P
_ C
cb) BeginInfo mn cts
rpbi (Subpass.Contents Word32
spcnt) =
	BeginInfo mn cts -> (Ptr BeginInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (cts :: [ClearType]) a.
(WithPoked (M mn), ClearValueListToCore cts) =>
BeginInfo mn cts -> (Ptr BeginInfo -> IO a) -> IO ()
RenderPass.beginInfoToCore BeginInfo mn cts
rpbi \Ptr BeginInfo
prpbi ->
		C -> Ptr BeginInfo -> Word32 -> IO ()
C.beginRenderPass C
cb Ptr BeginInfo
prpbi Word32
spcnt

endRenderPass :: CommandBuffer.M.C -> IO ()
endRenderPass :: C -> IO ()
endRenderPass (CommandBuffer.M.C IORef P
_ C
cb) = C -> IO ()
C.endRenderPass C
cb

bindPipelineGraphics ::
	CommandBuffer.M.C -> Pipeline.BindPoint -> Pipeline.G -> IO ()
bindPipelineGraphics :: C -> BindPoint -> G -> IO ()
bindPipelineGraphics (CommandBuffer.M.C IORef P
rppl C
cb) (Pipeline.BindPoint Word32
pbp) G
ppl = do
	ppl0 <- IORef P -> IO P
forall a. IORef a -> IO a
readIORef IORef P
rppl
	ppl' <- Pipeline.gToCore ppl
	when (ppl' /= ppl0) do
		writeIORef rppl ppl'
		C.bindPipeline cb pbp ppl'

bindPipelineCompute ::
	CommandBuffer.M.C -> Pipeline.BindPoint -> Pipeline.Compute.C -> IO ()
bindPipelineCompute :: C -> BindPoint -> C -> IO ()
bindPipelineCompute (CommandBuffer.M.C IORef P
rppl C
cb) (Pipeline.BindPoint Word32
pbp) (Pipeline.Compute.C P
ppl) = do
	ppl0 <- IORef P -> IO P
forall a. IORef a -> IO a
readIORef IORef P
rppl
	when (ppl /= ppl0) do
		writeIORef rppl ppl
		C.bindPipeline cb pbp ppl

bindVertexBuffers ::
	CommandBuffer.M.C -> Word32 -> [(Buffer.B, Device.Size)] -> IO ()
bindVertexBuffers :: C -> Word32 -> [(B, Size)] -> IO ()
bindVertexBuffers (CommandBuffer.M.C IORef P
_ C
c)
	Word32
fb (([(B, Size)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(B, Size)] -> Int)
-> ([(B, Size)] -> ([B], [Size]))
-> [(B, Size)]
-> (Int, ([B], [Size]))
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')
&&& [(B, Size)] -> ([B], [Size])
forall a b. [(a, b)] -> ([a], [b])
unzip) -> (Int
bc, ([B]
bs, [Size]
os))) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	pb <- ((Ptr B -> IO ()) -> IO ()) -> ContT () IO (Ptr B)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr B -> IO ()) -> IO ()) -> ContT () IO (Ptr B))
-> ((Ptr B -> IO ()) -> IO ()) -> ContT () IO (Ptr B)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr B -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bc
	lift . pokeArray pb $ (\(Buffer.B B
b) -> B
b) <$> bs
	po <- ContT $ allocaArray bc
	lift . pokeArray po $ (\(Device.Size Word64
sz) -> Word64
sz) <$> os
	lift $ C.bindVertexBuffers c fb (fromIntegral bc) pb po

bindIndexBuffer ::
	CommandBuffer.M.C -> Buffer.B -> Device.Size -> IndexType -> IO ()
bindIndexBuffer :: C -> B -> Size -> IndexType -> IO ()
bindIndexBuffer
	(CommandBuffer.M.C IORef P
_ C
cb) (Buffer.B B
ib) (Device.Size Word64
sz) (IndexType Word32
it) =
	C -> B -> Word64 -> Word32 -> IO ()
C.bindIndexBuffer C
cb B
ib Word64
sz Word32
it

pushConstants :: forall as . PokableList as =>
	CommandBuffer.M.C -> Pipeline.Layout.P ->
	ShaderStageFlags -> Word32 -> HeteroParList.L as -> IO ()
pushConstants :: forall (as :: [*]).
PokableList as =>
C -> P -> ShaderStageFlags -> Word32 -> L as -> IO ()
pushConstants (CommandBuffer.M.C IORef P
_ C
cb) (Pipeline.Layout.P P
lyt)
	(ShaderStageFlagBits Word32
ss) Word32
ost L as
xs = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	let	sz :: Integral n => n
		sz :: forall n. Integral n => n
sz = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> Int -> n
forall a b. (a -> b) -> a -> b
$ forall (as :: [*]). SizeAlignmentList as => Int
wholeSize @as
	p <- ((Ptr () -> IO ()) -> IO ()) -> ContT () IO (Ptr ())
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr () -> IO ()) -> IO ()) -> ContT () IO (Ptr ()))
-> ((Ptr () -> IO ()) -> IO ()) -> ContT () IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr () -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
forall n. Integral n => n
sz
	lift do	pokeList p xs
		C.pushConstants cb lyt ss ost sz p

bindDescriptorSets ::
	CommandBuffer.M.C -> Pipeline.BindPoint -> Pipeline.Layout.P ->
	Word32 -> [Descriptor.Set.D] -> [Word32] -> IO ()
bindDescriptorSets :: C -> BindPoint -> P -> Word32 -> [D] -> [Word32] -> IO ()
bindDescriptorSets
	(CommandBuffer.M.C IORef P
_ C
cb) (Pipeline.BindPoint Word32
bp) (Pipeline.Layout.P P
lyt)
	Word32
fs ([D] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([D] -> Int) -> ([D] -> [D]) -> [D] -> (Int, [D])
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')
&&& [D] -> [D]
forall a. a -> a
id -> (Int
dsc, [D]
dss))
	([Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Word32] -> Int)
-> ([Word32] -> [Word32]) -> [Word32] -> (Int, [Word32])
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')
&&& [Word32] -> [Word32]
forall a. a -> a
id -> (Int
doc, [Word32]
dos)) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	pdss <- ((Ptr D -> IO ()) -> IO ()) -> ContT () IO (Ptr D)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr D -> IO ()) -> IO ()) -> ContT () IO (Ptr D))
-> ((Ptr D -> IO ()) -> IO ()) -> ContT () IO (Ptr D)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr D -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
dsc
	let	cdss = (\(Descriptor.Set.D D
s) -> D
s) (D -> D) -> [D] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [D]
dss
	lift $ pokeArray pdss cdss
	pdos <- ContT $ allocaArray doc
	lift $ pokeArray pdos dos
	lift $ C.bindDescriptorSets
		cb bp lyt fs (fromIntegral dsc) pdss (fromIntegral doc) pdos

draw :: CommandBuffer.M.C -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
draw :: C -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
draw (CommandBuffer.M.C IORef P
_ C
cb) Word32
vc Word32
ic Word32
fv Word32
fi = C -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
C.draw C
cb Word32
vc Word32
ic Word32
fv Word32
fi

drawIndexed :: CommandBuffer.M.C ->
	Word32 -> Word32 -> Word32 -> Int32 -> Word32 -> IO ()
drawIndexed :: C -> Word32 -> Word32 -> Word32 -> Int32 -> Word32 -> IO ()
drawIndexed (CommandBuffer.M.C IORef P
_ C
cb) Word32
idxc Word32
istc Word32
fidx Int32
vo Word32
fist =
	C -> Word32 -> Word32 -> Word32 -> Int32 -> Word32 -> IO ()
C.drawIndexed C
cb Word32
idxc Word32
istc Word32
fidx Int32
vo Word32
fist

dispatch :: CommandBuffer.M.C -> Word32 -> Word32 -> Word32 -> IO ()
dispatch :: C -> Word32 -> Word32 -> Word32 -> IO ()
dispatch (CommandBuffer.M.C IORef P
_ C
cb) = C -> Word32 -> Word32 -> Word32 -> IO ()
C.dispatch C
cb

copyBuffer ::
	CommandBuffer.M.C -> Buffer.B -> Buffer.B -> [Buffer.C.Copy] -> IO ()
copyBuffer :: C -> B -> B -> [Copy] -> IO ()
copyBuffer (CommandBuffer.M.C IORef P
_ C
c) (Buffer.B B
s) (Buffer.B B
d)
	([Copy] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Copy] -> Int) -> ([Copy] -> [Copy]) -> [Copy] -> (Int, [Copy])
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')
&&& [Copy] -> [Copy]
forall a. a -> a
id -> (Int
rc, [Copy]
rs)) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	prs <- ((Ptr Copy -> IO ()) -> IO ()) -> ContT () IO (Ptr Copy)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Copy -> IO ()) -> IO ()) -> ContT () IO (Ptr Copy))
-> ((Ptr Copy -> IO ()) -> IO ()) -> ContT () IO (Ptr Copy)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Copy -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
rc
	lift do	pokeArray prs rs
		C.copyBuffer c s d (fromIntegral rc) prs

copyBufferToImage ::
	CommandBuffer.M.C -> Buffer.M.B -> Image.I -> Image.Layout ->
	[Buffer.M.ImageCopy] -> IO ()
copyBufferToImage :: C -> B -> I -> Layout -> [ImageCopy] -> IO ()
copyBufferToImage (CommandBuffer.M.C IORef P
_ C
cb)
	(Buffer.M.B B
sb) (Image.I IORef (Extent3d, I)
rdi) (Image.Layout Word32
dil)
	([ImageCopy] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ImageCopy] -> Int)
-> ([ImageCopy] -> [ImageCopy])
-> [ImageCopy]
-> (Int, [ImageCopy])
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')
&&& [ImageCopy] -> [ImageCopy]
forall a. a -> a
id -> (Int
rc, [ImageCopy]
rs)) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	prs <- ((Ptr ImageCopy -> IO ()) -> IO ()) -> ContT () IO (Ptr ImageCopy)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ImageCopy -> IO ()) -> IO ())
 -> ContT () IO (Ptr ImageCopy))
-> ((Ptr ImageCopy -> IO ()) -> IO ())
-> ContT () IO (Ptr ImageCopy)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr ImageCopy -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
rc
	lift . pokeArray prs $ Buffer.M.imageCopyToCore <$> rs
	lift do	(_, di) <- readIORef rdi
		C.copyBufferToImage cb sb di dil (fromIntegral rc) prs

copyImageToBuffer ::
	CommandBuffer.M.C -> Image.I -> Image.Layout -> Buffer.M.B ->
	[Buffer.M.ImageCopy] -> IO ()
copyImageToBuffer :: C -> I -> Layout -> B -> [ImageCopy] -> IO ()
copyImageToBuffer (CommandBuffer.M.C IORef P
_ C
cb)
	(Image.I IORef (Extent3d, I)
rsi) (Image.Layout Word32
sil) (Buffer.M.B B
db)
	([ImageCopy] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ImageCopy] -> Int)
-> ([ImageCopy] -> [ImageCopy])
-> [ImageCopy]
-> (Int, [ImageCopy])
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')
&&& [ImageCopy] -> [ImageCopy]
forall a. a -> a
id -> (Int
rc, [ImageCopy]
rs)) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	prs <- ((Ptr ImageCopy -> IO ()) -> IO ()) -> ContT () IO (Ptr ImageCopy)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ImageCopy -> IO ()) -> IO ())
 -> ContT () IO (Ptr ImageCopy))
-> ((Ptr ImageCopy -> IO ()) -> IO ())
-> ContT () IO (Ptr ImageCopy)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr ImageCopy -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
rc
	lift . pokeArray prs $ Buffer.M.imageCopyToCore <$> rs
	lift do	(_, si) <- readIORef rsi
		C.copyImageToBuffer cb si sil db (fromIntegral rc) prs

pipelineBarrier :: (
	HeteroParList.ToListWithCCpsM' WithPoked TMaybe.M ns,
	HeteroParList.ToListWithCCpsM' WithPoked TMaybe.M ns',
	HeteroParList.ToListWithCCpsM' WithPoked TMaybe.M ns'' ) =>
	CommandBuffer.M.C -> Pipeline.StageFlags -> Pipeline.StageFlags ->
	DependencyFlags ->
	HeteroParList.PL Memory.M.Barrier ns ->
	HeteroParList.PL Buffer.M.MemoryBarrier ns' ->
	HeteroParList.PL Image.MemoryBarrier ns'' -> IO ()
pipelineBarrier :: forall (ns :: [Maybe (*)]) (ns' :: [Maybe (*)])
       (ns'' :: [Maybe (*)]).
(ToListWithCCpsM' WithPoked M ns, ToListWithCCpsM' WithPoked M ns',
 ToListWithCCpsM' WithPoked M ns'') =>
C
-> StageFlags
-> StageFlags
-> DependencyFlags
-> PL Barrier ns
-> PL MemoryBarrier ns'
-> PL MemoryBarrier ns''
-> IO ()
pipelineBarrier (CommandBuffer.M.C IORef P
_ C
cb)
	(Pipeline.StageFlagBits Word32
ssm) (Pipeline.StageFlagBits Word32
dsm)
	(DependencyFlagBits Word32
dfs)
	PL Barrier ns
mbs PL MemoryBarrier ns'
bbs PL MemoryBarrier ns''
ibs =
		forall {k'} {k1} k2 (c :: k' -> Constraint) (t' :: k2 -> k')
       (ns :: [k2]) (t :: k2 -> *) (m :: k1 -> *) a (b :: k1).
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
forall k2 (c :: * -> Constraint) (t' :: k2 -> *) (ns :: [k2])
       (t :: k2 -> *) (m :: * -> *) a b.
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
HeteroParList.withListWithCCpsM' @_ @WithPoked @TMaybe.M PL Barrier ns
mbs Barrier s -> (Barrier -> IO ()) -> IO ()
forall (s :: Maybe (*)).
WithPoked (M s) =>
Barrier s -> (Barrier -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
Barrier mn -> (Barrier -> IO a) -> IO ()
Memory.M.barrierToCore \[Barrier]
cmbs ->
		let	mbc :: Int
mbc = [Barrier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Barrier]
cmbs in
		Int -> (Ptr Barrier -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
mbc \Ptr Barrier
pmbs ->
		Ptr Barrier -> [Barrier] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Barrier
pmbs [Barrier]
cmbs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		forall {k'} {k1} k2 (c :: k' -> Constraint) (t' :: k2 -> k')
       (ns :: [k2]) (t :: k2 -> *) (m :: k1 -> *) a (b :: k1).
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
forall k2 (c :: * -> Constraint) (t' :: k2 -> *) (ns :: [k2])
       (t :: k2 -> *) (m :: * -> *) a b.
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
HeteroParList.withListWithCCpsM' @_ @WithPoked @TMaybe.M PL MemoryBarrier ns'
bbs MemoryBarrier s -> (MemoryBarrier -> IO ()) -> IO ()
forall (s :: Maybe (*)).
WithPoked (M s) =>
MemoryBarrier s -> (MemoryBarrier -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
MemoryBarrier mn -> (MemoryBarrier -> IO a) -> IO ()
Buffer.M.memoryBarrierToCore' \[MemoryBarrier]
cbbs ->
		let	bbc :: Int
bbc = [MemoryBarrier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MemoryBarrier]
cbbs in
		Int -> (Ptr MemoryBarrier -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bbc \Ptr MemoryBarrier
pbbs ->
		Ptr MemoryBarrier -> [MemoryBarrier] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MemoryBarrier
pbbs [MemoryBarrier]
cbbs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
		forall {k'} {k1} k2 (c :: k' -> Constraint) (t' :: k2 -> k')
       (ns :: [k2]) (t :: k2 -> *) (m :: k1 -> *) a (b :: k1).
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
forall k2 (c :: * -> Constraint) (t' :: k2 -> *) (ns :: [k2])
       (t :: k2 -> *) (m :: * -> *) a b.
ToListWithCCpsM' c t' ns =>
PL t ns
-> (forall (s :: k2). c (t' s) => t s -> (a -> m b) -> m b)
-> ([a] -> m b)
-> m b
HeteroParList.withListWithCCpsM' @_ @WithPoked @TMaybe.M PL MemoryBarrier ns''
ibs MemoryBarrier s -> (MemoryBarrier -> IO ()) -> IO ()
forall (s :: Maybe (*)).
WithPoked (M s) =>
MemoryBarrier s -> (MemoryBarrier -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
MemoryBarrier mn -> (MemoryBarrier -> IO a) -> IO ()
Image.memoryBarrierToCore \[MemoryBarrier]
cibs ->
		let	ibc :: Int
ibc = [MemoryBarrier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MemoryBarrier]
cibs in
		Int -> (Ptr MemoryBarrier -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ibc \Ptr MemoryBarrier
pibs ->
		Ptr MemoryBarrier -> [MemoryBarrier] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MemoryBarrier
pibs [MemoryBarrier]
cibs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>

		C
-> Word32
-> Word32
-> Word32
-> Word32
-> Ptr Barrier
-> Word32
-> Ptr MemoryBarrier
-> Word32
-> Ptr MemoryBarrier
-> IO ()
C.pipelineBarrier C
cb Word32
ssm Word32
dsm Word32
dfs (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mbc) Ptr Barrier
pmbs
			(Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bbc) Ptr MemoryBarrier
pbbs (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ibc) Ptr MemoryBarrier
pibs

pipelineBarrier2 :: (
	WithPoked (TMaybe.M mn),
	HPList.ToListWithCCpsM' WithPoked TMaybe.M mbas, TList.Length mbas,
	HPList.ToListWithCCpsM' WithPoked TMaybe.M bmbas, TList.Length bmbas,
	HPList.ToListWithCCpsM' WithPoked TMaybe.M imbas, TList.Length imbas
	) =>
	CommandBuffer.M.C -> DependencyInfo mn mbas bmbas imbas -> IO ()
pipelineBarrier2 :: forall (mn :: Maybe (*)) (mbas :: [Maybe (*)])
       (bmbas :: [Maybe (*)]) (imbas :: [Maybe (*)]).
(WithPoked (M mn), ToListWithCCpsM' WithPoked M mbas, Length mbas,
 ToListWithCCpsM' WithPoked M bmbas, Length bmbas,
 ToListWithCCpsM' WithPoked M imbas, Length imbas) =>
C -> DependencyInfo mn mbas bmbas imbas -> IO ()
pipelineBarrier2 (CommandBuffer.M.C IORef P
_ C
cb) DependencyInfo mn mbas bmbas imbas
di =
	DependencyInfo mn mbas bmbas imbas
-> (DependencyInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (mbs :: [Maybe (*)]) (bmbs :: [Maybe (*)])
       (imbs :: [Maybe (*)]) a.
(WithPoked (M mn), ToListWithCCpsM' WithPoked M mbs, Length mbs,
 ToListWithCCpsM' WithPoked M bmbs, Length bmbs,
 ToListWithCCpsM' WithPoked M imbs, Length imbs) =>
DependencyInfo mn mbs bmbs imbs
-> (DependencyInfo -> IO a) -> IO ()
dependencyInfoToCore DependencyInfo mn mbas bmbas imbas
di \DependencyInfo
cdi -> (Ptr DependencyInfo -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DependencyInfo
pdi -> do
		Ptr DependencyInfo -> DependencyInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DependencyInfo
pdi DependencyInfo
cdi
		C -> Ptr DependencyInfo -> IO ()
C.pipelineBarrier2 C
cb Ptr DependencyInfo
pdi

blitImage :: CommandBuffer.M.C ->
	Image.I -> Image.Layout -> Image.I -> Image.Layout ->
	[Image.Blit] -> Filter -> IO ()
blitImage :: C -> I -> Layout -> I -> Layout -> [Blit] -> Filter -> IO ()
blitImage (CommandBuffer.M.C IORef P
_ C
cb)
	(Image.I IORef (Extent3d, I)
rsrc) (Image.Layout Word32
srcLyt) (Image.I IORef (Extent3d, I)
rdst) (Image.Layout Word32
dstLyt)
	([Blit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Blit] -> Int) -> ([Blit] -> [Blit]) -> [Blit] -> (Int, [Blit])
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')
&&& [Blit] -> [Blit]
forall a. a -> a
id -> (Int
bltc, [Blit]
blts)) (Filter Word32
ft) = (((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (((() -> IO ()) -> IO ()) -> IO ())
-> ((() -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContT () IO () -> (() -> IO ()) -> IO ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT do
	pblts <- ((Ptr Blit -> IO ()) -> IO ()) -> ContT () IO (Ptr Blit)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Blit -> IO ()) -> IO ()) -> ContT () IO (Ptr Blit))
-> ((Ptr Blit -> IO ()) -> IO ()) -> ContT () IO (Ptr Blit)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Blit -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bltc
	lift . pokeArray pblts $ Image.blitToCore <$> blts
	lift do (_, src) <- readIORef rsrc
		(_, dst) <- readIORef rdst
		C.blitImage cb src srcLyt dst dstLyt (fromIntegral bltc) pblts ft

blitImage2 :: (
	WithPoked (TMaybe.M mn),
	TList.Length ras, HPList.ToListWithCCpsM' WithPoked TMaybe.M ras ) =>
	CommandBuffer.M.C -> BlitImageInfo2 mn ras -> IO ()
blitImage2 :: forall (mn :: Maybe (*)) (ras :: [Maybe (*)]).
(WithPoked (M mn), Length ras, ToListWithCCpsM' WithPoked M ras) =>
C -> BlitImageInfo2 mn ras -> IO ()
blitImage2 (CommandBuffer.M.C IORef P
_ C
cb) BlitImageInfo2 mn ras
bii =
	BlitImageInfo2 mn ras -> (Ptr BlitImageInfo2 -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (ras :: [Maybe (*)]) a.
(Length ras, ToListWithCCpsM' WithPoked M ras, WithPoked (M mn)) =>
BlitImageInfo2 mn ras -> (Ptr BlitImageInfo2 -> IO a) -> IO ()
blitImageInfo2ToCore BlitImageInfo2 mn ras
bii \Ptr BlitImageInfo2
pcbii -> C -> Ptr BlitImageInfo2 -> IO ()
C.blitImage2 C
cb Ptr BlitImageInfo2
pcbii

resetQueryPool :: CommandBuffer.M.C -> QueryPool.Q -> Word32 -> Word32 -> IO ()
resetQueryPool :: C -> Q -> Word32 -> Word32 -> IO ()
resetQueryPool (CommandBuffer.M.C IORef P
_ C
c) (QueryPool.Q Q
q) Word32
fq Word32
qc =
	C -> Q -> Word32 -> Word32 -> IO ()
C.resetQueryPool C
c Q
q Word32
fq Word32
qc

beginQuery :: CommandBuffer.M.C ->
	QueryPool.Q -> Word32 -> Query.ControlFlags -> IO ()
beginQuery :: C -> Q -> Word32 -> ControlFlags -> IO ()
beginQuery (CommandBuffer.M.C IORef P
_ C
c) (QueryPool.Q Q
q) Word32
i (Query.ControlFlagBits Word32
flgs) =
	C -> Q -> Word32 -> Word32 -> IO ()
C.beginQuery C
c Q
q Word32
i Word32
flgs

endQuery :: CommandBuffer.M.C -> QueryPool.Q -> Word32 -> IO ()
endQuery :: C -> Q -> Word32 -> IO ()
endQuery (CommandBuffer.M.C IORef P
_ C
c) (QueryPool.Q Q
q) = C -> Q -> Word32 -> IO ()
C.endQuery C
c Q
q

writeTimestamp :: CommandBuffer.M.C -> Pipeline.StageFlagBits ->
	QueryPool.Q -> Word32 -> IO ()
writeTimestamp :: C -> StageFlags -> Q -> Word32 -> IO ()
writeTimestamp
	(CommandBuffer.M.C IORef P
_ C
c) (Pipeline.StageFlagBits Word32
fls) (QueryPool.Q Q
q) Word32
i =
	C -> Word32 -> Q -> Word32 -> IO ()
C.writeTimestamp C
c Word32
fls Q
q Word32
i

clearColorImage :: ClearColorValueToCore cct =>
	CommandBuffer.M.C -> Image.I -> Image.Layout ->
	ClearValue ('ClearTypeColor cct) -> [Image.SubresourceRange] -> IO ()
clearColorImage :: forall (cct :: ClearColorType).
ClearColorValueToCore cct =>
C
-> I
-> Layout
-> ClearValue ('ClearTypeColor cct)
-> [SubresourceRange]
-> IO ()
clearColorImage
	(CommandBuffer.M.C IORef P
_ C
cb) (Image.I IORef (Extent3d, I)
rimg) (Image.Layout Word32
lyt) ClearValue ('ClearTypeColor cct)
cv [SubresourceRange]
srrs =
	IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
rimg IO (Extent3d, I) -> ((Extent3d, I) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Extent3d
_, I
img) ->
	ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO ()) -> IO ()
forall a.
ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO a) -> IO a
forall (cct :: ClearColorType) a.
ClearColorValueToCore cct =>
ClearValue ('ClearTypeColor cct)
-> (Ptr ClearColorValue -> IO a) -> IO a
clearColorValueToCore ClearValue ('ClearTypeColor cct)
cv \Ptr ClearColorValue
ccv ->
	Int -> (Ptr SubresourceRange -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([SubresourceRange] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubresourceRange]
srrs) \Ptr SubresourceRange
psrrs ->
	Ptr SubresourceRange -> [SubresourceRange] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr SubresourceRange
psrrs (SubresourceRange -> SubresourceRange
Image.subresourceRangeToCore (SubresourceRange -> SubresourceRange)
-> [SubresourceRange] -> [SubresourceRange]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SubresourceRange]
srrs) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	C
-> I
-> Word32
-> Ptr ClearColorValue
-> Word32
-> Ptr SubresourceRange
-> IO ()
C.clearColorImage C
cb I
img Word32
lyt Ptr ClearColorValue
ccv ([SubresourceRange] -> Word32
forall i a. Num i => [a] -> i
L.genericLength [SubresourceRange]
srrs) Ptr SubresourceRange
psrrs