{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : WGPU.Internal.Queue
-- Description : Queues
module WGPU.Internal.Queue
  ( -- * Types
    Queue,

    -- * Functions
    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

-------------------------------------------------------------------------------

-- | Get the queue for a device.
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
..}

-- | Submit a list of command buffers to a device queue.
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

-------------------------------------------------------------------------------

-- | Schedule a data write into a texture.
queueWriteTexture ::
  forall m a.
  (MonadIO m, ReadableMemoryBuffer a) =>
  -- | Queue to which the texture write will be submitted.
  Queue ->
  -- | View of a texture which will be copied.
  ImageCopyTexture ->
  -- | Layout of the texture in a buffer's memory.
  TextureDataLayout ->
  -- | Extent of the texture operation.
  Extent3D ->
  -- | A 'ReadableMemoryBuffer' from which to copy. All of the buffer is copied
  -- (as determined by its 'readableMemoryBufferSize').
  a ->
  -- | Action to copy the texture
  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

-- | Schedule a data write into a buffer.
queueWriteBuffer ::
  forall m a.
  (MonadIO m, ReadableMemoryBuffer a) =>
  -- | Queue to which the buffer write will be submitted.
  Queue ->
  -- | Buffer in which to write.
  Buffer ->
  -- | A 'ReadableMemoryBuffer' from which to copy. All of the buffer is copied
  -- (as determined by its 'readableMemoryBufferSize').
  a ->
  -- | Action which copies the buffer data.
  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)