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

-- |
-- Module      : WGPU.Internal.Pipeline
-- Description : Pipelines.
module WGPU.Internal.Pipeline
  ( -- * Types
    PipelineLayout (..),
    PipelineLayoutDescriptor (..),
    VertexFormat (..),
    VertexAttribute (..),
    InputStepMode (..),
    VertexBufferLayout (..),
    VertexState (..),
    PrimitiveTopology (..),
    FrontFace (..),
    CullMode (..),
    PrimitiveState (..),
    StencilOperation (..),
    StencilFaceState (..),
    StencilState (..),
    DepthBiasState (..),
    DepthStencilState (..),
    MultisampleState (..),
    BlendFactor (..),
    BlendOperation (..),
    BlendComponent (..),
    BlendState (..),
    ColorWriteMask (..),
    ColorTargetState (..),
    FragmentState (..),
    RenderPipelineDescriptor (..),

    -- * Functions
    createPipelineLayout,
    createRenderPipeline,
    colorWriteMaskAll,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.))
import Data.Default (Default, def)
import Data.Int (Int32)
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Word (Word32, Word64, Word8)
import Foreign (nullPtr)
import Foreign.C (CFloat (CFloat))
import WGPU.Internal.Binding (BindGroupLayout)
import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)
import WGPU.Internal.Instance (wgpuHsInstance)
import WGPU.Internal.Memory
  ( ToRaw,
    evalContT,
    raw,
    rawArrayPtr,
    rawPtr,
    showWithPtr,
  )
import WGPU.Internal.Multipurpose (CompareFunction, IndexFormat)
import WGPU.Internal.RenderPass (RenderPipeline (RenderPipeline))
import WGPU.Internal.SMaybe (SMaybe (SJust, SNothing))
import WGPU.Internal.Shader (ShaderEntryPoint, ShaderModule)
import WGPU.Internal.Texture (TextureFormat)
import WGPU.Raw.Generated.Enum.WGPUBlendFactor (WGPUBlendFactor)
import qualified WGPU.Raw.Generated.Enum.WGPUBlendFactor as WGPUBlendFactor
import WGPU.Raw.Generated.Enum.WGPUBlendOperation (WGPUBlendOperation)
import qualified WGPU.Raw.Generated.Enum.WGPUBlendOperation as WGPUBlendOperation
import WGPU.Raw.Generated.Enum.WGPUColorWriteMask (WGPUColorWriteMask (WGPUColorWriteMask))
import qualified WGPU.Raw.Generated.Enum.WGPUColorWriteMask as WGPUColorWriteMask
import WGPU.Raw.Generated.Enum.WGPUCullMode (WGPUCullMode)
import qualified WGPU.Raw.Generated.Enum.WGPUCullMode as WGPUCullMode
import WGPU.Raw.Generated.Enum.WGPUFrontFace (WGPUFrontFace)
import qualified WGPU.Raw.Generated.Enum.WGPUFrontFace as WGPUFrontFace
import qualified WGPU.Raw.Generated.Enum.WGPUIndexFormat as WGPUIndexFormat
import WGPU.Raw.Generated.Enum.WGPUInputStepMode (WGPUInputStepMode)
import qualified WGPU.Raw.Generated.Enum.WGPUInputStepMode as WGPUInputStepMode
import WGPU.Raw.Generated.Enum.WGPUPrimitiveTopology (WGPUPrimitiveTopology)
import qualified WGPU.Raw.Generated.Enum.WGPUPrimitiveTopology as WGPUPrimitiveTopology
import WGPU.Raw.Generated.Enum.WGPUStencilOperation (WGPUStencilOperation)
import qualified WGPU.Raw.Generated.Enum.WGPUStencilOperation as WGPUStencilOperation
import WGPU.Raw.Generated.Enum.WGPUVertexFormat (WGPUVertexFormat)
import qualified WGPU.Raw.Generated.Enum.WGPUVertexFormat as WGPUVertexFormat
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPUBlendComponent (WGPUBlendComponent)
import qualified WGPU.Raw.Generated.Struct.WGPUBlendComponent as WGPUBlendComponent
import WGPU.Raw.Generated.Struct.WGPUBlendState (WGPUBlendState)
import qualified WGPU.Raw.Generated.Struct.WGPUBlendState as WGPUBlendState
import WGPU.Raw.Generated.Struct.WGPUColorTargetState (WGPUColorTargetState)
import qualified WGPU.Raw.Generated.Struct.WGPUColorTargetState as WGPUColorTargetState
import WGPU.Raw.Generated.Struct.WGPUDepthStencilState (WGPUDepthStencilState)
import qualified WGPU.Raw.Generated.Struct.WGPUDepthStencilState as WGPUDepthStencilState
import WGPU.Raw.Generated.Struct.WGPUFragmentState (WGPUFragmentState)
import qualified WGPU.Raw.Generated.Struct.WGPUFragmentState as WGPUFragmentState
import WGPU.Raw.Generated.Struct.WGPUMultisampleState (WGPUMultisampleState)
import qualified WGPU.Raw.Generated.Struct.WGPUMultisampleState as WGPUMultisampleState
import WGPU.Raw.Generated.Struct.WGPUPipelineLayoutDescriptor (WGPUPipelineLayoutDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUPipelineLayoutDescriptor as WGPUPipelineLayoutDescriptor
import WGPU.Raw.Generated.Struct.WGPUPrimitiveState (WGPUPrimitiveState)
import qualified WGPU.Raw.Generated.Struct.WGPUPrimitiveState as WGPUPrimitiveState
import WGPU.Raw.Generated.Struct.WGPURenderPipelineDescriptor (WGPURenderPipelineDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPURenderPipelineDescriptor as WGPURenderPipelineDescriptor
import WGPU.Raw.Generated.Struct.WGPUStencilFaceState (WGPUStencilFaceState)
import qualified WGPU.Raw.Generated.Struct.WGPUStencilFaceState as WGPUStencilFaceState
import WGPU.Raw.Generated.Struct.WGPUVertexAttribute (WGPUVertexAttribute)
import qualified WGPU.Raw.Generated.Struct.WGPUVertexAttribute as WGPUVertexAttribute
import WGPU.Raw.Generated.Struct.WGPUVertexBufferLayout (WGPUVertexBufferLayout)
import qualified WGPU.Raw.Generated.Struct.WGPUVertexBufferLayout as WGPUVertexBufferLayout
import WGPU.Raw.Generated.Struct.WGPUVertexState (WGPUVertexState)
import qualified WGPU.Raw.Generated.Struct.WGPUVertexState as WGPUVertexState
import WGPU.Raw.Types (WGPUPipelineLayout (WGPUPipelineLayout))
import Prelude hiding (compare)

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

newtype PipelineLayout = PipelineLayout {PipelineLayout -> WGPUPipelineLayout
wgpuPipelineLayout :: WGPUPipelineLayout}

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

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

instance ToRaw PipelineLayout WGPUPipelineLayout where
  raw :: PipelineLayout -> ContT r IO WGPUPipelineLayout
raw = WGPUPipelineLayout -> ContT r IO WGPUPipelineLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUPipelineLayout -> ContT r IO WGPUPipelineLayout)
-> (PipelineLayout -> WGPUPipelineLayout)
-> PipelineLayout
-> ContT r IO WGPUPipelineLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipelineLayout -> WGPUPipelineLayout
wgpuPipelineLayout

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

-- | Describes a pipeline layout.
data PipelineLayoutDescriptor = PipelineLayoutDescriptor
  { -- | Debug label of the pipeline layout.
    PipelineLayoutDescriptor -> Text
pipelineLabel :: !Text,
    -- | Bind groups that this pipeline uses.
    PipelineLayoutDescriptor -> Vector BindGroupLayout
bindGroupLayouts :: !(Vector BindGroupLayout)
  }
  deriving (PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool
(PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool)
-> (PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool)
-> Eq PipelineLayoutDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool
$c/= :: PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool
== :: PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool
$c== :: PipelineLayoutDescriptor -> PipelineLayoutDescriptor -> Bool
Eq, Int -> PipelineLayoutDescriptor -> ShowS
[PipelineLayoutDescriptor] -> ShowS
PipelineLayoutDescriptor -> String
(Int -> PipelineLayoutDescriptor -> ShowS)
-> (PipelineLayoutDescriptor -> String)
-> ([PipelineLayoutDescriptor] -> ShowS)
-> Show PipelineLayoutDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipelineLayoutDescriptor] -> ShowS
$cshowList :: [PipelineLayoutDescriptor] -> ShowS
show :: PipelineLayoutDescriptor -> String
$cshow :: PipelineLayoutDescriptor -> String
showsPrec :: Int -> PipelineLayoutDescriptor -> ShowS
$cshowsPrec :: Int -> PipelineLayoutDescriptor -> ShowS
Show)

instance ToRaw PipelineLayoutDescriptor WGPUPipelineLayoutDescriptor where
  raw :: PipelineLayoutDescriptor -> ContT r IO WGPUPipelineLayoutDescriptor
raw PipelineLayoutDescriptor {Text
Vector BindGroupLayout
bindGroupLayouts :: Vector BindGroupLayout
pipelineLabel :: Text
bindGroupLayouts :: PipelineLayoutDescriptor -> Vector BindGroupLayout
pipelineLabel :: PipelineLayoutDescriptor -> 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
pipelineLabel
    Ptr WGPUBindGroupLayout
bindGroupLayouts_ptr <- Vector BindGroupLayout -> ContT r IO (Ptr WGPUBindGroupLayout)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector BindGroupLayout
bindGroupLayouts
    WGPUPipelineLayoutDescriptor
-> ContT r IO WGPUPipelineLayoutDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUPipelineLayoutDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> Word32
-> Ptr WGPUBindGroupLayout
-> WGPUPipelineLayoutDescriptor
WGPUPipelineLayoutDescriptor.WGPUPipelineLayoutDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          bindGroupLayoutCount :: Word32
bindGroupLayoutCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector BindGroupLayout -> Int)
-> Vector BindGroupLayout
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector BindGroupLayout -> Int
forall a. Vector a -> Int
Vector.length (Vector BindGroupLayout -> Word32)
-> Vector BindGroupLayout -> Word32
forall a b. (a -> b) -> a -> b
$ Vector BindGroupLayout
bindGroupLayouts,
          bindGroupLayouts :: Ptr WGPUBindGroupLayout
bindGroupLayouts = Ptr WGPUBindGroupLayout
bindGroupLayouts_ptr
        }

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

-- | Create a pipeline layout.
createPipelineLayout ::
  MonadIO m =>
  -- | The device for which the pipeline layout will be created.
  Device ->
  -- | Descriptor of the pipeline.
  PipelineLayoutDescriptor ->
  m PipelineLayout
createPipelineLayout :: Device -> PipelineLayoutDescriptor -> m PipelineLayout
createPipelineLayout Device
device PipelineLayoutDescriptor
pdl = IO PipelineLayout -> m PipelineLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PipelineLayout -> m PipelineLayout)
-> (ContT PipelineLayout IO PipelineLayout -> IO PipelineLayout)
-> ContT PipelineLayout IO PipelineLayout
-> m PipelineLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PipelineLayout IO PipelineLayout -> IO PipelineLayout
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT PipelineLayout IO PipelineLayout -> m PipelineLayout)
-> ContT PipelineLayout IO PipelineLayout -> m PipelineLayout
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Device -> Instance
deviceInst Device
device
  Ptr WGPUPipelineLayoutDescriptor
pipelineLayoutDescriptor_ptr <- PipelineLayoutDescriptor
-> ContT PipelineLayout IO (Ptr WGPUPipelineLayoutDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr PipelineLayoutDescriptor
pdl
  WGPUPipelineLayout
rawPipelineLayout <-
    WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUPipelineLayoutDescriptor
-> ContT PipelineLayout IO WGPUPipelineLayout
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUPipelineLayoutDescriptor
-> m WGPUPipelineLayout
RawFun.wgpuDeviceCreatePipelineLayout
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Device -> WGPUDevice
wgpuDevice Device
device)
      Ptr WGPUPipelineLayoutDescriptor
pipelineLayoutDescriptor_ptr
  PipelineLayout -> ContT PipelineLayout IO PipelineLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUPipelineLayout -> PipelineLayout
PipelineLayout WGPUPipelineLayout
rawPipelineLayout)

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

-- | Vertex format for a vertex attribute.
data VertexFormat
  = VertexFormatUint8x2
  | VertexFormatUint8x4
  | VertexFormatSint8x2
  | VertexFormatSint8x4
  | VertexFormatUnorm8x2
  | VertexFormatUnorm8x4
  | VertexFormatSnorm8x2
  | VertexFormatSnorm8x4
  | VertexFormatUint16x2
  | VertexFormatUint16x4
  | VertexFormatSint16x2
  | VertexFormatSint16x4
  | VertexFormatUnorm16x2
  | VertexFormatUnorm16x4
  | VertexFormatSnorm16x2
  | VertexFormatSnorm16x4
  | VertexFormatFloat16x2
  | VertexFormatFloat16x4
  | VertexFormatFloat32
  | VertexFormatFloat32x2
  | VertexFormatFloat32x3
  | VertexFormatFloat32x4
  | VertexFormatUint32
  | VertexFormatUint32x2
  | VertexFormatUint32x3
  | VertexFormatUint32x4
  | VertexFormatSint32
  | VertexFormatSint32x2
  | VertexFormatSint32x3
  | VertexFormatSint32x4
  deriving (VertexFormat -> VertexFormat -> Bool
(VertexFormat -> VertexFormat -> Bool)
-> (VertexFormat -> VertexFormat -> Bool) -> Eq VertexFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexFormat -> VertexFormat -> Bool
$c/= :: VertexFormat -> VertexFormat -> Bool
== :: VertexFormat -> VertexFormat -> Bool
$c== :: VertexFormat -> VertexFormat -> Bool
Eq, Int -> VertexFormat -> ShowS
[VertexFormat] -> ShowS
VertexFormat -> String
(Int -> VertexFormat -> ShowS)
-> (VertexFormat -> String)
-> ([VertexFormat] -> ShowS)
-> Show VertexFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexFormat] -> ShowS
$cshowList :: [VertexFormat] -> ShowS
show :: VertexFormat -> String
$cshow :: VertexFormat -> String
showsPrec :: Int -> VertexFormat -> ShowS
$cshowsPrec :: Int -> VertexFormat -> ShowS
Show)

-- | Convert a 'VertexFormat' to its raw representation.
instance ToRaw VertexFormat WGPUVertexFormat where
  raw :: VertexFormat -> ContT r IO WGPUVertexFormat
raw VertexFormat
vf =
    WGPUVertexFormat -> ContT r IO WGPUVertexFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUVertexFormat -> ContT r IO WGPUVertexFormat)
-> WGPUVertexFormat -> ContT r IO WGPUVertexFormat
forall a b. (a -> b) -> a -> b
$
      case VertexFormat
vf of
        VertexFormat
VertexFormatUint8x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint8x2
        VertexFormat
VertexFormatUint8x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint8x4
        VertexFormat
VertexFormatSint8x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint8x2
        VertexFormat
VertexFormatSint8x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint8x4
        VertexFormat
VertexFormatUnorm8x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Unorm8x2
        VertexFormat
VertexFormatUnorm8x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Unorm8x4
        VertexFormat
VertexFormatSnorm8x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Snorm8x2
        VertexFormat
VertexFormatSnorm8x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Snorm8x4
        VertexFormat
VertexFormatUint16x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint16x2
        VertexFormat
VertexFormatUint16x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint16x4
        VertexFormat
VertexFormatSint16x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint16x2
        VertexFormat
VertexFormatSint16x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint16x4
        VertexFormat
VertexFormatUnorm16x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Unorm16x2
        VertexFormat
VertexFormatUnorm16x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Unorm16x4
        VertexFormat
VertexFormatSnorm16x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Snorm16x2
        VertexFormat
VertexFormatSnorm16x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Snorm16x4
        VertexFormat
VertexFormatFloat16x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float16x2
        VertexFormat
VertexFormatFloat16x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float16x4
        VertexFormat
VertexFormatFloat32 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float32
        VertexFormat
VertexFormatFloat32x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float32x2
        VertexFormat
VertexFormatFloat32x3 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float32x3
        VertexFormat
VertexFormatFloat32x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Float32x4
        VertexFormat
VertexFormatUint32 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint32
        VertexFormat
VertexFormatUint32x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint32x2
        VertexFormat
VertexFormatUint32x3 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint32x3
        VertexFormat
VertexFormatUint32x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Uint32x4
        VertexFormat
VertexFormatSint32 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint32
        VertexFormat
VertexFormatSint32x2 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint32x2
        VertexFormat
VertexFormatSint32x3 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint32x3
        VertexFormat
VertexFormatSint32x4 -> WGPUVertexFormat
forall a. (Eq a, Num a) => a
WGPUVertexFormat.Sint32x4

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

-- | Vertex inputs (attributes) to shaders.
data VertexAttribute = VertexAttribute
  { -- | Format of the input.
    VertexAttribute -> VertexFormat
vertexFormat :: !VertexFormat,
    -- | Byte offset of the start of the input.
    VertexAttribute -> Word64
vertexOffset :: !Word64,
    -- | Location for this input. Must match the location in the shader.
    VertexAttribute -> Word32
shaderLocation :: !Word32
  }
  deriving (VertexAttribute -> VertexAttribute -> Bool
(VertexAttribute -> VertexAttribute -> Bool)
-> (VertexAttribute -> VertexAttribute -> Bool)
-> Eq VertexAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexAttribute -> VertexAttribute -> Bool
$c/= :: VertexAttribute -> VertexAttribute -> Bool
== :: VertexAttribute -> VertexAttribute -> Bool
$c== :: VertexAttribute -> VertexAttribute -> Bool
Eq, Int -> VertexAttribute -> ShowS
[VertexAttribute] -> ShowS
VertexAttribute -> String
(Int -> VertexAttribute -> ShowS)
-> (VertexAttribute -> String)
-> ([VertexAttribute] -> ShowS)
-> Show VertexAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexAttribute] -> ShowS
$cshowList :: [VertexAttribute] -> ShowS
show :: VertexAttribute -> String
$cshow :: VertexAttribute -> String
showsPrec :: Int -> VertexAttribute -> ShowS
$cshowsPrec :: Int -> VertexAttribute -> ShowS
Show)

instance ToRaw VertexAttribute WGPUVertexAttribute where
  raw :: VertexAttribute -> ContT r IO WGPUVertexAttribute
raw VertexAttribute {Word32
Word64
VertexFormat
shaderLocation :: Word32
vertexOffset :: Word64
vertexFormat :: VertexFormat
shaderLocation :: VertexAttribute -> Word32
vertexOffset :: VertexAttribute -> Word64
vertexFormat :: VertexAttribute -> VertexFormat
..} = do
    WGPUVertexFormat
n_format <- VertexFormat -> ContT r IO WGPUVertexFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw VertexFormat
vertexFormat
    WGPUVertexAttribute -> ContT r IO WGPUVertexAttribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUVertexAttribute :: WGPUVertexFormat -> Word64 -> Word32 -> WGPUVertexAttribute
WGPUVertexAttribute.WGPUVertexAttribute
        { format :: WGPUVertexFormat
format = WGPUVertexFormat
n_format,
          offset :: Word64
offset = Word64
vertexOffset,
          shaderLocation :: Word32
shaderLocation = Word32
shaderLocation
        }

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

-- | Determines when vertex data is advanced.
data InputStepMode
  = -- | Input data is advanced every vertex.
    InputStepModeVertex
  | -- | Input data is advanced every instance.
    InputStepModeInstance
  deriving (InputStepMode -> InputStepMode -> Bool
(InputStepMode -> InputStepMode -> Bool)
-> (InputStepMode -> InputStepMode -> Bool) -> Eq InputStepMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputStepMode -> InputStepMode -> Bool
$c/= :: InputStepMode -> InputStepMode -> Bool
== :: InputStepMode -> InputStepMode -> Bool
$c== :: InputStepMode -> InputStepMode -> Bool
Eq, Int -> InputStepMode -> ShowS
[InputStepMode] -> ShowS
InputStepMode -> String
(Int -> InputStepMode -> ShowS)
-> (InputStepMode -> String)
-> ([InputStepMode] -> ShowS)
-> Show InputStepMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputStepMode] -> ShowS
$cshowList :: [InputStepMode] -> ShowS
show :: InputStepMode -> String
$cshow :: InputStepMode -> String
showsPrec :: Int -> InputStepMode -> ShowS
$cshowsPrec :: Int -> InputStepMode -> ShowS
Show)

-- | Convert an 'InputStepMode' to its raw value.
instance ToRaw InputStepMode WGPUInputStepMode where
  raw :: InputStepMode -> ContT r IO WGPUInputStepMode
raw InputStepMode
ism =
    WGPUInputStepMode -> ContT r IO WGPUInputStepMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUInputStepMode -> ContT r IO WGPUInputStepMode)
-> WGPUInputStepMode -> ContT r IO WGPUInputStepMode
forall a b. (a -> b) -> a -> b
$
      case InputStepMode
ism of
        InputStepMode
InputStepModeVertex -> WGPUInputStepMode
forall a. (Eq a, Num a) => a
WGPUInputStepMode.Vertex
        InputStepMode
InputStepModeInstance -> WGPUInputStepMode
forall a. (Eq a, Num a) => a
WGPUInputStepMode.Instance

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

-- | Describes how a vertex buffer is interpreted.
data VertexBufferLayout = VertexBufferLayout
  { -- | The stride, in bytes, between elements of the buffer.
    VertexBufferLayout -> Word64
arrayStride :: !Word64,
    -- | How often the vertex buffer is stepped forward (per vertex or
    -- per instance).
    VertexBufferLayout -> InputStepMode
stepMode :: !InputStepMode,
    -- | List of attributes that comprise a single vertex.
    VertexBufferLayout -> Vector VertexAttribute
attributes :: !(Vector VertexAttribute)
  }
  deriving (VertexBufferLayout -> VertexBufferLayout -> Bool
(VertexBufferLayout -> VertexBufferLayout -> Bool)
-> (VertexBufferLayout -> VertexBufferLayout -> Bool)
-> Eq VertexBufferLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexBufferLayout -> VertexBufferLayout -> Bool
$c/= :: VertexBufferLayout -> VertexBufferLayout -> Bool
== :: VertexBufferLayout -> VertexBufferLayout -> Bool
$c== :: VertexBufferLayout -> VertexBufferLayout -> Bool
Eq, Int -> VertexBufferLayout -> ShowS
[VertexBufferLayout] -> ShowS
VertexBufferLayout -> String
(Int -> VertexBufferLayout -> ShowS)
-> (VertexBufferLayout -> String)
-> ([VertexBufferLayout] -> ShowS)
-> Show VertexBufferLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexBufferLayout] -> ShowS
$cshowList :: [VertexBufferLayout] -> ShowS
show :: VertexBufferLayout -> String
$cshow :: VertexBufferLayout -> String
showsPrec :: Int -> VertexBufferLayout -> ShowS
$cshowsPrec :: Int -> VertexBufferLayout -> ShowS
Show)

instance ToRaw VertexBufferLayout WGPUVertexBufferLayout where
  raw :: VertexBufferLayout -> ContT r IO WGPUVertexBufferLayout
raw VertexBufferLayout {Word64
Vector VertexAttribute
InputStepMode
attributes :: Vector VertexAttribute
stepMode :: InputStepMode
arrayStride :: Word64
attributes :: VertexBufferLayout -> Vector VertexAttribute
stepMode :: VertexBufferLayout -> InputStepMode
arrayStride :: VertexBufferLayout -> Word64
..} = do
    WGPUInputStepMode
n_stepMode <- InputStepMode -> ContT r IO WGPUInputStepMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw InputStepMode
stepMode
    Ptr WGPUVertexAttribute
attributes_ptr <- Vector VertexAttribute -> ContT r IO (Ptr WGPUVertexAttribute)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector VertexAttribute
attributes
    WGPUVertexBufferLayout -> ContT r IO WGPUVertexBufferLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUVertexBufferLayout :: Word64
-> WGPUInputStepMode
-> Word32
-> Ptr WGPUVertexAttribute
-> WGPUVertexBufferLayout
WGPUVertexBufferLayout.WGPUVertexBufferLayout
        { arrayStride :: Word64
arrayStride = Word64
arrayStride,
          stepMode :: WGPUInputStepMode
stepMode = WGPUInputStepMode
n_stepMode,
          attributeCount :: Word32
attributeCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector VertexAttribute -> Int)
-> Vector VertexAttribute
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector VertexAttribute -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector VertexAttribute -> Word32)
-> Vector VertexAttribute -> Word32
forall a b. (a -> b) -> a -> b
$ Vector VertexAttribute
attributes,
          attributes :: Ptr WGPUVertexAttribute
attributes = Ptr WGPUVertexAttribute
attributes_ptr
        }

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

-- | Describes the vertex process in a render pipeline.
data VertexState = VertexState
  { -- | The compiled shader module for this stage.
    VertexState -> ShaderModule
vertexShaderModule :: !ShaderModule,
    -- | The name of the entry point in the compiled shader. There must be a
    -- function that returns @void@ with this name in the shader.
    VertexState -> ShaderEntryPoint
vertexEntryPoint :: !ShaderEntryPoint,
    -- | The format of any vertex buffers used with this pipeline.
    VertexState -> Vector VertexBufferLayout
buffers :: !(Vector VertexBufferLayout)
  }
  deriving (VertexState -> VertexState -> Bool
(VertexState -> VertexState -> Bool)
-> (VertexState -> VertexState -> Bool) -> Eq VertexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexState -> VertexState -> Bool
$c/= :: VertexState -> VertexState -> Bool
== :: VertexState -> VertexState -> Bool
$c== :: VertexState -> VertexState -> Bool
Eq, Int -> VertexState -> ShowS
[VertexState] -> ShowS
VertexState -> String
(Int -> VertexState -> ShowS)
-> (VertexState -> String)
-> ([VertexState] -> ShowS)
-> Show VertexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexState] -> ShowS
$cshowList :: [VertexState] -> ShowS
show :: VertexState -> String
$cshow :: VertexState -> String
showsPrec :: Int -> VertexState -> ShowS
$cshowsPrec :: Int -> VertexState -> ShowS
Show)

instance ToRaw VertexState WGPUVertexState where
  raw :: VertexState -> ContT r IO WGPUVertexState
raw VertexState {Vector VertexBufferLayout
ShaderEntryPoint
ShaderModule
buffers :: Vector VertexBufferLayout
vertexEntryPoint :: ShaderEntryPoint
vertexShaderModule :: ShaderModule
buffers :: VertexState -> Vector VertexBufferLayout
vertexEntryPoint :: VertexState -> ShaderEntryPoint
vertexShaderModule :: VertexState -> ShaderModule
..} = do
    WGPUShaderModule
n_shaderModule <- ShaderModule -> ContT r IO WGPUShaderModule
forall a b r. ToRaw a b => a -> ContT r IO b
raw ShaderModule
vertexShaderModule
    Ptr CChar
entryPoint_ptr <- ShaderEntryPoint -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr ShaderEntryPoint
vertexEntryPoint
    Ptr WGPUVertexBufferLayout
buffers_ptr <- Vector VertexBufferLayout
-> ContT r IO (Ptr WGPUVertexBufferLayout)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector VertexBufferLayout
buffers
    WGPUVertexState -> ContT r IO WGPUVertexState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUVertexState :: Ptr WGPUChainedStruct
-> WGPUShaderModule
-> Ptr CChar
-> Word32
-> Ptr WGPUVertexBufferLayout
-> WGPUVertexState
WGPUVertexState.WGPUVertexState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          shaderModule :: WGPUShaderModule
shaderModule = WGPUShaderModule
n_shaderModule,
          entryPoint :: Ptr CChar
entryPoint = Ptr CChar
entryPoint_ptr,
          bufferCount :: Word32
bufferCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector VertexBufferLayout -> Int)
-> Vector VertexBufferLayout
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector VertexBufferLayout -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector VertexBufferLayout -> Word32)
-> Vector VertexBufferLayout -> Word32
forall a b. (a -> b) -> a -> b
$ Vector VertexBufferLayout
buffers,
          buffers :: Ptr WGPUVertexBufferLayout
buffers = Ptr WGPUVertexBufferLayout
buffers_ptr
        }

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

-- | Primitive type out of which an input mesh is composed.
data PrimitiveTopology
  = PrimitiveTopologyPointList
  | PrimitiveTopologyLineList
  | PrimitiveTopologyLineStrip
  | PrimitiveTopologyTriangleList
  | PrimitiveTopologyTriangleStrip
  deriving (PrimitiveTopology -> PrimitiveTopology -> Bool
(PrimitiveTopology -> PrimitiveTopology -> Bool)
-> (PrimitiveTopology -> PrimitiveTopology -> Bool)
-> Eq PrimitiveTopology
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveTopology -> PrimitiveTopology -> Bool
$c/= :: PrimitiveTopology -> PrimitiveTopology -> Bool
== :: PrimitiveTopology -> PrimitiveTopology -> Bool
$c== :: PrimitiveTopology -> PrimitiveTopology -> Bool
Eq, Int -> PrimitiveTopology -> ShowS
[PrimitiveTopology] -> ShowS
PrimitiveTopology -> String
(Int -> PrimitiveTopology -> ShowS)
-> (PrimitiveTopology -> String)
-> ([PrimitiveTopology] -> ShowS)
-> Show PrimitiveTopology
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveTopology] -> ShowS
$cshowList :: [PrimitiveTopology] -> ShowS
show :: PrimitiveTopology -> String
$cshow :: PrimitiveTopology -> String
showsPrec :: Int -> PrimitiveTopology -> ShowS
$cshowsPrec :: Int -> PrimitiveTopology -> ShowS
Show)

instance Default PrimitiveTopology where def :: PrimitiveTopology
def = PrimitiveTopology
PrimitiveTopologyTriangleList

-- | Convert a 'PrimitiveTopology' to its raw value.
instance ToRaw PrimitiveTopology WGPUPrimitiveTopology where
  raw :: PrimitiveTopology -> ContT r IO WGPUPrimitiveTopology
raw PrimitiveTopology
pt =
    WGPUPrimitiveTopology -> ContT r IO WGPUPrimitiveTopology
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUPrimitiveTopology -> ContT r IO WGPUPrimitiveTopology)
-> WGPUPrimitiveTopology -> ContT r IO WGPUPrimitiveTopology
forall a b. (a -> b) -> a -> b
$
      case PrimitiveTopology
pt of
        PrimitiveTopology
PrimitiveTopologyPointList -> WGPUPrimitiveTopology
forall a. (Eq a, Num a) => a
WGPUPrimitiveTopology.PointList
        PrimitiveTopology
PrimitiveTopologyLineList -> WGPUPrimitiveTopology
forall a. (Eq a, Num a) => a
WGPUPrimitiveTopology.LineList
        PrimitiveTopology
PrimitiveTopologyLineStrip -> WGPUPrimitiveTopology
forall a. (Eq a, Num a) => a
WGPUPrimitiveTopology.LineStrip
        PrimitiveTopology
PrimitiveTopologyTriangleList -> WGPUPrimitiveTopology
forall a. (Eq a, Num a) => a
WGPUPrimitiveTopology.TriangleList
        PrimitiveTopology
PrimitiveTopologyTriangleStrip -> WGPUPrimitiveTopology
forall a. (Eq a, Num a) => a
WGPUPrimitiveTopology.TriangleStrip

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

-- | Winding order which classifies the "front" face.
data FrontFace
  = -- | Triangles with counter-clockwise vertices are the front face.
    FrontFaceCCW
  | -- | Triangles with clockwise vertices are the front face.
    FrontFaceCW
  deriving (FrontFace -> FrontFace -> Bool
(FrontFace -> FrontFace -> Bool)
-> (FrontFace -> FrontFace -> Bool) -> Eq FrontFace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrontFace -> FrontFace -> Bool
$c/= :: FrontFace -> FrontFace -> Bool
== :: FrontFace -> FrontFace -> Bool
$c== :: FrontFace -> FrontFace -> Bool
Eq, Int -> FrontFace -> ShowS
[FrontFace] -> ShowS
FrontFace -> String
(Int -> FrontFace -> ShowS)
-> (FrontFace -> String)
-> ([FrontFace] -> ShowS)
-> Show FrontFace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrontFace] -> ShowS
$cshowList :: [FrontFace] -> ShowS
show :: FrontFace -> String
$cshow :: FrontFace -> String
showsPrec :: Int -> FrontFace -> ShowS
$cshowsPrec :: Int -> FrontFace -> ShowS
Show)

instance Default FrontFace where def :: FrontFace
def = FrontFace
FrontFaceCCW

-- | Convert a 'FrontFace' to its raw value.
instance ToRaw FrontFace WGPUFrontFace where
  raw :: FrontFace -> ContT r IO WGPUFrontFace
raw FrontFace
ff =
    WGPUFrontFace -> ContT r IO WGPUFrontFace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUFrontFace -> ContT r IO WGPUFrontFace)
-> WGPUFrontFace -> ContT r IO WGPUFrontFace
forall a b. (a -> b) -> a -> b
$
      case FrontFace
ff of
        FrontFace
FrontFaceCCW -> WGPUFrontFace
forall a. (Eq a, Num a) => a
WGPUFrontFace.CCW
        FrontFace
FrontFaceCW -> WGPUFrontFace
forall a. (Eq a, Num a) => a
WGPUFrontFace.CW

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

-- | Whether to cull the face of a vertex.
data CullMode
  = -- | Cull the front face.
    CullModeFront
  | -- | Cull the back face.
    CullModeBack
  | -- | Do not cull either face.
    CullModeNone
  deriving (CullMode -> CullMode -> Bool
(CullMode -> CullMode -> Bool)
-> (CullMode -> CullMode -> Bool) -> Eq CullMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CullMode -> CullMode -> Bool
$c/= :: CullMode -> CullMode -> Bool
== :: CullMode -> CullMode -> Bool
$c== :: CullMode -> CullMode -> Bool
Eq, Int -> CullMode -> ShowS
[CullMode] -> ShowS
CullMode -> String
(Int -> CullMode -> ShowS)
-> (CullMode -> String) -> ([CullMode] -> ShowS) -> Show CullMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CullMode] -> ShowS
$cshowList :: [CullMode] -> ShowS
show :: CullMode -> String
$cshow :: CullMode -> String
showsPrec :: Int -> CullMode -> ShowS
$cshowsPrec :: Int -> CullMode -> ShowS
Show)

instance Default CullMode where def :: CullMode
def = CullMode
CullModeNone

-- | Convert a 'CullMode' to its raw value.
instance ToRaw CullMode WGPUCullMode where
  raw :: CullMode -> ContT r IO WGPUCullMode
raw CullMode
cm =
    WGPUCullMode -> ContT r IO WGPUCullMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUCullMode -> ContT r IO WGPUCullMode)
-> WGPUCullMode -> ContT r IO WGPUCullMode
forall a b. (a -> b) -> a -> b
$
      case CullMode
cm of
        CullMode
CullModeFront -> WGPUCullMode
forall a. (Eq a, Num a) => a
WGPUCullMode.Front
        CullMode
CullModeBack -> WGPUCullMode
forall a. (Eq a, Num a) => a
WGPUCullMode.Back
        CullMode
CullModeNone -> WGPUCullMode
forall a. (Eq a, Num a) => a
WGPUCullMode.None

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

-- | Describes the state of primitive assembly and rasterization in a render
-- pipeline.
--
-- Differences between this and the Rust API:
--   - no `clamp_depth` member
--   - no `polygon_mode` member
--   - no `conservative` member
data PrimitiveState = PrimitiveState
  { -- | The primitive topology used to interpret vertices.
    PrimitiveState -> PrimitiveTopology
topology :: !PrimitiveTopology,
    -- | When drawing strip topologies with indices, this is the required
    -- format for the index buffer. This has no effect for non-indexed or
    -- non-strip draws.
    PrimitiveState -> SMaybe IndexFormat
stripIndexFormat :: !(SMaybe IndexFormat),
    -- | The face to consider the front for the purpose of culling and
    -- stencil operations.
    PrimitiveState -> FrontFace
frontFace :: !FrontFace,
    -- | The face culling mode.
    PrimitiveState -> CullMode
cullMode :: !CullMode
  }
  deriving (PrimitiveState -> PrimitiveState -> Bool
(PrimitiveState -> PrimitiveState -> Bool)
-> (PrimitiveState -> PrimitiveState -> Bool) -> Eq PrimitiveState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveState -> PrimitiveState -> Bool
$c/= :: PrimitiveState -> PrimitiveState -> Bool
== :: PrimitiveState -> PrimitiveState -> Bool
$c== :: PrimitiveState -> PrimitiveState -> Bool
Eq, Int -> PrimitiveState -> ShowS
[PrimitiveState] -> ShowS
PrimitiveState -> String
(Int -> PrimitiveState -> ShowS)
-> (PrimitiveState -> String)
-> ([PrimitiveState] -> ShowS)
-> Show PrimitiveState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveState] -> ShowS
$cshowList :: [PrimitiveState] -> ShowS
show :: PrimitiveState -> String
$cshow :: PrimitiveState -> String
showsPrec :: Int -> PrimitiveState -> ShowS
$cshowsPrec :: Int -> PrimitiveState -> ShowS
Show)

instance Default PrimitiveState where
  def :: PrimitiveState
def =
    PrimitiveState :: PrimitiveTopology
-> SMaybe IndexFormat -> FrontFace -> CullMode -> PrimitiveState
PrimitiveState
      { topology :: PrimitiveTopology
topology = PrimitiveTopology
forall a. Default a => a
def,
        stripIndexFormat :: SMaybe IndexFormat
stripIndexFormat = SMaybe IndexFormat
forall a. SMaybe a
SNothing,
        frontFace :: FrontFace
frontFace = FrontFace
forall a. Default a => a
def,
        cullMode :: CullMode
cullMode = CullMode
forall a. Default a => a
def
      }

instance ToRaw PrimitiveState WGPUPrimitiveState where
  raw :: PrimitiveState -> ContT r IO WGPUPrimitiveState
raw PrimitiveState {SMaybe IndexFormat
CullMode
FrontFace
PrimitiveTopology
cullMode :: CullMode
frontFace :: FrontFace
stripIndexFormat :: SMaybe IndexFormat
topology :: PrimitiveTopology
cullMode :: PrimitiveState -> CullMode
frontFace :: PrimitiveState -> FrontFace
stripIndexFormat :: PrimitiveState -> SMaybe IndexFormat
topology :: PrimitiveState -> PrimitiveTopology
..} = do
    WGPUPrimitiveTopology
n_topology <- PrimitiveTopology -> ContT r IO WGPUPrimitiveTopology
forall a b r. ToRaw a b => a -> ContT r IO b
raw PrimitiveTopology
topology
    WGPUIndexFormat
n_stripIndexFormat <-
      case SMaybe IndexFormat
stripIndexFormat of
        SMaybe IndexFormat
SNothing -> WGPUIndexFormat -> ContT r IO WGPUIndexFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUIndexFormat
forall a. (Eq a, Num a) => a
WGPUIndexFormat.Undefined
        SJust IndexFormat
sif -> IndexFormat -> ContT r IO WGPUIndexFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw IndexFormat
sif
    WGPUFrontFace
n_frontFace <- FrontFace -> ContT r IO WGPUFrontFace
forall a b r. ToRaw a b => a -> ContT r IO b
raw FrontFace
frontFace
    WGPUCullMode
n_cullMode <- CullMode -> ContT r IO WGPUCullMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw CullMode
cullMode
    WGPUPrimitiveState -> ContT r IO WGPUPrimitiveState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUPrimitiveState :: Ptr WGPUChainedStruct
-> WGPUPrimitiveTopology
-> WGPUIndexFormat
-> WGPUFrontFace
-> WGPUCullMode
-> WGPUPrimitiveState
WGPUPrimitiveState.WGPUPrimitiveState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          topology :: WGPUPrimitiveTopology
topology = WGPUPrimitiveTopology
n_topology,
          stripIndexFormat :: WGPUIndexFormat
stripIndexFormat = WGPUIndexFormat
n_stripIndexFormat,
          frontFace :: WGPUFrontFace
frontFace = WGPUFrontFace
n_frontFace,
          cullMode :: WGPUCullMode
cullMode = WGPUCullMode
n_cullMode
        }

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

-- | Operation to perform on a stencil value.
data StencilOperation
  = StencilOperationKeep
  | StencilOperationZero
  | StencilOperationReplace
  | StencilOperationInvert
  | StencilOperationIncrementClamp
  | StencilOperationDecrementClamp
  | StencilOperationIncrementWrap
  | StencilOperationDecrementWrap
  deriving (StencilOperation -> StencilOperation -> Bool
(StencilOperation -> StencilOperation -> Bool)
-> (StencilOperation -> StencilOperation -> Bool)
-> Eq StencilOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StencilOperation -> StencilOperation -> Bool
$c/= :: StencilOperation -> StencilOperation -> Bool
== :: StencilOperation -> StencilOperation -> Bool
$c== :: StencilOperation -> StencilOperation -> Bool
Eq, Int -> StencilOperation -> ShowS
[StencilOperation] -> ShowS
StencilOperation -> String
(Int -> StencilOperation -> ShowS)
-> (StencilOperation -> String)
-> ([StencilOperation] -> ShowS)
-> Show StencilOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StencilOperation] -> ShowS
$cshowList :: [StencilOperation] -> ShowS
show :: StencilOperation -> String
$cshow :: StencilOperation -> String
showsPrec :: Int -> StencilOperation -> ShowS
$cshowsPrec :: Int -> StencilOperation -> ShowS
Show)

-- | Convert a 'StencilOperation' to its raw value.
instance ToRaw StencilOperation WGPUStencilOperation where
  raw :: StencilOperation -> ContT r IO WGPUStencilOperation
raw StencilOperation
so =
    WGPUStencilOperation -> ContT r IO WGPUStencilOperation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUStencilOperation -> ContT r IO WGPUStencilOperation)
-> WGPUStencilOperation -> ContT r IO WGPUStencilOperation
forall a b. (a -> b) -> a -> b
$
      case StencilOperation
so of
        StencilOperation
StencilOperationKeep -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.Keep
        StencilOperation
StencilOperationZero -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.Zero
        StencilOperation
StencilOperationReplace -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.Replace
        StencilOperation
StencilOperationInvert -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.Invert
        StencilOperation
StencilOperationIncrementClamp -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.IncrementClamp
        StencilOperation
StencilOperationDecrementClamp -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.DecrementClamp
        StencilOperation
StencilOperationIncrementWrap -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.IncrementWrap
        StencilOperation
StencilOperationDecrementWrap -> WGPUStencilOperation
forall a. (Eq a, Num a) => a
WGPUStencilOperation.DecrementWrap

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

-- | Describes stencil state in a render pipeline.
data StencilFaceState = StencilFaceState
  { StencilFaceState -> CompareFunction
compare :: !CompareFunction,
    StencilFaceState -> StencilOperation
failOp :: !StencilOperation,
    StencilFaceState -> StencilOperation
depthFailOp :: !StencilOperation,
    StencilFaceState -> StencilOperation
passOp :: !StencilOperation
  }
  deriving (StencilFaceState -> StencilFaceState -> Bool
(StencilFaceState -> StencilFaceState -> Bool)
-> (StencilFaceState -> StencilFaceState -> Bool)
-> Eq StencilFaceState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StencilFaceState -> StencilFaceState -> Bool
$c/= :: StencilFaceState -> StencilFaceState -> Bool
== :: StencilFaceState -> StencilFaceState -> Bool
$c== :: StencilFaceState -> StencilFaceState -> Bool
Eq, Int -> StencilFaceState -> ShowS
[StencilFaceState] -> ShowS
StencilFaceState -> String
(Int -> StencilFaceState -> ShowS)
-> (StencilFaceState -> String)
-> ([StencilFaceState] -> ShowS)
-> Show StencilFaceState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StencilFaceState] -> ShowS
$cshowList :: [StencilFaceState] -> ShowS
show :: StencilFaceState -> String
$cshow :: StencilFaceState -> String
showsPrec :: Int -> StencilFaceState -> ShowS
$cshowsPrec :: Int -> StencilFaceState -> ShowS
Show)

instance ToRaw StencilFaceState WGPUStencilFaceState where
  raw :: StencilFaceState -> ContT r IO WGPUStencilFaceState
raw StencilFaceState {CompareFunction
StencilOperation
passOp :: StencilOperation
depthFailOp :: StencilOperation
failOp :: StencilOperation
compare :: CompareFunction
passOp :: StencilFaceState -> StencilOperation
depthFailOp :: StencilFaceState -> StencilOperation
failOp :: StencilFaceState -> StencilOperation
compare :: StencilFaceState -> CompareFunction
..} = do
    WGPUCompareFunction
n_compare <- CompareFunction -> ContT r IO WGPUCompareFunction
forall a b r. ToRaw a b => a -> ContT r IO b
raw CompareFunction
compare
    WGPUStencilOperation
n_failOp <- StencilOperation -> ContT r IO WGPUStencilOperation
forall a b r. ToRaw a b => a -> ContT r IO b
raw StencilOperation
failOp
    WGPUStencilOperation
n_depthFailOp <- StencilOperation -> ContT r IO WGPUStencilOperation
forall a b r. ToRaw a b => a -> ContT r IO b
raw StencilOperation
depthFailOp
    WGPUStencilOperation
n_passOp <- StencilOperation -> ContT r IO WGPUStencilOperation
forall a b r. ToRaw a b => a -> ContT r IO b
raw StencilOperation
passOp
    WGPUStencilFaceState -> ContT r IO WGPUStencilFaceState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUStencilFaceState :: WGPUCompareFunction
-> WGPUStencilOperation
-> WGPUStencilOperation
-> WGPUStencilOperation
-> WGPUStencilFaceState
WGPUStencilFaceState.WGPUStencilFaceState
        { compare :: WGPUCompareFunction
compare = WGPUCompareFunction
n_compare,
          failOp :: WGPUStencilOperation
failOp = WGPUStencilOperation
n_failOp,
          depthFailOp :: WGPUStencilOperation
depthFailOp = WGPUStencilOperation
n_depthFailOp,
          passOp :: WGPUStencilOperation
passOp = WGPUStencilOperation
n_passOp
        }

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

-- | State of the stencil operation (fixed pipeline stage).
data StencilState = StencilState
  { -- | Front face mode.
    StencilState -> StencilFaceState
front :: !StencilFaceState,
    -- | Back face mode.
    StencilState -> StencilFaceState
back :: !StencilFaceState,
    -- | Stencil values are AND-ed with this mask when reading and writing from
    -- the stencil buffer.
    StencilState -> Word8
readMask :: !Word8,
    -- | Stencil values are AND-ed with this mask when writing to the stencil
    -- buffer.
    StencilState -> Word8
writeMask :: !Word8
  }
  deriving (StencilState -> StencilState -> Bool
(StencilState -> StencilState -> Bool)
-> (StencilState -> StencilState -> Bool) -> Eq StencilState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StencilState -> StencilState -> Bool
$c/= :: StencilState -> StencilState -> Bool
== :: StencilState -> StencilState -> Bool
$c== :: StencilState -> StencilState -> Bool
Eq, Int -> StencilState -> ShowS
[StencilState] -> ShowS
StencilState -> String
(Int -> StencilState -> ShowS)
-> (StencilState -> String)
-> ([StencilState] -> ShowS)
-> Show StencilState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StencilState] -> ShowS
$cshowList :: [StencilState] -> ShowS
show :: StencilState -> String
$cshow :: StencilState -> String
showsPrec :: Int -> StencilState -> ShowS
$cshowsPrec :: Int -> StencilState -> ShowS
Show)

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

-- | Describes the biasing setting for the depth target.
data DepthBiasState = DepthBiasState
  { -- Constant depth biasing factor, in basic units of the depth format.
    DepthBiasState -> Int32
constant :: !Int32,
    -- | Slope depth biasing factor.
    DepthBiasState -> Float
slopeScale :: !Float,
    -- | Depth bias clamp value (absolute).
    DepthBiasState -> Float
clamp :: !Float
  }
  deriving (DepthBiasState -> DepthBiasState -> Bool
(DepthBiasState -> DepthBiasState -> Bool)
-> (DepthBiasState -> DepthBiasState -> Bool) -> Eq DepthBiasState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepthBiasState -> DepthBiasState -> Bool
$c/= :: DepthBiasState -> DepthBiasState -> Bool
== :: DepthBiasState -> DepthBiasState -> Bool
$c== :: DepthBiasState -> DepthBiasState -> Bool
Eq, Int -> DepthBiasState -> ShowS
[DepthBiasState] -> ShowS
DepthBiasState -> String
(Int -> DepthBiasState -> ShowS)
-> (DepthBiasState -> String)
-> ([DepthBiasState] -> ShowS)
-> Show DepthBiasState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepthBiasState] -> ShowS
$cshowList :: [DepthBiasState] -> ShowS
show :: DepthBiasState -> String
$cshow :: DepthBiasState -> String
showsPrec :: Int -> DepthBiasState -> ShowS
$cshowsPrec :: Int -> DepthBiasState -> ShowS
Show)

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

-- | Describes the depth / stencil state of a render pipeline.
data DepthStencilState = DepthStencilState
  { -- | Format of the depth/stencil buffer. This must be a special depth
    -- format, and must match the format of the depth/stencil attachment in
    -- the command encoder.
    DepthStencilState -> TextureFormat
depthStencilTextureFormat :: !TextureFormat,
    -- | If disabled, depth will not be written to.
    DepthStencilState -> Bool
depthWriteEnabled :: !Bool,
    -- | Comparison function used to compare depth values in the depth test.
    DepthStencilState -> CompareFunction
depthCompare :: !CompareFunction,
    -- | Stencil state.
    DepthStencilState -> StencilState
stencil :: !StencilState,
    -- | Depth bias state.
    DepthStencilState -> DepthBiasState
bias :: !DepthBiasState
  }
  deriving (DepthStencilState -> DepthStencilState -> Bool
(DepthStencilState -> DepthStencilState -> Bool)
-> (DepthStencilState -> DepthStencilState -> Bool)
-> Eq DepthStencilState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DepthStencilState -> DepthStencilState -> Bool
$c/= :: DepthStencilState -> DepthStencilState -> Bool
== :: DepthStencilState -> DepthStencilState -> Bool
$c== :: DepthStencilState -> DepthStencilState -> Bool
Eq, Int -> DepthStencilState -> ShowS
[DepthStencilState] -> ShowS
DepthStencilState -> String
(Int -> DepthStencilState -> ShowS)
-> (DepthStencilState -> String)
-> ([DepthStencilState] -> ShowS)
-> Show DepthStencilState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepthStencilState] -> ShowS
$cshowList :: [DepthStencilState] -> ShowS
show :: DepthStencilState -> String
$cshow :: DepthStencilState -> String
showsPrec :: Int -> DepthStencilState -> ShowS
$cshowsPrec :: Int -> DepthStencilState -> ShowS
Show)

instance ToRaw DepthStencilState WGPUDepthStencilState where
  raw :: DepthStencilState -> ContT r IO WGPUDepthStencilState
raw DepthStencilState {Bool
CompareFunction
TextureFormat
DepthBiasState
StencilState
bias :: DepthBiasState
stencil :: StencilState
depthCompare :: CompareFunction
depthWriteEnabled :: Bool
depthStencilTextureFormat :: TextureFormat
bias :: DepthStencilState -> DepthBiasState
stencil :: DepthStencilState -> StencilState
depthCompare :: DepthStencilState -> CompareFunction
depthWriteEnabled :: DepthStencilState -> Bool
depthStencilTextureFormat :: DepthStencilState -> TextureFormat
..} = do
    WGPUTextureFormat
n_format <- TextureFormat -> ContT r IO WGPUTextureFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureFormat
depthStencilTextureFormat
    CBool
n_depthWriteEnabled <- Bool -> ContT r IO CBool
forall a b r. ToRaw a b => a -> ContT r IO b
raw Bool
depthWriteEnabled
    WGPUCompareFunction
n_depthCompare <- CompareFunction -> ContT r IO WGPUCompareFunction
forall a b r. ToRaw a b => a -> ContT r IO b
raw CompareFunction
depthCompare
    WGPUStencilFaceState
n_stencilFront <- StencilFaceState -> ContT r IO WGPUStencilFaceState
forall a b r. ToRaw a b => a -> ContT r IO b
raw (StencilFaceState -> ContT r IO WGPUStencilFaceState)
-> (StencilState -> StencilFaceState)
-> StencilState
-> ContT r IO WGPUStencilFaceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilState -> StencilFaceState
front (StencilState -> ContT r IO WGPUStencilFaceState)
-> StencilState -> ContT r IO WGPUStencilFaceState
forall a b. (a -> b) -> a -> b
$ StencilState
stencil
    WGPUStencilFaceState
n_stencilBack <- StencilFaceState -> ContT r IO WGPUStencilFaceState
forall a b r. ToRaw a b => a -> ContT r IO b
raw (StencilFaceState -> ContT r IO WGPUStencilFaceState)
-> (StencilState -> StencilFaceState)
-> StencilState
-> ContT r IO WGPUStencilFaceState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilState -> StencilFaceState
back (StencilState -> ContT r IO WGPUStencilFaceState)
-> StencilState -> ContT r IO WGPUStencilFaceState
forall a b. (a -> b) -> a -> b
$ StencilState
stencil
    WGPUDepthStencilState -> ContT r IO WGPUDepthStencilState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUDepthStencilState :: Ptr WGPUChainedStruct
-> WGPUTextureFormat
-> CBool
-> WGPUCompareFunction
-> WGPUStencilFaceState
-> WGPUStencilFaceState
-> Word32
-> Word32
-> Int32
-> CFloat
-> CFloat
-> WGPUDepthStencilState
WGPUDepthStencilState.WGPUDepthStencilState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          format :: WGPUTextureFormat
format = WGPUTextureFormat
n_format,
          depthWriteEnabled :: CBool
depthWriteEnabled = CBool
n_depthWriteEnabled,
          depthCompare :: WGPUCompareFunction
depthCompare = WGPUCompareFunction
n_depthCompare,
          stencilFront :: WGPUStencilFaceState
stencilFront = WGPUStencilFaceState
n_stencilFront,
          stencilBack :: WGPUStencilFaceState
stencilBack = WGPUStencilFaceState
n_stencilBack,
          stencilReadMask :: Word32
stencilReadMask = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32)
-> (StencilState -> Word8) -> StencilState -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StencilState -> Word8
readMask (StencilState -> Word32) -> StencilState -> Word32
forall a b. (a -> b) -> a -> b
$ StencilState
stencil,
          stencilWriteMask :: Word32
stencilWriteMask = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ StencilState -> Word8
writeMask (StencilState
stencil :: StencilState),
          depthBias :: Int32
depthBias = DepthBiasState -> Int32
constant DepthBiasState
bias,
          depthBiasSlopeScale :: CFloat
depthBiasSlopeScale = Float -> CFloat
CFloat (DepthBiasState -> Float
slopeScale DepthBiasState
bias),
          depthBiasClamp :: CFloat
depthBiasClamp = Float -> CFloat
CFloat (DepthBiasState -> Float
clamp DepthBiasState
bias)
        }

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

-- | Describes the multi-sampling state of a render pipeline.
data MultisampleState = MultisampleState
  { -- | Number of samples calculated per pixel (for MSAA). For
    -- non-multisampled textures, this should be 1.
    MultisampleState -> Word32
count :: Word32,
    -- | Bitmask that restricts the samples of a pixel modified by this
    -- pipeline. All samples can be enabled by using
    -- @0XFFFFFFFF@ (ie. zero complement).
    MultisampleState -> Word32
mask :: Word32,
    -- | When enabled, produces another sample mask per pixel based on the
    -- alpha output value, and that is AND-ed with the sample mask and the
    -- primitive coverage to restrict the set of samples affected by a
    -- primitive.
    MultisampleState -> Bool
alphaToCoverageEnabled :: Bool
  }
  deriving (MultisampleState -> MultisampleState -> Bool
(MultisampleState -> MultisampleState -> Bool)
-> (MultisampleState -> MultisampleState -> Bool)
-> Eq MultisampleState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultisampleState -> MultisampleState -> Bool
$c/= :: MultisampleState -> MultisampleState -> Bool
== :: MultisampleState -> MultisampleState -> Bool
$c== :: MultisampleState -> MultisampleState -> Bool
Eq, Int -> MultisampleState -> ShowS
[MultisampleState] -> ShowS
MultisampleState -> String
(Int -> MultisampleState -> ShowS)
-> (MultisampleState -> String)
-> ([MultisampleState] -> ShowS)
-> Show MultisampleState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultisampleState] -> ShowS
$cshowList :: [MultisampleState] -> ShowS
show :: MultisampleState -> String
$cshow :: MultisampleState -> String
showsPrec :: Int -> MultisampleState -> ShowS
$cshowsPrec :: Int -> MultisampleState -> ShowS
Show)

instance ToRaw MultisampleState WGPUMultisampleState where
  raw :: MultisampleState -> ContT r IO WGPUMultisampleState
raw MultisampleState {Bool
Word32
alphaToCoverageEnabled :: Bool
mask :: Word32
count :: Word32
alphaToCoverageEnabled :: MultisampleState -> Bool
mask :: MultisampleState -> Word32
count :: MultisampleState -> Word32
..} = do
    CBool
n_alphaToCoverageEnabled <- Bool -> ContT r IO CBool
forall a b r. ToRaw a b => a -> ContT r IO b
raw Bool
alphaToCoverageEnabled
    WGPUMultisampleState -> ContT r IO WGPUMultisampleState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUMultisampleState :: Ptr WGPUChainedStruct
-> Word32 -> Word32 -> CBool -> WGPUMultisampleState
WGPUMultisampleState.WGPUMultisampleState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          count :: Word32
count = Word32
count,
          mask :: Word32
mask = Word32
mask,
          alphaToCoverageEnabled :: CBool
alphaToCoverageEnabled = CBool
n_alphaToCoverageEnabled
        }

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

-- | Alpha blend factor.
data BlendFactor
  = BlendFactorZero
  | BlendFactorOne
  | BlendFactorSrc
  | BlendFactorOneMinusSrc
  | BlendFactorSrcAlpha
  | BlendFactorOneMinusSrcAlpha
  | BlendFactorDst
  | BlendFactorOneMinusDst
  | BlendFactorDstAlpha
  | BlendFactorOneMinusDstAlpha
  | BlendFactorSrcAlphaSaturated
  | BlendFactorConstant
  | BlendFactorOneMinusConstant
  deriving (BlendFactor -> BlendFactor -> Bool
(BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> Bool) -> Eq BlendFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendFactor -> BlendFactor -> Bool
$c/= :: BlendFactor -> BlendFactor -> Bool
== :: BlendFactor -> BlendFactor -> Bool
$c== :: BlendFactor -> BlendFactor -> Bool
Eq, Int -> BlendFactor -> ShowS
[BlendFactor] -> ShowS
BlendFactor -> String
(Int -> BlendFactor -> ShowS)
-> (BlendFactor -> String)
-> ([BlendFactor] -> ShowS)
-> Show BlendFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlendFactor] -> ShowS
$cshowList :: [BlendFactor] -> ShowS
show :: BlendFactor -> String
$cshow :: BlendFactor -> String
showsPrec :: Int -> BlendFactor -> ShowS
$cshowsPrec :: Int -> BlendFactor -> ShowS
Show)

-- | Convert a 'BlendFactor' to its raw value.
instance ToRaw BlendFactor WGPUBlendFactor where
  raw :: BlendFactor -> ContT r IO WGPUBlendFactor
raw BlendFactor
bf =
    WGPUBlendFactor -> ContT r IO WGPUBlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBlendFactor -> ContT r IO WGPUBlendFactor)
-> WGPUBlendFactor -> ContT r IO WGPUBlendFactor
forall a b. (a -> b) -> a -> b
$
      case BlendFactor
bf of
        BlendFactor
BlendFactorZero -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.Zero
        BlendFactor
BlendFactorOne -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.One
        BlendFactor
BlendFactorSrc -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.Src
        BlendFactor
BlendFactorOneMinusSrc -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.OneMinusSrc
        BlendFactor
BlendFactorSrcAlpha -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.SrcAlpha
        BlendFactor
BlendFactorOneMinusSrcAlpha -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.OneMinusSrcAlpha
        BlendFactor
BlendFactorDst -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.Dst
        BlendFactor
BlendFactorOneMinusDst -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.OneMinusDst
        BlendFactor
BlendFactorDstAlpha -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.DstAlpha
        BlendFactor
BlendFactorOneMinusDstAlpha -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.OneMinusDstAlpha
        BlendFactor
BlendFactorSrcAlphaSaturated -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.SrcAlphaSaturated
        BlendFactor
BlendFactorConstant -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.Constant
        BlendFactor
BlendFactorOneMinusConstant -> WGPUBlendFactor
forall a. (Eq a, Num a) => a
WGPUBlendFactor.OneMinusConstant

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

-- | Alpha blending operation.
data BlendOperation
  = BlendOperationAdd
  | BlendOperationSubtract
  | BlendOperationReverseSubtract
  | BlendOperationMin
  | BlendOperationMax
  deriving (BlendOperation -> BlendOperation -> Bool
(BlendOperation -> BlendOperation -> Bool)
-> (BlendOperation -> BlendOperation -> Bool) -> Eq BlendOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendOperation -> BlendOperation -> Bool
$c/= :: BlendOperation -> BlendOperation -> Bool
== :: BlendOperation -> BlendOperation -> Bool
$c== :: BlendOperation -> BlendOperation -> Bool
Eq, Int -> BlendOperation -> ShowS
[BlendOperation] -> ShowS
BlendOperation -> String
(Int -> BlendOperation -> ShowS)
-> (BlendOperation -> String)
-> ([BlendOperation] -> ShowS)
-> Show BlendOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlendOperation] -> ShowS
$cshowList :: [BlendOperation] -> ShowS
show :: BlendOperation -> String
$cshow :: BlendOperation -> String
showsPrec :: Int -> BlendOperation -> ShowS
$cshowsPrec :: Int -> BlendOperation -> ShowS
Show)

-- | Convert a 'BlendOperation' to its raw value.
instance ToRaw BlendOperation WGPUBlendOperation where
  raw :: BlendOperation -> ContT r IO WGPUBlendOperation
raw BlendOperation
bo =
    WGPUBlendOperation -> ContT r IO WGPUBlendOperation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUBlendOperation -> ContT r IO WGPUBlendOperation)
-> WGPUBlendOperation -> ContT r IO WGPUBlendOperation
forall a b. (a -> b) -> a -> b
$
      case BlendOperation
bo of
        BlendOperation
BlendOperationAdd -> WGPUBlendOperation
forall a. (Eq a, Num a) => a
WGPUBlendOperation.Add
        BlendOperation
BlendOperationSubtract -> WGPUBlendOperation
forall a. (Eq a, Num a) => a
WGPUBlendOperation.Subtract
        BlendOperation
BlendOperationReverseSubtract -> WGPUBlendOperation
forall a. (Eq a, Num a) => a
WGPUBlendOperation.ReverseSubtract
        BlendOperation
BlendOperationMin -> WGPUBlendOperation
forall a. (Eq a, Num a) => a
WGPUBlendOperation.Min
        BlendOperation
BlendOperationMax -> WGPUBlendOperation
forall a. (Eq a, Num a) => a
WGPUBlendOperation.Max

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

-- | Describes the blend component of a pipeline.
data BlendComponent = BlendComponent
  { -- | Multiplier for the source, which is produced by the fragment shader.
    BlendComponent -> BlendFactor
srcFactor :: !BlendFactor,
    -- | Multiplier for the destination, which is stored in the target.
    BlendComponent -> BlendFactor
dstFactor :: !BlendFactor,
    -- | Binary operation applied to the source and destination, multiplied by
    -- their respective factors.
    BlendComponent -> BlendOperation
operation :: !BlendOperation
  }
  deriving (BlendComponent -> BlendComponent -> Bool
(BlendComponent -> BlendComponent -> Bool)
-> (BlendComponent -> BlendComponent -> Bool) -> Eq BlendComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendComponent -> BlendComponent -> Bool
$c/= :: BlendComponent -> BlendComponent -> Bool
== :: BlendComponent -> BlendComponent -> Bool
$c== :: BlendComponent -> BlendComponent -> Bool
Eq, Int -> BlendComponent -> ShowS
[BlendComponent] -> ShowS
BlendComponent -> String
(Int -> BlendComponent -> ShowS)
-> (BlendComponent -> String)
-> ([BlendComponent] -> ShowS)
-> Show BlendComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlendComponent] -> ShowS
$cshowList :: [BlendComponent] -> ShowS
show :: BlendComponent -> String
$cshow :: BlendComponent -> String
showsPrec :: Int -> BlendComponent -> ShowS
$cshowsPrec :: Int -> BlendComponent -> ShowS
Show)

instance Default BlendComponent where
  def :: BlendComponent
def =
    BlendComponent :: BlendFactor -> BlendFactor -> BlendOperation -> BlendComponent
BlendComponent
      { srcFactor :: BlendFactor
srcFactor = BlendFactor
BlendFactorOne,
        dstFactor :: BlendFactor
dstFactor = BlendFactor
BlendFactorZero,
        operation :: BlendOperation
operation = BlendOperation
BlendOperationAdd
      }

instance ToRaw BlendComponent WGPUBlendComponent where
  raw :: BlendComponent -> ContT r IO WGPUBlendComponent
raw BlendComponent {BlendOperation
BlendFactor
operation :: BlendOperation
dstFactor :: BlendFactor
srcFactor :: BlendFactor
operation :: BlendComponent -> BlendOperation
dstFactor :: BlendComponent -> BlendFactor
srcFactor :: BlendComponent -> BlendFactor
..} = do
    WGPUBlendFactor
n_srcFactor <- BlendFactor -> ContT r IO WGPUBlendFactor
forall a b r. ToRaw a b => a -> ContT r IO b
raw BlendFactor
srcFactor
    WGPUBlendFactor
n_dstFactor <- BlendFactor -> ContT r IO WGPUBlendFactor
forall a b r. ToRaw a b => a -> ContT r IO b
raw BlendFactor
dstFactor
    WGPUBlendOperation
n_operation <- BlendOperation -> ContT r IO WGPUBlendOperation
forall a b r. ToRaw a b => a -> ContT r IO b
raw BlendOperation
operation
    WGPUBlendComponent -> ContT r IO WGPUBlendComponent
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUBlendComponent :: WGPUBlendFactor
-> WGPUBlendFactor -> WGPUBlendOperation -> WGPUBlendComponent
WGPUBlendComponent.WGPUBlendComponent
        { srcFactor :: WGPUBlendFactor
srcFactor = WGPUBlendFactor
n_srcFactor,
          dstFactor :: WGPUBlendFactor
dstFactor = WGPUBlendFactor
n_dstFactor,
          operation :: WGPUBlendOperation
operation = WGPUBlendOperation
n_operation
        }

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

-- | Describes the blend state of a render pipeline.
data BlendState = BlendState
  { -- | Color equation.
    BlendState -> BlendComponent
blendColor :: !BlendComponent,
    -- | Alpha equation.
    BlendState -> BlendComponent
blendAlpha :: !BlendComponent
  }
  deriving (BlendState -> BlendState -> Bool
(BlendState -> BlendState -> Bool)
-> (BlendState -> BlendState -> Bool) -> Eq BlendState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendState -> BlendState -> Bool
$c/= :: BlendState -> BlendState -> Bool
== :: BlendState -> BlendState -> Bool
$c== :: BlendState -> BlendState -> Bool
Eq, Int -> BlendState -> ShowS
[BlendState] -> ShowS
BlendState -> String
(Int -> BlendState -> ShowS)
-> (BlendState -> String)
-> ([BlendState] -> ShowS)
-> Show BlendState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlendState] -> ShowS
$cshowList :: [BlendState] -> ShowS
show :: BlendState -> String
$cshow :: BlendState -> String
showsPrec :: Int -> BlendState -> ShowS
$cshowsPrec :: Int -> BlendState -> ShowS
Show)

instance ToRaw BlendState WGPUBlendState where
  raw :: BlendState -> ContT r IO WGPUBlendState
raw BlendState {BlendComponent
blendAlpha :: BlendComponent
blendColor :: BlendComponent
blendAlpha :: BlendState -> BlendComponent
blendColor :: BlendState -> BlendComponent
..} = do
    WGPUBlendComponent
n_color <- BlendComponent -> ContT r IO WGPUBlendComponent
forall a b r. ToRaw a b => a -> ContT r IO b
raw BlendComponent
blendColor
    WGPUBlendComponent
n_alpha <- BlendComponent -> ContT r IO WGPUBlendComponent
forall a b r. ToRaw a b => a -> ContT r IO b
raw BlendComponent
blendAlpha
    WGPUBlendState -> ContT r IO WGPUBlendState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUBlendState :: WGPUBlendComponent -> WGPUBlendComponent -> WGPUBlendState
WGPUBlendState.WGPUBlendState
        { color :: WGPUBlendComponent
color = WGPUBlendComponent
n_color,
          alpha :: WGPUBlendComponent
alpha = WGPUBlendComponent
n_alpha
        }

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

-- | Describes which color channels are written.
data ColorWriteMask = ColorWriteMask
  { ColorWriteMask -> Bool
maskRed :: !Bool,
    ColorWriteMask -> Bool
maskGreen :: !Bool,
    ColorWriteMask -> Bool
maskBlue :: !Bool,
    ColorWriteMask -> Bool
maskAlpha :: !Bool
  }
  deriving (ColorWriteMask -> ColorWriteMask -> Bool
(ColorWriteMask -> ColorWriteMask -> Bool)
-> (ColorWriteMask -> ColorWriteMask -> Bool) -> Eq ColorWriteMask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorWriteMask -> ColorWriteMask -> Bool
$c/= :: ColorWriteMask -> ColorWriteMask -> Bool
== :: ColorWriteMask -> ColorWriteMask -> Bool
$c== :: ColorWriteMask -> ColorWriteMask -> Bool
Eq, Int -> ColorWriteMask -> ShowS
[ColorWriteMask] -> ShowS
ColorWriteMask -> String
(Int -> ColorWriteMask -> ShowS)
-> (ColorWriteMask -> String)
-> ([ColorWriteMask] -> ShowS)
-> Show ColorWriteMask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorWriteMask] -> ShowS
$cshowList :: [ColorWriteMask] -> ShowS
show :: ColorWriteMask -> String
$cshow :: ColorWriteMask -> String
showsPrec :: Int -> ColorWriteMask -> ShowS
$cshowsPrec :: Int -> ColorWriteMask -> ShowS
Show)

-- | A 'ColorWriteMask' that writes all colors and the alpha value.
colorWriteMaskAll :: ColorWriteMask
colorWriteMaskAll :: ColorWriteMask
colorWriteMaskAll = Bool -> Bool -> Bool -> Bool -> ColorWriteMask
ColorWriteMask Bool
True Bool
True Bool
True Bool
True

instance ToRaw ColorWriteMask WGPUColorWriteMask where
  raw :: ColorWriteMask -> ContT r IO WGPUColorWriteMask
raw ColorWriteMask {Bool
maskAlpha :: Bool
maskBlue :: Bool
maskGreen :: Bool
maskRed :: Bool
maskAlpha :: ColorWriteMask -> Bool
maskBlue :: ColorWriteMask -> Bool
maskGreen :: ColorWriteMask -> Bool
maskRed :: ColorWriteMask -> Bool
..} =
    WGPUColorWriteMask -> ContT r IO WGPUColorWriteMask
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUColorWriteMask -> ContT r IO WGPUColorWriteMask)
-> WGPUColorWriteMask -> ContT r IO WGPUColorWriteMask
forall a b. (a -> b) -> a -> b
$
      Word32 -> WGPUColorWriteMask
WGPUColorWriteMask
        ( (if Bool
maskRed then Word32
forall a. (Eq a, Num a) => a
WGPUColorWriteMask.Red else Word32
0)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (if Bool
maskGreen then Word32
forall a. (Eq a, Num a) => a
WGPUColorWriteMask.Green else Word32
0)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (if Bool
maskBlue then Word32
forall a. (Eq a, Num a) => a
WGPUColorWriteMask.Blue else Word32
0)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (if Bool
maskAlpha then Word32
forall a. (Eq a, Num a) => a
WGPUColorWriteMask.Alpha else Word32
0)
        )

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

-- | Describes the color state of a render pipeline.
data ColorTargetState = ColorTargetState
  { -- | The texture format of the image that this pipeline will render to.
    -- Must match the format of the corresponding color attachment in the
    -- command encoder.
    ColorTargetState -> TextureFormat
colorTextureFormat :: !TextureFormat,
    -- | The blending that is used for this pipeline.
    ColorTargetState -> SMaybe BlendState
blend :: !(SMaybe BlendState),
    -- | Mask which enables or disables writes to different color/alpha
    -- channels.
    ColorTargetState -> ColorWriteMask
colorWriteMask :: !ColorWriteMask
  }
  deriving (ColorTargetState -> ColorTargetState -> Bool
(ColorTargetState -> ColorTargetState -> Bool)
-> (ColorTargetState -> ColorTargetState -> Bool)
-> Eq ColorTargetState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorTargetState -> ColorTargetState -> Bool
$c/= :: ColorTargetState -> ColorTargetState -> Bool
== :: ColorTargetState -> ColorTargetState -> Bool
$c== :: ColorTargetState -> ColorTargetState -> Bool
Eq, Int -> ColorTargetState -> ShowS
[ColorTargetState] -> ShowS
ColorTargetState -> String
(Int -> ColorTargetState -> ShowS)
-> (ColorTargetState -> String)
-> ([ColorTargetState] -> ShowS)
-> Show ColorTargetState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorTargetState] -> ShowS
$cshowList :: [ColorTargetState] -> ShowS
show :: ColorTargetState -> String
$cshow :: ColorTargetState -> String
showsPrec :: Int -> ColorTargetState -> ShowS
$cshowsPrec :: Int -> ColorTargetState -> ShowS
Show)

instance ToRaw ColorTargetState WGPUColorTargetState where
  raw :: ColorTargetState -> ContT r IO WGPUColorTargetState
raw ColorTargetState {SMaybe BlendState
TextureFormat
ColorWriteMask
colorWriteMask :: ColorWriteMask
blend :: SMaybe BlendState
colorTextureFormat :: TextureFormat
colorWriteMask :: ColorTargetState -> ColorWriteMask
blend :: ColorTargetState -> SMaybe BlendState
colorTextureFormat :: ColorTargetState -> TextureFormat
..} = do
    WGPUTextureFormat
n_format <- TextureFormat -> ContT r IO WGPUTextureFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureFormat
colorTextureFormat
    Ptr WGPUBlendState
blend_ptr <-
      case SMaybe BlendState
blend of
        SMaybe BlendState
SNothing -> Ptr WGPUBlendState -> ContT r IO (Ptr WGPUBlendState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr WGPUBlendState
forall a. Ptr a
nullPtr
        SJust BlendState
x -> BlendState -> ContT r IO (Ptr WGPUBlendState)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr BlendState
x
    WGPUColorWriteMask Word32
n_writeMask <- ColorWriteMask -> ContT r IO WGPUColorWriteMask
forall a b r. ToRaw a b => a -> ContT r IO b
raw ColorWriteMask
colorWriteMask
    WGPUColorTargetState -> ContT r IO WGPUColorTargetState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUColorTargetState :: Ptr WGPUChainedStruct
-> WGPUTextureFormat
-> Ptr WGPUBlendState
-> Word32
-> WGPUColorTargetState
WGPUColorTargetState.WGPUColorTargetState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          format :: WGPUTextureFormat
format = WGPUTextureFormat
n_format,
          blend :: Ptr WGPUBlendState
blend = Ptr WGPUBlendState
blend_ptr,
          writeMask :: Word32
writeMask = Word32
n_writeMask
        }

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

-- | Describes the fragment processing in a render pipeline.
data FragmentState = FragmentState
  { -- | The compiled shader module for this stage.
    FragmentState -> ShaderModule
fragmentShaderModule :: !ShaderModule,
    -- | The entry point in the compiled shader. There must be a function that
    -- returns @void@ with this name in the shader.
    FragmentState -> ShaderEntryPoint
fragmentEntryPoint :: !ShaderEntryPoint,
    -- | The color state of the render targets.
    FragmentState -> Vector ColorTargetState
targets :: !(Vector ColorTargetState)
  }
  deriving (FragmentState -> FragmentState -> Bool
(FragmentState -> FragmentState -> Bool)
-> (FragmentState -> FragmentState -> Bool) -> Eq FragmentState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragmentState -> FragmentState -> Bool
$c/= :: FragmentState -> FragmentState -> Bool
== :: FragmentState -> FragmentState -> Bool
$c== :: FragmentState -> FragmentState -> Bool
Eq, Int -> FragmentState -> ShowS
[FragmentState] -> ShowS
FragmentState -> String
(Int -> FragmentState -> ShowS)
-> (FragmentState -> String)
-> ([FragmentState] -> ShowS)
-> Show FragmentState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FragmentState] -> ShowS
$cshowList :: [FragmentState] -> ShowS
show :: FragmentState -> String
$cshow :: FragmentState -> String
showsPrec :: Int -> FragmentState -> ShowS
$cshowsPrec :: Int -> FragmentState -> ShowS
Show)

instance ToRaw FragmentState WGPUFragmentState where
  raw :: FragmentState -> ContT r IO WGPUFragmentState
raw FragmentState {Vector ColorTargetState
ShaderEntryPoint
ShaderModule
targets :: Vector ColorTargetState
fragmentEntryPoint :: ShaderEntryPoint
fragmentShaderModule :: ShaderModule
targets :: FragmentState -> Vector ColorTargetState
fragmentEntryPoint :: FragmentState -> ShaderEntryPoint
fragmentShaderModule :: FragmentState -> ShaderModule
..} = do
    WGPUShaderModule
n_shaderModule <- ShaderModule -> ContT r IO WGPUShaderModule
forall a b r. ToRaw a b => a -> ContT r IO b
raw ShaderModule
fragmentShaderModule
    Ptr CChar
entryPoint_ptr <- ShaderEntryPoint -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr ShaderEntryPoint
fragmentEntryPoint
    Ptr WGPUColorTargetState
targets_ptr <- Vector ColorTargetState -> ContT r IO (Ptr WGPUColorTargetState)
forall (v :: * -> *) r a b.
(ToRaw a b, Storable b, Vector v a) =>
v a -> ContT r IO (Ptr b)
rawArrayPtr Vector ColorTargetState
targets
    WGPUFragmentState -> ContT r IO WGPUFragmentState
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUFragmentState :: Ptr WGPUChainedStruct
-> WGPUShaderModule
-> Ptr CChar
-> Word32
-> Ptr WGPUColorTargetState
-> WGPUFragmentState
WGPUFragmentState.WGPUFragmentState
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          shaderModule :: WGPUShaderModule
shaderModule = WGPUShaderModule
n_shaderModule,
          entryPoint :: Ptr CChar
entryPoint = Ptr CChar
entryPoint_ptr,
          targetCount :: Word32
targetCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (Vector ColorTargetState -> Int)
-> Vector ColorTargetState
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ColorTargetState -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector ColorTargetState -> Word32)
-> Vector ColorTargetState -> Word32
forall a b. (a -> b) -> a -> b
$ Vector ColorTargetState
targets,
          targets :: Ptr WGPUColorTargetState
targets = Ptr WGPUColorTargetState
targets_ptr
        }

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

-- | Describes a render (graphics) pipeline.
data RenderPipelineDescriptor = RenderPipelineDescriptor
  { -- | Debug label of the pipeline.
    RenderPipelineDescriptor -> Text
renderPipelineLabel :: !Text,
    -- | The layout of bind groups for this pipeline.
    RenderPipelineDescriptor -> SMaybe PipelineLayout
layout :: !(SMaybe PipelineLayout),
    -- | Vertex state.
    RenderPipelineDescriptor -> VertexState
vertex :: !VertexState,
    -- | Primitive state.
    RenderPipelineDescriptor -> PrimitiveState
primitive :: !PrimitiveState,
    -- | Depth stencil state.
    RenderPipelineDescriptor -> SMaybe DepthStencilState
depthStencil :: !(SMaybe DepthStencilState),
    -- | Multisample state.
    RenderPipelineDescriptor -> MultisampleState
multisample :: !MultisampleState,
    -- | Fragment state.
    RenderPipelineDescriptor -> SMaybe FragmentState
fragment :: !(SMaybe FragmentState)
  }
  deriving (RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool
(RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool)
-> (RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool)
-> Eq RenderPipelineDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool
$c/= :: RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool
== :: RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool
$c== :: RenderPipelineDescriptor -> RenderPipelineDescriptor -> Bool
Eq, Int -> RenderPipelineDescriptor -> ShowS
[RenderPipelineDescriptor] -> ShowS
RenderPipelineDescriptor -> String
(Int -> RenderPipelineDescriptor -> ShowS)
-> (RenderPipelineDescriptor -> String)
-> ([RenderPipelineDescriptor] -> ShowS)
-> Show RenderPipelineDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderPipelineDescriptor] -> ShowS
$cshowList :: [RenderPipelineDescriptor] -> ShowS
show :: RenderPipelineDescriptor -> String
$cshow :: RenderPipelineDescriptor -> String
showsPrec :: Int -> RenderPipelineDescriptor -> ShowS
$cshowsPrec :: Int -> RenderPipelineDescriptor -> ShowS
Show)

instance ToRaw RenderPipelineDescriptor WGPURenderPipelineDescriptor where
  raw :: RenderPipelineDescriptor -> ContT r IO WGPURenderPipelineDescriptor
raw RenderPipelineDescriptor {Text
SMaybe FragmentState
SMaybe DepthStencilState
SMaybe PipelineLayout
MultisampleState
PrimitiveState
VertexState
fragment :: SMaybe FragmentState
multisample :: MultisampleState
depthStencil :: SMaybe DepthStencilState
primitive :: PrimitiveState
vertex :: VertexState
layout :: SMaybe PipelineLayout
renderPipelineLabel :: Text
fragment :: RenderPipelineDescriptor -> SMaybe FragmentState
multisample :: RenderPipelineDescriptor -> MultisampleState
depthStencil :: RenderPipelineDescriptor -> SMaybe DepthStencilState
primitive :: RenderPipelineDescriptor -> PrimitiveState
vertex :: RenderPipelineDescriptor -> VertexState
layout :: RenderPipelineDescriptor -> SMaybe PipelineLayout
renderPipelineLabel :: RenderPipelineDescriptor -> 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
renderPipelineLabel
    WGPUPipelineLayout
n_layout <-
      case SMaybe PipelineLayout
layout of
        SMaybe PipelineLayout
SNothing -> WGPUPipelineLayout -> ContT r IO WGPUPipelineLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr () -> WGPUPipelineLayout
WGPUPipelineLayout Ptr ()
forall a. Ptr a
nullPtr)
        SJust PipelineLayout
x -> PipelineLayout -> ContT r IO WGPUPipelineLayout
forall a b r. ToRaw a b => a -> ContT r IO b
raw PipelineLayout
x
    WGPUVertexState
n_vertex <- VertexState -> ContT r IO WGPUVertexState
forall a b r. ToRaw a b => a -> ContT r IO b
raw VertexState
vertex
    WGPUPrimitiveState
n_primitive <- PrimitiveState -> ContT r IO WGPUPrimitiveState
forall a b r. ToRaw a b => a -> ContT r IO b
raw PrimitiveState
primitive
    Ptr WGPUDepthStencilState
n_depthStencil <-
      case SMaybe DepthStencilState
depthStencil of
        SMaybe DepthStencilState
SNothing -> Ptr WGPUDepthStencilState -> ContT r IO (Ptr WGPUDepthStencilState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr WGPUDepthStencilState
forall a. Ptr a
nullPtr
        SJust DepthStencilState
x -> DepthStencilState -> ContT r IO (Ptr WGPUDepthStencilState)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr DepthStencilState
x
    WGPUMultisampleState
n_multisample <- MultisampleState -> ContT r IO WGPUMultisampleState
forall a b r. ToRaw a b => a -> ContT r IO b
raw MultisampleState
multisample
    Ptr WGPUFragmentState
n_fragment <-
      case SMaybe FragmentState
fragment of
        SMaybe FragmentState
SNothing -> Ptr WGPUFragmentState -> ContT r IO (Ptr WGPUFragmentState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr WGPUFragmentState
forall a. Ptr a
nullPtr
        SJust FragmentState
x -> FragmentState -> ContT r IO (Ptr WGPUFragmentState)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr FragmentState
x
    WGPURenderPipelineDescriptor
-> ContT r IO WGPURenderPipelineDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPURenderPipelineDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> WGPUPipelineLayout
-> WGPUVertexState
-> WGPUPrimitiveState
-> Ptr WGPUDepthStencilState
-> WGPUMultisampleState
-> Ptr WGPUFragmentState
-> WGPURenderPipelineDescriptor
WGPURenderPipelineDescriptor.WGPURenderPipelineDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          layout :: WGPUPipelineLayout
layout = WGPUPipelineLayout
n_layout,
          vertex :: WGPUVertexState
vertex = WGPUVertexState
n_vertex,
          primitive :: WGPUPrimitiveState
primitive = WGPUPrimitiveState
n_primitive,
          depthStencil :: Ptr WGPUDepthStencilState
depthStencil = Ptr WGPUDepthStencilState
n_depthStencil,
          multisample :: WGPUMultisampleState
multisample = WGPUMultisampleState
n_multisample,
          fragment :: Ptr WGPUFragmentState
fragment = Ptr WGPUFragmentState
n_fragment
        }

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

createRenderPipeline ::
  MonadIO m =>
  Device ->
  RenderPipelineDescriptor ->
  m RenderPipeline
createRenderPipeline :: Device -> RenderPipelineDescriptor -> m RenderPipeline
createRenderPipeline Device
device RenderPipelineDescriptor
rpd = IO RenderPipeline -> m RenderPipeline
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderPipeline -> m RenderPipeline)
-> (ContT RenderPipeline IO RenderPipeline -> IO RenderPipeline)
-> ContT RenderPipeline IO RenderPipeline
-> m RenderPipeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT RenderPipeline IO RenderPipeline -> IO RenderPipeline
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT RenderPipeline IO RenderPipeline -> m RenderPipeline)
-> ContT RenderPipeline IO RenderPipeline -> m RenderPipeline
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Device -> Instance
deviceInst Device
device
  Ptr WGPURenderPipelineDescriptor
renderPipelineDescriptor_ptr <- RenderPipelineDescriptor
-> ContT RenderPipeline IO (Ptr WGPURenderPipelineDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr RenderPipelineDescriptor
rpd
  WGPURenderPipeline
renderPipelineRaw <-
    WGPUHsInstance
-> WGPUDevice
-> Ptr WGPURenderPipelineDescriptor
-> ContT RenderPipeline IO WGPURenderPipeline
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUDevice
-> Ptr WGPURenderPipelineDescriptor
-> m WGPURenderPipeline
RawFun.wgpuDeviceCreateRenderPipeline
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Device -> WGPUDevice
wgpuDevice Device
device)
      Ptr WGPURenderPipelineDescriptor
renderPipelineDescriptor_ptr
  RenderPipeline -> ContT RenderPipeline IO RenderPipeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPURenderPipeline -> RenderPipeline
RenderPipeline WGPURenderPipeline
renderPipelineRaw)