{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module WGPU.Internal.Queue
(
Queue,
getQueue,
queueSubmit,
queueWriteTexture,
queueWriteBuffer,
)
where
import Control.Monad.Cont (ContT (ContT))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Vector (Vector)
import Foreign (castPtr)
import WGPU.Internal.Buffer (Buffer, wgpuBuffer)
import WGPU.Internal.CommandBuffer (CommandBuffer)
import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)
import WGPU.Internal.Instance (Instance, wgpuHsInstance)
import WGPU.Internal.Memory
( ReadableMemoryBuffer,
ToRaw,
evalContT,
raw,
rawArrayPtr,
rawPtr,
readableMemoryBufferSize,
showWithPtr,
toCSize,
withReadablePtr,
)
import WGPU.Internal.Multipurpose
( Extent3D,
ImageCopyTexture,
TextureDataLayout,
)
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Types (WGPUQueue (WGPUQueue))
data Queue = Queue
{ Queue -> Instance
queueInst :: !Instance,
Queue -> WGPUQueue
wgpuQueue :: !WGPUQueue
}
instance Show Queue where
show :: Queue -> String
show Queue
q =
let Queue Instance
_ (WGPUQueue Ptr ()
ptr) = Queue
q
in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"Queue" Ptr ()
ptr
instance Eq Queue where
== :: Queue -> Queue -> Bool
(==) Queue
q1 Queue
q2 =
let Queue Instance
_ (WGPUQueue Ptr ()
q1_ptr) = Queue
q1
Queue Instance
_ (WGPUQueue Ptr ()
q2_ptr) = Queue
q2
in Ptr ()
q1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
q2_ptr
instance ToRaw Queue WGPUQueue where
raw :: Queue -> ContT r IO WGPUQueue
raw = WGPUQueue -> ContT r IO WGPUQueue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUQueue -> ContT r IO WGPUQueue)
-> (Queue -> WGPUQueue) -> Queue -> ContT r IO WGPUQueue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Queue -> WGPUQueue
wgpuQueue
getQueue :: MonadIO m => Device -> m Queue
getQueue :: Device -> m Queue
getQueue Device
device = do
let queueInst :: Instance
queueInst = Device -> Instance
deviceInst Device
device
WGPUQueue
wgpuQueue <-
WGPUHsInstance -> WGPUDevice -> m WGPUQueue
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance -> WGPUDevice -> m WGPUQueue
RawFun.wgpuDeviceGetQueue (Instance -> WGPUHsInstance
wgpuHsInstance Instance
queueInst) (Device -> WGPUDevice
wgpuDevice Device
device)
Queue -> m Queue
forall (f :: * -> *) a. Applicative f => a -> f a
pure Queue :: Instance -> WGPUQueue -> Queue
Queue {WGPUQueue
Instance
wgpuQueue :: WGPUQueue
queueInst :: Instance
wgpuQueue :: WGPUQueue
queueInst :: Instance
..}
queueSubmit :: MonadIO m => Queue -> Vector CommandBuffer -> m ()
queueSubmit :: Queue -> Vector CommandBuffer -> m ()
queueSubmit Queue
queue Vector CommandBuffer
cbs = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT () IO () -> m ()) -> ContT () IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let inst :: Instance
inst = Queue -> Instance
queueInst Queue
queue
let commandCount :: Word32
commandCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector CommandBuffer -> Int) -> Vector CommandBuffer -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector CommandBuffer -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector CommandBuffer -> Word32) -> Vector CommandBuffer -> Word32
forall a b. (a -> b) -> a -> b
$ Vector CommandBuffer
cbs
Ptr WGPUCommandBuffer
commandBuffer_ptr <- Vector CommandBuffer -> ContT () IO (Ptr WGPUCommandBuffer)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector CommandBuffer
cbs
WGPUHsInstance
-> WGPUQueue -> Word32 -> Ptr WGPUCommandBuffer -> ContT () IO ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUQueue -> Word32 -> Ptr WGPUCommandBuffer -> m ()
RawFun.wgpuQueueSubmit
(Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
(Queue -> WGPUQueue
wgpuQueue Queue
queue)
Word32
commandCount
Ptr WGPUCommandBuffer
commandBuffer_ptr
queueWriteTexture ::
forall m a.
(MonadIO m, ReadableMemoryBuffer a) =>
Queue ->
ImageCopyTexture ->
TextureDataLayout ->
Extent3D ->
a ->
m ()
queueWriteTexture :: Queue
-> ImageCopyTexture -> TextureDataLayout -> Extent3D -> a -> m ()
queueWriteTexture Queue
queue ImageCopyTexture
imageCopyTexture TextureDataLayout
textureDataLayout Extent3D
extent3d a
content =
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT () IO () -> m ()) -> ContT () IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let inst :: Instance
inst = Queue -> Instance
queueInst Queue
queue
let content_sz :: ByteSize
content_sz = a -> ByteSize
forall a. ReadableMemoryBuffer a => a -> ByteSize
readableMemoryBufferSize a
content
Ptr ()
content_ptr <- ((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
$ a -> (Ptr () -> IO ()) -> IO ()
forall a b. ReadableMemoryBuffer a => a -> (Ptr () -> IO b) -> IO b
withReadablePtr a
content
Ptr WGPUImageCopyTexture
imageCopyTexture_ptr <- ImageCopyTexture -> ContT () IO (Ptr WGPUImageCopyTexture)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr ImageCopyTexture
imageCopyTexture
Ptr WGPUTextureDataLayout
textureDataLayout_ptr <- TextureDataLayout -> ContT () IO (Ptr WGPUTextureDataLayout)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr TextureDataLayout
textureDataLayout
Ptr WGPUExtent3D
extent3d_ptr <- Extent3D -> ContT () IO (Ptr WGPUExtent3D)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Extent3D
extent3d
WGPUHsInstance
-> WGPUQueue
-> Ptr WGPUImageCopyTexture
-> Ptr ()
-> CSize
-> Ptr WGPUTextureDataLayout
-> Ptr WGPUExtent3D
-> ContT () IO ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUQueue
-> Ptr WGPUImageCopyTexture
-> Ptr ()
-> CSize
-> Ptr WGPUTextureDataLayout
-> Ptr WGPUExtent3D
-> m ()
RawFun.wgpuQueueWriteTexture
(Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
(Queue -> WGPUQueue
wgpuQueue Queue
queue)
Ptr WGPUImageCopyTexture
imageCopyTexture_ptr
Ptr ()
content_ptr
(ByteSize -> CSize
toCSize ByteSize
content_sz)
Ptr WGPUTextureDataLayout
textureDataLayout_ptr
Ptr WGPUExtent3D
extent3d_ptr
queueWriteBuffer ::
forall m a.
(MonadIO m, ReadableMemoryBuffer a) =>
Queue ->
Buffer ->
a ->
m ()
queueWriteBuffer :: Queue -> Buffer -> a -> m ()
queueWriteBuffer Queue
queue Buffer
buffer a
content = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT () IO () -> m ()) -> ContT () IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let inst :: Instance
inst = Queue -> Instance
queueInst Queue
queue
let content_sz :: ByteSize
content_sz = a -> ByteSize
forall a. ReadableMemoryBuffer a => a -> ByteSize
readableMemoryBufferSize a
content
Ptr ()
content_ptr <- ((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
$ a -> (Ptr () -> IO ()) -> IO ()
forall a b. ReadableMemoryBuffer a => a -> (Ptr () -> IO b) -> IO b
withReadablePtr a
content
WGPUHsInstance
-> WGPUQueue
-> WGPUBuffer
-> Word64
-> Ptr ()
-> CSize
-> ContT () IO ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUQueue -> WGPUBuffer -> Word64 -> Ptr () -> CSize -> m ()
RawFun.wgpuQueueWriteBuffer
(Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
(Queue -> WGPUQueue
wgpuQueue Queue
queue)
(Buffer -> WGPUBuffer
wgpuBuffer Buffer
buffer)
Word64
0
(Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
content_ptr)
(ByteSize -> CSize
toCSize ByteSize
content_sz)