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

-- |
-- Module      : WGPU.Internal.RenderPass
-- Description : Render passes.
module WGPU.Internal.RenderPass
  ( -- * Types
    RenderPipeline (..),
    RenderPassEncoder,
    LoadOp (..),
    StoreOp (..),
    Operations (..),
    RenderPassColorAttachment (..),
    RenderPassDepthStencilAttachment (..),
    RenderPassDescriptor (..),
    Range (..),

    -- * Functions
    beginRenderPass,
    renderPassSetPipeline,
    renderPassDraw,
    endRenderPass,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Word (Word32)
import Foreign (nullPtr)
import Foreign.C (CBool (CBool), CFloat (CFloat))
import WGPU.Internal.Color (Color, transparentBlack)
import WGPU.Internal.CommandEncoder
  ( CommandEncoder,
    commandEncoderInst,
    wgpuCommandEncoder,
  )
import WGPU.Internal.Instance (Instance, wgpuHsInstance)
import WGPU.Internal.Memory
  ( ToRaw,
    evalContT,
    raw,
    rawArrayPtr,
    rawPtr,
    showWithPtr,
  )
import WGPU.Internal.SMaybe (SMaybe (SJust, SNothing))
import WGPU.Internal.Texture (TextureView)
import qualified WGPU.Raw.Generated.Enum.WGPULoadOp as WGPULoadOp
import WGPU.Raw.Generated.Enum.WGPUStoreOp (WGPUStoreOp)
import qualified WGPU.Raw.Generated.Enum.WGPUStoreOp as WGPUStoreOp
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPURenderPassColorAttachment (WGPURenderPassColorAttachment)
import qualified WGPU.Raw.Generated.Struct.WGPURenderPassColorAttachment as WGPURenderPassColorAttachment
import WGPU.Raw.Generated.Struct.WGPURenderPassDepthStencilAttachment (WGPURenderPassDepthStencilAttachment)
import qualified WGPU.Raw.Generated.Struct.WGPURenderPassDepthStencilAttachment as WGPURenderPassDepthStencilAttachment
import WGPU.Raw.Generated.Struct.WGPURenderPassDescriptor (WGPURenderPassDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPURenderPassDescriptor as WGPURenderPassDescriptor
import WGPU.Raw.Types
  ( WGPUQuerySet (WGPUQuerySet),
    WGPURenderPassEncoder (WGPURenderPassEncoder),
    WGPURenderPipeline (WGPURenderPipeline),
    WGPUTextureView (WGPUTextureView),
  )

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

newtype RenderPipeline = RenderPipeline {RenderPipeline -> WGPURenderPipeline
wgpuRenderPipeline :: WGPURenderPipeline}

instance Show RenderPipeline where
  show :: RenderPipeline -> String
show RenderPipeline
p =
    let RenderPipeline (WGPURenderPipeline Ptr ()
ptr) = RenderPipeline
p
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"RenderPipeline" Ptr ()
ptr

instance Eq RenderPipeline where
  == :: RenderPipeline -> RenderPipeline -> Bool
(==) RenderPipeline
p1 RenderPipeline
p2 =
    let RenderPipeline (WGPURenderPipeline Ptr ()
p1_ptr) = RenderPipeline
p1
        RenderPipeline (WGPURenderPipeline Ptr ()
p2_ptr) = RenderPipeline
p2
     in Ptr ()
p1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
p2_ptr

instance ToRaw RenderPipeline WGPURenderPipeline where
  raw :: RenderPipeline -> ContT r IO WGPURenderPipeline
raw = WGPURenderPipeline -> ContT r IO WGPURenderPipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPURenderPipeline -> ContT r IO WGPURenderPipeline)
-> (RenderPipeline -> WGPURenderPipeline)
-> RenderPipeline
-> ContT r IO WGPURenderPipeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderPipeline -> WGPURenderPipeline
wgpuRenderPipeline

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

data RenderPassEncoder = RenderPassEncoder
  { RenderPassEncoder -> Instance
renderPassEncoderInst :: !Instance,
    RenderPassEncoder -> WGPURenderPassEncoder
wgpuRenderPassEncoder :: !WGPURenderPassEncoder
  }

instance Show RenderPassEncoder where
  show :: RenderPassEncoder -> String
show RenderPassEncoder
e =
    let RenderPassEncoder Instance
_ (WGPURenderPassEncoder Ptr ()
ptr) = RenderPassEncoder
e
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"RenderPassEncoder" Ptr ()
ptr

instance Eq RenderPassEncoder where
  == :: RenderPassEncoder -> RenderPassEncoder -> Bool
(==) RenderPassEncoder
e1 RenderPassEncoder
e2 =
    let RenderPassEncoder Instance
_ (WGPURenderPassEncoder Ptr ()
e1_ptr) = RenderPassEncoder
e1
        RenderPassEncoder Instance
_ (WGPURenderPassEncoder Ptr ()
e2_ptr) = RenderPassEncoder
e2
     in Ptr ()
e1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
e2_ptr

instance ToRaw RenderPassEncoder WGPURenderPassEncoder where
  raw :: RenderPassEncoder -> ContT r IO WGPURenderPassEncoder
raw = WGPURenderPassEncoder -> ContT r IO WGPURenderPassEncoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPURenderPassEncoder -> ContT r IO WGPURenderPassEncoder)
-> (RenderPassEncoder -> WGPURenderPassEncoder)
-> RenderPassEncoder
-> ContT r IO WGPURenderPassEncoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderPassEncoder -> WGPURenderPassEncoder
wgpuRenderPassEncoder

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

-- | Operation to perform to the output attachment at the start of a render
-- pass.
data LoadOp a
  = -- | Clear with the specified color value.
    LoadOpClear !a
  | -- | Load from memory.
    LoadOpLoad
  deriving (LoadOp a -> LoadOp a -> Bool
(LoadOp a -> LoadOp a -> Bool)
-> (LoadOp a -> LoadOp a -> Bool) -> Eq (LoadOp a)
forall a. Eq a => LoadOp a -> LoadOp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadOp a -> LoadOp a -> Bool
$c/= :: forall a. Eq a => LoadOp a -> LoadOp a -> Bool
== :: LoadOp a -> LoadOp a -> Bool
$c== :: forall a. Eq a => LoadOp a -> LoadOp a -> Bool
Eq, Int -> LoadOp a -> ShowS
[LoadOp a] -> ShowS
LoadOp a -> String
(Int -> LoadOp a -> ShowS)
-> (LoadOp a -> String) -> ([LoadOp a] -> ShowS) -> Show (LoadOp a)
forall a. Show a => Int -> LoadOp a -> ShowS
forall a. Show a => [LoadOp a] -> ShowS
forall a. Show a => LoadOp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadOp a] -> ShowS
$cshowList :: forall a. Show a => [LoadOp a] -> ShowS
show :: LoadOp a -> String
$cshow :: forall a. Show a => LoadOp a -> String
showsPrec :: Int -> LoadOp a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LoadOp a -> ShowS
Show)

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

-- | Operation to perform to the output attachment at the end of the render
-- pass.
data StoreOp
  = -- | Store the result.
    StoreOpStore
  | -- | Discard the result.
    StoreOpClear
  deriving (StoreOp -> StoreOp -> Bool
(StoreOp -> StoreOp -> Bool)
-> (StoreOp -> StoreOp -> Bool) -> Eq StoreOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreOp -> StoreOp -> Bool
$c/= :: StoreOp -> StoreOp -> Bool
== :: StoreOp -> StoreOp -> Bool
$c== :: StoreOp -> StoreOp -> Bool
Eq, Int -> StoreOp -> ShowS
[StoreOp] -> ShowS
StoreOp -> String
(Int -> StoreOp -> ShowS)
-> (StoreOp -> String) -> ([StoreOp] -> ShowS) -> Show StoreOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreOp] -> ShowS
$cshowList :: [StoreOp] -> ShowS
show :: StoreOp -> String
$cshow :: StoreOp -> String
showsPrec :: Int -> StoreOp -> ShowS
$cshowsPrec :: Int -> StoreOp -> ShowS
Show)

instance ToRaw StoreOp WGPUStoreOp where
  raw :: StoreOp -> ContT r IO WGPUStoreOp
raw StoreOp
storeOp =
    WGPUStoreOp -> ContT r IO WGPUStoreOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUStoreOp -> ContT r IO WGPUStoreOp)
-> WGPUStoreOp -> ContT r IO WGPUStoreOp
forall a b. (a -> b) -> a -> b
$
      case StoreOp
storeOp of
        StoreOp
StoreOpStore -> WGPUStoreOp
forall a. (Eq a, Num a) => a
WGPUStoreOp.Store
        StoreOp
StoreOpClear -> WGPUStoreOp
forall a. (Eq a, Num a) => a
WGPUStoreOp.Clear

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

data Operations a = Operations
  { Operations a -> LoadOp a
load :: !(LoadOp a),
    Operations a -> StoreOp
store :: !StoreOp
  }
  deriving (Operations a -> Operations a -> Bool
(Operations a -> Operations a -> Bool)
-> (Operations a -> Operations a -> Bool) -> Eq (Operations a)
forall a. Eq a => Operations a -> Operations a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operations a -> Operations a -> Bool
$c/= :: forall a. Eq a => Operations a -> Operations a -> Bool
== :: Operations a -> Operations a -> Bool
$c== :: forall a. Eq a => Operations a -> Operations a -> Bool
Eq, Int -> Operations a -> ShowS
[Operations a] -> ShowS
Operations a -> String
(Int -> Operations a -> ShowS)
-> (Operations a -> String)
-> ([Operations a] -> ShowS)
-> Show (Operations a)
forall a. Show a => Int -> Operations a -> ShowS
forall a. Show a => [Operations a] -> ShowS
forall a. Show a => Operations a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operations a] -> ShowS
$cshowList :: forall a. Show a => [Operations a] -> ShowS
show :: Operations a -> String
$cshow :: forall a. Show a => Operations a -> String
showsPrec :: Int -> Operations a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Operations a -> ShowS
Show)

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

-- | Describes a color attachment to a render pass.
data RenderPassColorAttachment = RenderPassColorAttachment
  { -- | The view to use as an attachment.
    RenderPassColorAttachment -> TextureView
colorView :: !TextureView,
    -- | The view that will receive output if multisampling is used.
    RenderPassColorAttachment -> SMaybe TextureView
resolveTarget :: !(SMaybe TextureView),
    -- | What operations will be performed on this color attachment.
    RenderPassColorAttachment -> Operations Color
operations :: !(Operations Color)
  }
  deriving (RenderPassColorAttachment -> RenderPassColorAttachment -> Bool
(RenderPassColorAttachment -> RenderPassColorAttachment -> Bool)
-> (RenderPassColorAttachment -> RenderPassColorAttachment -> Bool)
-> Eq RenderPassColorAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderPassColorAttachment -> RenderPassColorAttachment -> Bool
$c/= :: RenderPassColorAttachment -> RenderPassColorAttachment -> Bool
== :: RenderPassColorAttachment -> RenderPassColorAttachment -> Bool
$c== :: RenderPassColorAttachment -> RenderPassColorAttachment -> Bool
Eq, Int -> RenderPassColorAttachment -> ShowS
[RenderPassColorAttachment] -> ShowS
RenderPassColorAttachment -> String
(Int -> RenderPassColorAttachment -> ShowS)
-> (RenderPassColorAttachment -> String)
-> ([RenderPassColorAttachment] -> ShowS)
-> Show RenderPassColorAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderPassColorAttachment] -> ShowS
$cshowList :: [RenderPassColorAttachment] -> ShowS
show :: RenderPassColorAttachment -> String
$cshow :: RenderPassColorAttachment -> String
showsPrec :: Int -> RenderPassColorAttachment -> ShowS
$cshowsPrec :: Int -> RenderPassColorAttachment -> ShowS
Show)

instance ToRaw RenderPassColorAttachment WGPURenderPassColorAttachment where
  raw :: RenderPassColorAttachment
-> ContT r IO WGPURenderPassColorAttachment
raw RenderPassColorAttachment {SMaybe TextureView
TextureView
Operations Color
operations :: Operations Color
resolveTarget :: SMaybe TextureView
colorView :: TextureView
operations :: RenderPassColorAttachment -> Operations Color
resolveTarget :: RenderPassColorAttachment -> SMaybe TextureView
colorView :: RenderPassColorAttachment -> TextureView
..} = do
    WGPUTextureView
n_view <- TextureView -> ContT r IO WGPUTextureView
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureView
colorView
    WGPUTextureView
n_resolveTarget <-
      case SMaybe TextureView
resolveTarget of
        SMaybe TextureView
SNothing -> WGPUTextureView -> ContT r IO WGPUTextureView
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr () -> WGPUTextureView
WGPUTextureView Ptr ()
forall a. Ptr a
nullPtr)
        SJust TextureView
t -> TextureView -> ContT r IO WGPUTextureView
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureView
t
    WGPUStoreOp
n_storeOp <- StoreOp -> ContT r IO WGPUStoreOp
forall a b r. ToRaw a b => a -> ContT r IO b
raw (StoreOp -> ContT r IO WGPUStoreOp)
-> (Operations Color -> StoreOp)
-> Operations Color
-> ContT r IO WGPUStoreOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operations Color -> StoreOp
forall a. Operations a -> StoreOp
store (Operations Color -> ContT r IO WGPUStoreOp)
-> Operations Color -> ContT r IO WGPUStoreOp
forall a b. (a -> b) -> a -> b
$ Operations Color
operations
    (WGPULoadOp
n_loadOp, WGPUColor
n_clearColor) <-
      case Operations Color -> LoadOp Color
forall a. Operations a -> LoadOp a
load Operations Color
operations of
        LoadOpClear Color
color -> do
          WGPUColor
n_color <- Color -> ContT r IO WGPUColor
forall a b r. ToRaw a b => a -> ContT r IO b
raw Color
color
          (WGPULoadOp, WGPUColor) -> ContT r IO (WGPULoadOp, WGPUColor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Clear, WGPUColor
n_color)
        LoadOp Color
LoadOpLoad -> do
          WGPUColor
n_color <- Color -> ContT r IO WGPUColor
forall a b r. ToRaw a b => a -> ContT r IO b
raw Color
transparentBlack
          (WGPULoadOp, WGPUColor) -> ContT r IO (WGPULoadOp, WGPUColor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Load, WGPUColor
n_color)
    WGPURenderPassColorAttachment
-> ContT r IO WGPURenderPassColorAttachment
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPURenderPassColorAttachment :: WGPUTextureView
-> WGPUTextureView
-> WGPULoadOp
-> WGPUStoreOp
-> WGPUColor
-> WGPURenderPassColorAttachment
WGPURenderPassColorAttachment.WGPURenderPassColorAttachment
        { view :: WGPUTextureView
view = WGPUTextureView
n_view,
          resolveTarget :: WGPUTextureView
resolveTarget = WGPUTextureView
n_resolveTarget,
          loadOp :: WGPULoadOp
loadOp = WGPULoadOp
n_loadOp,
          storeOp :: WGPUStoreOp
storeOp = WGPUStoreOp
n_storeOp,
          clearColor :: WGPUColor
clearColor = WGPUColor
n_clearColor
        }

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

-- | Describes a depth/stencil attachment to a render pass.
data RenderPassDepthStencilAttachment = RenderPassDepthStencilAttachment
  { -- | The view to use as an attachment.
    RenderPassDepthStencilAttachment -> TextureView
depthStencilView :: !TextureView,
    -- | What operations will be performed on the depth part.
    RenderPassDepthStencilAttachment -> SMaybe (Operations Float)
depthOps :: !(SMaybe (Operations Float)),
    -- | What operations will be performed on the stencil part.
    RenderPassDepthStencilAttachment -> SMaybe (Operations Word32)
stencilOps :: !(SMaybe (Operations Word32))
  }
  deriving (RenderPassDepthStencilAttachment
-> RenderPassDepthStencilAttachment -> Bool
(RenderPassDepthStencilAttachment
 -> RenderPassDepthStencilAttachment -> Bool)
-> (RenderPassDepthStencilAttachment
    -> RenderPassDepthStencilAttachment -> Bool)
-> Eq RenderPassDepthStencilAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderPassDepthStencilAttachment
-> RenderPassDepthStencilAttachment -> Bool
$c/= :: RenderPassDepthStencilAttachment
-> RenderPassDepthStencilAttachment -> Bool
== :: RenderPassDepthStencilAttachment
-> RenderPassDepthStencilAttachment -> Bool
$c== :: RenderPassDepthStencilAttachment
-> RenderPassDepthStencilAttachment -> Bool
Eq, Int -> RenderPassDepthStencilAttachment -> ShowS
[RenderPassDepthStencilAttachment] -> ShowS
RenderPassDepthStencilAttachment -> String
(Int -> RenderPassDepthStencilAttachment -> ShowS)
-> (RenderPassDepthStencilAttachment -> String)
-> ([RenderPassDepthStencilAttachment] -> ShowS)
-> Show RenderPassDepthStencilAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderPassDepthStencilAttachment] -> ShowS
$cshowList :: [RenderPassDepthStencilAttachment] -> ShowS
show :: RenderPassDepthStencilAttachment -> String
$cshow :: RenderPassDepthStencilAttachment -> String
showsPrec :: Int -> RenderPassDepthStencilAttachment -> ShowS
$cshowsPrec :: Int -> RenderPassDepthStencilAttachment -> ShowS
Show)

instance
  ToRaw
    RenderPassDepthStencilAttachment
    WGPURenderPassDepthStencilAttachment
  where
  raw :: RenderPassDepthStencilAttachment
-> ContT r IO WGPURenderPassDepthStencilAttachment
raw RenderPassDepthStencilAttachment {SMaybe (Operations Float)
SMaybe (Operations Word32)
TextureView
stencilOps :: SMaybe (Operations Word32)
depthOps :: SMaybe (Operations Float)
depthStencilView :: TextureView
stencilOps :: RenderPassDepthStencilAttachment -> SMaybe (Operations Word32)
depthOps :: RenderPassDepthStencilAttachment -> SMaybe (Operations Float)
depthStencilView :: RenderPassDepthStencilAttachment -> TextureView
..} = do
    WGPUTextureView
n_view <- TextureView -> ContT r IO WGPUTextureView
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureView
depthStencilView

    (WGPULoadOp
n_depthLoadOp, WGPUStoreOp
n_depthStoreOp, CFloat
n_clearDepth, CBool
n_depthReadOnly) <-
      case SMaybe (Operations Float)
depthOps of
        SMaybe (Operations Float)
SNothing ->
          (WGPULoadOp, WGPUStoreOp, CFloat, CBool)
-> ContT r IO (WGPULoadOp, WGPUStoreOp, CFloat, CBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Clear,
              WGPUStoreOp
forall a. (Eq a, Num a) => a
WGPUStoreOp.Clear,
              Float -> CFloat
CFloat Float
0,
              Word8 -> CBool
CBool Word8
1
            )
        SJust Operations {StoreOp
LoadOp Float
store :: StoreOp
load :: LoadOp Float
store :: forall a. Operations a -> StoreOp
load :: forall a. Operations a -> LoadOp a
..} -> do
          (WGPULoadOp
loadOp, CFloat
depth) <-
            case LoadOp Float
load of
              LoadOpClear Float
d -> (WGPULoadOp, CFloat) -> ContT r IO (WGPULoadOp, CFloat)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Clear, Float -> CFloat
CFloat Float
d)
              LoadOp Float
LoadOpLoad -> (WGPULoadOp, CFloat) -> ContT r IO (WGPULoadOp, CFloat)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Load, Float -> CFloat
CFloat Float
0)
          WGPUStoreOp
storeOp <- StoreOp -> ContT r IO WGPUStoreOp
forall a b r. ToRaw a b => a -> ContT r IO b
raw StoreOp
store
          (WGPULoadOp, WGPUStoreOp, CFloat, CBool)
-> ContT r IO (WGPULoadOp, WGPUStoreOp, CFloat, CBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
loadOp, WGPUStoreOp
storeOp, CFloat
depth, Word8 -> CBool
CBool Word8
0)

    (WGPULoadOp
n_stencilLoadOp, WGPUStoreOp
n_stencilStoreOp, Word32
n_clearStencil, CBool
n_stencilReadOnly) <-
      case SMaybe (Operations Word32)
stencilOps of
        SMaybe (Operations Word32)
SNothing ->
          (WGPULoadOp, WGPUStoreOp, Word32, CBool)
-> ContT r IO (WGPULoadOp, WGPUStoreOp, Word32, CBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Clear,
              WGPUStoreOp
forall a. (Eq a, Num a) => a
WGPUStoreOp.Clear,
              Word32
0,
              Word8 -> CBool
CBool Word8
1
            )
        SJust Operations {StoreOp
LoadOp Word32
store :: StoreOp
load :: LoadOp Word32
store :: forall a. Operations a -> StoreOp
load :: forall a. Operations a -> LoadOp a
..} -> do
          (WGPULoadOp
loadOp, Word32
stencil) <-
            case LoadOp Word32
load of
              LoadOpClear Word32
s -> (WGPULoadOp, Word32) -> ContT r IO (WGPULoadOp, Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Clear, Word32
s)
              LoadOp Word32
LoadOpLoad -> (WGPULoadOp, Word32) -> ContT r IO (WGPULoadOp, Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
forall a. (Eq a, Num a) => a
WGPULoadOp.Load, Word32
0)
          WGPUStoreOp
storeOp <- StoreOp -> ContT r IO WGPUStoreOp
forall a b r. ToRaw a b => a -> ContT r IO b
raw StoreOp
store
          (WGPULoadOp, WGPUStoreOp, Word32, CBool)
-> ContT r IO (WGPULoadOp, WGPUStoreOp, Word32, CBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPULoadOp
loadOp, WGPUStoreOp
storeOp, Word32
stencil, Word8 -> CBool
CBool Word8
0)

    WGPURenderPassDepthStencilAttachment
-> ContT r IO WGPURenderPassDepthStencilAttachment
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPURenderPassDepthStencilAttachment :: WGPUTextureView
-> WGPULoadOp
-> WGPUStoreOp
-> CFloat
-> CBool
-> WGPULoadOp
-> WGPUStoreOp
-> Word32
-> CBool
-> WGPURenderPassDepthStencilAttachment
WGPURenderPassDepthStencilAttachment.WGPURenderPassDepthStencilAttachment
        { view :: WGPUTextureView
view = WGPUTextureView
n_view,
          depthLoadOp :: WGPULoadOp
depthLoadOp = WGPULoadOp
n_depthLoadOp,
          depthStoreOp :: WGPUStoreOp
depthStoreOp = WGPUStoreOp
n_depthStoreOp,
          clearDepth :: CFloat
clearDepth = CFloat
n_clearDepth,
          depthReadOnly :: CBool
depthReadOnly = CBool
n_depthReadOnly,
          stencilLoadOp :: WGPULoadOp
stencilLoadOp = WGPULoadOp
n_stencilLoadOp,
          stencilStoreOp :: WGPUStoreOp
stencilStoreOp = WGPUStoreOp
n_stencilStoreOp,
          clearStencil :: Word32
clearStencil = Word32
n_clearStencil,
          stencilReadOnly :: CBool
stencilReadOnly = CBool
n_stencilReadOnly
        }

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

-- | Describes the attachments of a render pass.
data RenderPassDescriptor = RenderPassDescriptor
  { -- | Debugging label for the render pass.
    RenderPassDescriptor -> Text
renderPassLabel :: !Text,
    -- | Color attachments of the render pass.
    RenderPassDescriptor -> Vector RenderPassColorAttachment
colorAttachments :: !(Vector RenderPassColorAttachment),
    -- | Depth and stencil attachments of the render pass.
    RenderPassDescriptor -> SMaybe RenderPassDepthStencilAttachment
depthStencilAttachment :: !(SMaybe RenderPassDepthStencilAttachment)
  }
  deriving (RenderPassDescriptor -> RenderPassDescriptor -> Bool
(RenderPassDescriptor -> RenderPassDescriptor -> Bool)
-> (RenderPassDescriptor -> RenderPassDescriptor -> Bool)
-> Eq RenderPassDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderPassDescriptor -> RenderPassDescriptor -> Bool
$c/= :: RenderPassDescriptor -> RenderPassDescriptor -> Bool
== :: RenderPassDescriptor -> RenderPassDescriptor -> Bool
$c== :: RenderPassDescriptor -> RenderPassDescriptor -> Bool
Eq, Int -> RenderPassDescriptor -> ShowS
[RenderPassDescriptor] -> ShowS
RenderPassDescriptor -> String
(Int -> RenderPassDescriptor -> ShowS)
-> (RenderPassDescriptor -> String)
-> ([RenderPassDescriptor] -> ShowS)
-> Show RenderPassDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderPassDescriptor] -> ShowS
$cshowList :: [RenderPassDescriptor] -> ShowS
show :: RenderPassDescriptor -> String
$cshow :: RenderPassDescriptor -> String
showsPrec :: Int -> RenderPassDescriptor -> ShowS
$cshowsPrec :: Int -> RenderPassDescriptor -> ShowS
Show)

instance ToRaw RenderPassDescriptor WGPURenderPassDescriptor where
  raw :: RenderPassDescriptor -> ContT r IO WGPURenderPassDescriptor
raw RenderPassDescriptor {Text
Vector RenderPassColorAttachment
SMaybe RenderPassDepthStencilAttachment
depthStencilAttachment :: SMaybe RenderPassDepthStencilAttachment
colorAttachments :: Vector RenderPassColorAttachment
renderPassLabel :: Text
depthStencilAttachment :: RenderPassDescriptor -> SMaybe RenderPassDepthStencilAttachment
colorAttachments :: RenderPassDescriptor -> Vector RenderPassColorAttachment
renderPassLabel :: RenderPassDescriptor -> Text
..} = do
    Ptr CChar
label_ptr <- Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Text
renderPassLabel
    Ptr WGPURenderPassColorAttachment
colorAttachments_ptr <- Vector RenderPassColorAttachment
-> ContT r IO (Ptr WGPURenderPassColorAttachment)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector RenderPassColorAttachment
colorAttachments
    Ptr WGPURenderPassDepthStencilAttachment
depthStencilAttachment_ptr <-
      case SMaybe RenderPassDepthStencilAttachment
depthStencilAttachment of
        SMaybe RenderPassDepthStencilAttachment
SNothing -> Ptr WGPURenderPassDepthStencilAttachment
-> ContT r IO (Ptr WGPURenderPassDepthStencilAttachment)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr WGPURenderPassDepthStencilAttachment
forall a. Ptr a
nullPtr
        SJust RenderPassDepthStencilAttachment
x -> RenderPassDepthStencilAttachment
-> ContT r IO (Ptr WGPURenderPassDepthStencilAttachment)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr RenderPassDepthStencilAttachment
x
    WGPURenderPassDescriptor -> ContT r IO WGPURenderPassDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPURenderPassDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> Word32
-> Ptr WGPURenderPassColorAttachment
-> Ptr WGPURenderPassDepthStencilAttachment
-> WGPUQuerySet
-> WGPURenderPassDescriptor
WGPURenderPassDescriptor.WGPURenderPassDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          colorAttachmentCount :: Word32
colorAttachmentCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector RenderPassColorAttachment -> Int)
-> Vector RenderPassColorAttachment
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector RenderPassColorAttachment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector RenderPassColorAttachment -> Word32)
-> Vector RenderPassColorAttachment -> Word32
forall a b. (a -> b) -> a -> b
$ Vector RenderPassColorAttachment
colorAttachments,
          colorAttachments :: Ptr WGPURenderPassColorAttachment
colorAttachments = Ptr WGPURenderPassColorAttachment
colorAttachments_ptr,
          depthStencilAttachment :: Ptr WGPURenderPassDepthStencilAttachment
depthStencilAttachment = Ptr WGPURenderPassDepthStencilAttachment
depthStencilAttachment_ptr,
          occlusionQuerySet :: WGPUQuerySet
occlusionQuerySet = Ptr () -> WGPUQuerySet
WGPUQuerySet Ptr ()
forall a. Ptr a
nullPtr
        }

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

-- | Half open range. It includes the 'start' value but not the 'end' value.
data Range a = Range
  { Range a -> a
rangeStart :: !a,
    Range a -> a
rangeLength :: !a
  }
  deriving (Range a -> Range a -> Bool
(Range a -> Range a -> Bool)
-> (Range a -> Range a -> Bool) -> Eq (Range a)
forall a. Eq a => Range a -> Range a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range a -> Range a -> Bool
$c/= :: forall a. Eq a => Range a -> Range a -> Bool
== :: Range a -> Range a -> Bool
$c== :: forall a. Eq a => Range a -> Range a -> Bool
Eq, Int -> Range a -> ShowS
[Range a] -> ShowS
Range a -> String
(Int -> Range a -> ShowS)
-> (Range a -> String) -> ([Range a] -> ShowS) -> Show (Range a)
forall a. Show a => Int -> Range a -> ShowS
forall a. Show a => [Range a] -> ShowS
forall a. Show a => Range a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range a] -> ShowS
$cshowList :: forall a. Show a => [Range a] -> ShowS
show :: Range a -> String
$cshow :: forall a. Show a => Range a -> String
showsPrec :: Int -> Range a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Range a -> ShowS
Show)

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

-- | Begins recording of a render pass.
beginRenderPass ::
  MonadIO m =>
  -- | @CommandEncoder@ to contain the render pass.
  CommandEncoder ->
  -- | Description of the render pass.
  RenderPassDescriptor ->
  -- | IO action which returns the render pass encoder.
  m RenderPassEncoder
beginRenderPass :: CommandEncoder -> RenderPassDescriptor -> m RenderPassEncoder
beginRenderPass CommandEncoder
commandEncoder RenderPassDescriptor
rpd = IO RenderPassEncoder -> m RenderPassEncoder
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderPassEncoder -> m RenderPassEncoder)
-> (ContT RenderPassEncoder IO RenderPassEncoder
    -> IO RenderPassEncoder)
-> ContT RenderPassEncoder IO RenderPassEncoder
-> m RenderPassEncoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT RenderPassEncoder IO RenderPassEncoder
-> IO RenderPassEncoder
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT RenderPassEncoder IO RenderPassEncoder
 -> m RenderPassEncoder)
-> ContT RenderPassEncoder IO RenderPassEncoder
-> m RenderPassEncoder
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = CommandEncoder -> Instance
commandEncoderInst CommandEncoder
commandEncoder
  Ptr WGPURenderPassDescriptor
renderPassDescriptor_ptr <- RenderPassDescriptor
-> ContT RenderPassEncoder IO (Ptr WGPURenderPassDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr RenderPassDescriptor
rpd
  WGPURenderPassEncoder
renderPassEncoderRaw <-
    WGPUHsInstance
-> WGPUCommandEncoder
-> Ptr WGPURenderPassDescriptor
-> ContT RenderPassEncoder IO WGPURenderPassEncoder
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUCommandEncoder
-> Ptr WGPURenderPassDescriptor
-> m WGPURenderPassEncoder
RawFun.wgpuCommandEncoderBeginRenderPass
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (CommandEncoder -> WGPUCommandEncoder
wgpuCommandEncoder CommandEncoder
commandEncoder)
      Ptr WGPURenderPassDescriptor
renderPassDescriptor_ptr
  RenderPassEncoder -> ContT RenderPassEncoder IO RenderPassEncoder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instance -> WGPURenderPassEncoder -> RenderPassEncoder
RenderPassEncoder Instance
inst WGPURenderPassEncoder
renderPassEncoderRaw)

-- | Sets the active render pipeline.
--
-- Subsequent draw calls will exhibit the behaviour defined by the pipeline.
renderPassSetPipeline ::
  MonadIO m =>
  -- | Render pass encoder on which to act.
  RenderPassEncoder ->
  -- | Render pipeline to set active.
  RenderPipeline ->
  -- | IO action which sets the active render pipeline.
  m ()
renderPassSetPipeline :: RenderPassEncoder -> RenderPipeline -> m ()
renderPassSetPipeline RenderPassEncoder
renderPassEncoder RenderPipeline
renderPipeline = do
  let inst :: Instance
inst = RenderPassEncoder -> Instance
renderPassEncoderInst RenderPassEncoder
renderPassEncoder
  WGPUHsInstance
-> WGPURenderPassEncoder -> WGPURenderPipeline -> m ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPURenderPassEncoder -> WGPURenderPipeline -> m ()
RawFun.wgpuRenderPassEncoderSetPipeline
    (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
    (RenderPassEncoder -> WGPURenderPassEncoder
wgpuRenderPassEncoder RenderPassEncoder
renderPassEncoder)
    (RenderPipeline -> WGPURenderPipeline
wgpuRenderPipeline RenderPipeline
renderPipeline)

-- | Draws primitives from the active vertex buffers.
renderPassDraw ::
  MonadIO m =>
  -- | Render pass encoder on which to act.
  RenderPassEncoder ->
  -- | Range of vertices to draw.
  Range Word32 ->
  -- | Range of instances to draw.
  Range Word32 ->
  -- | IO action which stores the draw command.
  m ()
renderPassDraw :: RenderPassEncoder -> Range Word32 -> Range Word32 -> m ()
renderPassDraw RenderPassEncoder
renderPassEncoder Range Word32
vertices Range Word32
instances = do
  let inst :: Instance
inst = RenderPassEncoder -> Instance
renderPassEncoderInst RenderPassEncoder
renderPassEncoder
  WGPUHsInstance
-> WGPURenderPassEncoder
-> Word32
-> Word32
-> Word32
-> Word32
-> m ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPURenderPassEncoder
-> Word32
-> Word32
-> Word32
-> Word32
-> m ()
RawFun.wgpuRenderPassEncoderDraw
    (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
    (RenderPassEncoder -> WGPURenderPassEncoder
wgpuRenderPassEncoder RenderPassEncoder
renderPassEncoder)
    (Range Word32 -> Word32
forall a. Range a -> a
rangeLength (Range Word32
vertices :: Range Word32))
    (Range Word32 -> Word32
forall a. Range a -> a
rangeLength (Range Word32
instances :: Range Word32))
    (Range Word32 -> Word32
forall a. Range a -> a
rangeStart Range Word32
vertices)
    (Range Word32 -> Word32
forall a. Range a -> a
rangeStart Range Word32
instances)

-- | Finish recording of a render pass.
endRenderPass ::
  MonadIO m =>
  -- | Render pass encoder on which to finish recording.
  RenderPassEncoder ->
  -- | IO action that finishes recording.
  m ()
endRenderPass :: RenderPassEncoder -> m ()
endRenderPass RenderPassEncoder
renderPassEncoder = do
  let inst :: Instance
inst = RenderPassEncoder -> Instance
renderPassEncoderInst RenderPassEncoder
renderPassEncoder
  WGPUHsInstance -> WGPURenderPassEncoder -> m ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance -> WGPURenderPassEncoder -> m ()
RawFun.wgpuRenderPassEncoderEndPass
    (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
    (RenderPassEncoder -> WGPURenderPassEncoder
wgpuRenderPassEncoder RenderPassEncoder
renderPassEncoder)