{-# 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,

	-- * MEMORY DEPENDENCY

	pipelineBarrier,

	-- * QUERY

	resetQueryPool, beginQuery, endQuery, writeTimestamp

	) where

import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
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.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
	P
ppl0 <- IORef P -> IO P
forall a. IORef a -> IO a
readIORef IORef P
rppl
	P
ppl' <- G -> IO P
Pipeline.gToCore G
ppl
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (P
ppl' P -> P -> Bool
forall a. Eq a => a -> a -> Bool
/= P
ppl0) do
		IORef P -> P -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef P
rppl P
ppl'
		C -> Word32 -> P -> IO ()
C.bindPipeline C
cb Word32
pbp P
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
	P
ppl0 <- IORef P -> IO P
forall a. IORef a -> IO a
readIORef IORef P
rppl
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (P
ppl P -> P -> Bool
forall a. Eq a => a -> a -> Bool
/= P
ppl0) do
		IORef P -> P -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef P
rppl P
ppl
		C -> Word32 -> P -> IO ()
C.bindPipeline C
cb Word32
pbp P
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
	Ptr B
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ())
-> ([B] -> IO ()) -> [B] -> ContT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr B -> [B] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr B
pb ([B] -> ContT () IO ()) -> [B] -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ (\(Buffer.B B
b) -> B
b) (B -> B) -> [B] -> [B]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [B]
bs
	Ptr Word64
po <- ((Ptr Word64 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word64)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word64 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word64))
-> ((Ptr Word64 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word64)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word64 -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bc
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ())
-> ([Word64] -> IO ()) -> [Word64] -> ContT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
po ([Word64] -> ContT () IO ()) -> [Word64] -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ (\(Device.Size Word64
sz) -> Word64
sz) (Size -> Word64) -> [Size] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Size]
os
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ C -> Word32 -> Word32 -> Ptr B -> Ptr Word64 -> IO ()
C.bindVertexBuffers C
c Word32
fb (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc) Ptr B
pb Ptr Word64
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
	Ptr ()
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do	Ptr () -> L as -> IO ()
forall (as :: [*]) x. PokableList as => Ptr x -> L as -> IO ()
forall x. Ptr x -> L as -> IO ()
pokeList Ptr ()
p L as
xs
		C -> P -> Word32 -> Word32 -> Word32 -> Ptr () -> IO ()
C.pushConstants C
cb P
lyt Word32
ss Word32
ost Word32
forall n. Integral n => n
sz Ptr ()
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
	Ptr D
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 :: [D]
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr D -> [D] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr D
pdss [D]
cdss
	Ptr Word32
pdos <- ((Ptr Word32 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word32)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word32))
-> ((Ptr Word32 -> IO ()) -> IO ()) -> ContT () IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word32 -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
doc
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> [Word32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word32
pdos [Word32]
dos
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ C
-> Word32
-> P
-> Word32
-> Word32
-> Ptr D
-> Word32
-> Ptr Word32
-> IO ()
C.bindDescriptorSets
		C
cb Word32
bp P
lyt Word32
fs (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dsc) Ptr D
pdss (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
doc) Ptr Word32
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
	Ptr Copy
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do	Ptr Copy -> [Copy] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Copy
prs [Copy]
rs
		C -> B -> B -> Word32 -> Ptr Copy -> IO ()
C.copyBuffer C
c B
s B
d (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rc) Ptr Copy
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
	Ptr ImageCopy
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ())
-> ([ImageCopy] -> IO ()) -> [ImageCopy] -> ContT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ImageCopy -> [ImageCopy] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr ImageCopy
prs ([ImageCopy] -> ContT () IO ()) -> [ImageCopy] -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ImageCopy -> ImageCopy
Buffer.M.imageCopyToCore (ImageCopy -> ImageCopy) -> [ImageCopy] -> [ImageCopy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImageCopy]
rs
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do	(Extent3d
_, I
di) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
rdi
		C -> B -> I -> Word32 -> Word32 -> Ptr ImageCopy -> IO ()
C.copyBufferToImage C
cb B
sb I
di Word32
dil (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rc) Ptr ImageCopy
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
	Ptr ImageCopy
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ())
-> ([ImageCopy] -> IO ()) -> [ImageCopy] -> ContT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr ImageCopy -> [ImageCopy] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr ImageCopy
prs ([ImageCopy] -> ContT () IO ()) -> [ImageCopy] -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ImageCopy -> ImageCopy
Buffer.M.imageCopyToCore (ImageCopy -> ImageCopy) -> [ImageCopy] -> [ImageCopy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImageCopy]
rs
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do	(Extent3d
_, I
si) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
rsi
		C -> I -> Word32 -> B -> Word32 -> Ptr ImageCopy -> IO ()
C.copyImageToBuffer C
cb I
si Word32
sil B
db (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rc) Ptr ImageCopy
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

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
	Ptr Blit
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
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ())
-> ([Blit] -> IO ()) -> [Blit] -> ContT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Blit -> [Blit] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Blit
pblts ([Blit] -> ContT () IO ()) -> [Blit] -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Blit -> Blit
Image.blitToCore (Blit -> Blit) -> [Blit] -> [Blit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Blit]
blts
	IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do (Extent3d
_, I
src) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
rsrc
		(Extent3d
_, I
dst) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
rdst
		C
-> I
-> Word32
-> I
-> Word32
-> Word32
-> Ptr Blit
-> Word32
-> IO ()
C.blitImage C
cb I
src Word32
srcLyt I
dst Word32
dstLyt (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bltc) Ptr Blit
pblts Word32
ft

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