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

-- |
-- Module      : WGPU.Internal.Multipurpose
-- Description : Multipurpose
--
-- This is a bit like a "Types" module. It exists to collect things which are
-- somewhat generic and are used in more than one part of the API.
module WGPU.Internal.Multipurpose
  ( -- * Types
    Texture (..),
    CompareFunction (..),
    Origin3D (..),
    Extent3D (..),
    TextureAspect (..),
    ImageCopyTexture (..),
    TextureDataLayout (..),
    IndexFormat (..),
  )
where

import Data.Word (Word32)
import Foreign (Word64, nullPtr)
import WGPU.Internal.Instance (Instance)
import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)
import WGPU.Raw.Generated.Enum.WGPUCompareFunction (WGPUCompareFunction)
import qualified WGPU.Raw.Generated.Enum.WGPUCompareFunction as WGPUCompareFunction
import WGPU.Raw.Generated.Enum.WGPUIndexFormat (WGPUIndexFormat)
import qualified WGPU.Raw.Generated.Enum.WGPUIndexFormat as WGPUIndexFormat
import WGPU.Raw.Generated.Enum.WGPUTextureAspect (WGPUTextureAspect)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureAspect as WGPUTextureAspect
import WGPU.Raw.Generated.Struct.WGPUExtent3D (WGPUExtent3D)
import qualified WGPU.Raw.Generated.Struct.WGPUExtent3D as WGPUExtent3D
import WGPU.Raw.Generated.Struct.WGPUImageCopyTexture (WGPUImageCopyTexture)
import qualified WGPU.Raw.Generated.Struct.WGPUImageCopyTexture as WGPU
import qualified WGPU.Raw.Generated.Struct.WGPUImageCopyTexture as WGPUImageCopyTexture
import WGPU.Raw.Generated.Struct.WGPUOrigin3D (WGPUOrigin3D)
import qualified WGPU.Raw.Generated.Struct.WGPUOrigin3D as WGPUOrigin3D
import WGPU.Raw.Generated.Struct.WGPUTextureDataLayout (WGPUTextureDataLayout)
import qualified WGPU.Raw.Generated.Struct.WGPUTextureDataLayout as WGPUTextureDataLayout
import WGPU.Raw.Types (WGPUTexture (WGPUTexture))

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

-- | Handle to a texture.
data Texture = Texture
  { Texture -> Instance
textureInst :: !Instance,
    Texture -> WGPUTexture
wgpuTexture :: !WGPUTexture
  }

instance Show Texture where
  show :: Texture -> String
show Texture
t =
    let Texture Instance
_ (WGPUTexture Ptr ()
ptr) = Texture
t
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"Texture" Ptr ()
ptr

instance Eq Texture where
  == :: Texture -> Texture -> Bool
(==) Texture
t1 Texture
t2 =
    let Texture Instance
_ (WGPUTexture Ptr ()
t1_ptr) = Texture
t1
        Texture Instance
_ (WGPUTexture Ptr ()
t2_ptr) = Texture
t2
     in Ptr ()
t1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
t2_ptr

instance ToRaw Texture WGPUTexture where
  raw :: Texture -> ContT r IO WGPUTexture
raw = WGPUTexture -> ContT r IO WGPUTexture
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTexture -> ContT r IO WGPUTexture)
-> (Texture -> WGPUTexture) -> Texture -> ContT r IO WGPUTexture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture -> WGPUTexture
wgpuTexture

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

-- | Comparison function used for depth and stencil operations.
data CompareFunction
  = CompareFunctionNever
  | CompareFunctionLess
  | CompareFunctionEqual
  | CompareFunctionLessEqual
  | CompareFunctionGreater
  | CompareFunctionNotEqual
  | CompareFunctionGreaterEqual
  | CompareFunctionAlways
  deriving (CompareFunction -> CompareFunction -> Bool
(CompareFunction -> CompareFunction -> Bool)
-> (CompareFunction -> CompareFunction -> Bool)
-> Eq CompareFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareFunction -> CompareFunction -> Bool
$c/= :: CompareFunction -> CompareFunction -> Bool
== :: CompareFunction -> CompareFunction -> Bool
$c== :: CompareFunction -> CompareFunction -> Bool
Eq, Int -> CompareFunction -> ShowS
[CompareFunction] -> ShowS
CompareFunction -> String
(Int -> CompareFunction -> ShowS)
-> (CompareFunction -> String)
-> ([CompareFunction] -> ShowS)
-> Show CompareFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompareFunction] -> ShowS
$cshowList :: [CompareFunction] -> ShowS
show :: CompareFunction -> String
$cshow :: CompareFunction -> String
showsPrec :: Int -> CompareFunction -> ShowS
$cshowsPrec :: Int -> CompareFunction -> ShowS
Show)

-- | Convert a 'CompareFunction' to its raw value.
instance ToRaw CompareFunction WGPUCompareFunction where
  raw :: CompareFunction -> ContT r IO WGPUCompareFunction
raw CompareFunction
cf =
    WGPUCompareFunction -> ContT r IO WGPUCompareFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUCompareFunction -> ContT r IO WGPUCompareFunction)
-> WGPUCompareFunction -> ContT r IO WGPUCompareFunction
forall a b. (a -> b) -> a -> b
$
      case CompareFunction
cf of
        CompareFunction
CompareFunctionNever -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.Never
        CompareFunction
CompareFunctionLess -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.Less
        CompareFunction
CompareFunctionEqual -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.Equal
        CompareFunction
CompareFunctionLessEqual -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.LessEqual
        CompareFunction
CompareFunctionGreater -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.Greater
        CompareFunction
CompareFunctionNotEqual -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.NotEqual
        CompareFunction
CompareFunctionGreaterEqual -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.GreaterEqual
        CompareFunction
CompareFunctionAlways -> WGPUCompareFunction
forall a. (Eq a, Num a) => a
WGPUCompareFunction.Always

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

-- | Origin of a copy to/from a texture.
data Origin3D = Origin3D
  { Origin3D -> Word32
originX :: !Word32,
    Origin3D -> Word32
originY :: !Word32,
    Origin3D -> Word32
originZ :: !Word32
  }
  deriving (Origin3D -> Origin3D -> Bool
(Origin3D -> Origin3D -> Bool)
-> (Origin3D -> Origin3D -> Bool) -> Eq Origin3D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin3D -> Origin3D -> Bool
$c/= :: Origin3D -> Origin3D -> Bool
== :: Origin3D -> Origin3D -> Bool
$c== :: Origin3D -> Origin3D -> Bool
Eq, Int -> Origin3D -> ShowS
[Origin3D] -> ShowS
Origin3D -> String
(Int -> Origin3D -> ShowS)
-> (Origin3D -> String) -> ([Origin3D] -> ShowS) -> Show Origin3D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin3D] -> ShowS
$cshowList :: [Origin3D] -> ShowS
show :: Origin3D -> String
$cshow :: Origin3D -> String
showsPrec :: Int -> Origin3D -> ShowS
$cshowsPrec :: Int -> Origin3D -> ShowS
Show)

instance ToRaw Origin3D WGPUOrigin3D where
  raw :: Origin3D -> ContT r IO WGPUOrigin3D
raw Origin3D {Word32
originZ :: Word32
originY :: Word32
originX :: Word32
originZ :: Origin3D -> Word32
originY :: Origin3D -> Word32
originX :: Origin3D -> Word32
..} =
    WGPUOrigin3D -> ContT r IO WGPUOrigin3D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUOrigin3D -> ContT r IO WGPUOrigin3D)
-> WGPUOrigin3D -> ContT r IO WGPUOrigin3D
forall a b. (a -> b) -> a -> b
$
      WGPUOrigin3D :: Word32 -> Word32 -> Word32 -> WGPUOrigin3D
WGPUOrigin3D.WGPUOrigin3D
        { x :: Word32
x = Word32
originX,
          y :: Word32
y = Word32
originY,
          z :: Word32
z = Word32
originZ
        }

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

-- | Extent of a texture or texture-related operation.
data Extent3D = Extent3D
  { Extent3D -> Word32
extentWidth :: !Word32,
    Extent3D -> Word32
extentHeight :: !Word32,
    Extent3D -> Word32
extentDepthOrArrayLayers :: !Word32
  }
  deriving (Extent3D -> Extent3D -> Bool
(Extent3D -> Extent3D -> Bool)
-> (Extent3D -> Extent3D -> Bool) -> Eq Extent3D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extent3D -> Extent3D -> Bool
$c/= :: Extent3D -> Extent3D -> Bool
== :: Extent3D -> Extent3D -> Bool
$c== :: Extent3D -> Extent3D -> Bool
Eq, Int -> Extent3D -> ShowS
[Extent3D] -> ShowS
Extent3D -> String
(Int -> Extent3D -> ShowS)
-> (Extent3D -> String) -> ([Extent3D] -> ShowS) -> Show Extent3D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extent3D] -> ShowS
$cshowList :: [Extent3D] -> ShowS
show :: Extent3D -> String
$cshow :: Extent3D -> String
showsPrec :: Int -> Extent3D -> ShowS
$cshowsPrec :: Int -> Extent3D -> ShowS
Show)

instance ToRaw Extent3D WGPUExtent3D where
  raw :: Extent3D -> ContT r IO WGPUExtent3D
raw Extent3D {Word32
extentDepthOrArrayLayers :: Word32
extentHeight :: Word32
extentWidth :: Word32
extentDepthOrArrayLayers :: Extent3D -> Word32
extentHeight :: Extent3D -> Word32
extentWidth :: Extent3D -> Word32
..} =
    WGPUExtent3D -> ContT r IO WGPUExtent3D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUExtent3D -> ContT r IO WGPUExtent3D)
-> WGPUExtent3D -> ContT r IO WGPUExtent3D
forall a b. (a -> b) -> a -> b
$
      WGPUExtent3D :: Word32 -> Word32 -> Word32 -> WGPUExtent3D
WGPUExtent3D.WGPUExtent3D
        { width :: Word32
width = Word32
extentWidth,
          height :: Word32
height = Word32
extentHeight,
          depthOrArrayLayers :: Word32
depthOrArrayLayers = Word32
extentDepthOrArrayLayers
        }

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

-- | Kind of data a texture holds.
data TextureAspect
  = TextureAspectAll
  | TextureAspectStencilOnly
  | TextureAspectDepthOnly
  deriving (TextureAspect -> TextureAspect -> Bool
(TextureAspect -> TextureAspect -> Bool)
-> (TextureAspect -> TextureAspect -> Bool) -> Eq TextureAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureAspect -> TextureAspect -> Bool
$c/= :: TextureAspect -> TextureAspect -> Bool
== :: TextureAspect -> TextureAspect -> Bool
$c== :: TextureAspect -> TextureAspect -> Bool
Eq, Int -> TextureAspect -> ShowS
[TextureAspect] -> ShowS
TextureAspect -> String
(Int -> TextureAspect -> ShowS)
-> (TextureAspect -> String)
-> ([TextureAspect] -> ShowS)
-> Show TextureAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureAspect] -> ShowS
$cshowList :: [TextureAspect] -> ShowS
show :: TextureAspect -> String
$cshow :: TextureAspect -> String
showsPrec :: Int -> TextureAspect -> ShowS
$cshowsPrec :: Int -> TextureAspect -> ShowS
Show)

instance ToRaw TextureAspect WGPUTextureAspect where
  raw :: TextureAspect -> ContT r IO WGPUTextureAspect
raw TextureAspect
ta = WGPUTextureAspect -> ContT r IO WGPUTextureAspect
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureAspect -> ContT r IO WGPUTextureAspect)
-> WGPUTextureAspect -> ContT r IO WGPUTextureAspect
forall a b. (a -> b) -> a -> b
$ case TextureAspect
ta of
    TextureAspect
TextureAspectAll -> WGPUTextureAspect
forall a. (Eq a, Num a) => a
WGPUTextureAspect.All
    TextureAspect
TextureAspectStencilOnly -> WGPUTextureAspect
forall a. (Eq a, Num a) => a
WGPUTextureAspect.StencilOnly
    TextureAspect
TextureAspectDepthOnly -> WGPUTextureAspect
forall a. (Eq a, Num a) => a
WGPUTextureAspect.DepthOnly

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

-- | View of a texture which can be used to copy to/from a buffer/texture.
data ImageCopyTexture = ImageCopyTexture
  { ImageCopyTexture -> Texture
texture :: !Texture,
    ImageCopyTexture -> Word32
mipLevel :: !Word32,
    ImageCopyTexture -> Origin3D
origin :: !Origin3D,
    ImageCopyTexture -> TextureAspect
aspect :: !TextureAspect
  }

instance ToRaw ImageCopyTexture WGPUImageCopyTexture where
  raw :: ImageCopyTexture -> ContT r IO WGPUImageCopyTexture
raw ImageCopyTexture {Word32
TextureAspect
Origin3D
Texture
aspect :: TextureAspect
origin :: Origin3D
mipLevel :: Word32
texture :: Texture
aspect :: ImageCopyTexture -> TextureAspect
origin :: ImageCopyTexture -> Origin3D
mipLevel :: ImageCopyTexture -> Word32
texture :: ImageCopyTexture -> Texture
..} = do
    WGPUTexture
n_texture <- Texture -> ContT r IO WGPUTexture
forall a b r. ToRaw a b => a -> ContT r IO b
raw Texture
texture
    WGPUOrigin3D
n_origin <- Origin3D -> ContT r IO WGPUOrigin3D
forall a b r. ToRaw a b => a -> ContT r IO b
raw Origin3D
origin
    WGPUTextureAspect
n_aspect <- TextureAspect -> ContT r IO WGPUTextureAspect
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureAspect
aspect
    WGPUImageCopyTexture -> ContT r IO WGPUImageCopyTexture
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUImageCopyTexture :: Ptr WGPUChainedStruct
-> WGPUTexture
-> Word32
-> WGPUOrigin3D
-> WGPUTextureAspect
-> WGPUImageCopyTexture
WGPUImageCopyTexture.WGPUImageCopyTexture
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          texture :: WGPUTexture
texture = WGPUTexture
n_texture,
          mipLevel :: Word32
mipLevel = Word32
mipLevel,
          origin :: WGPUOrigin3D
origin = WGPUOrigin3D
n_origin,
          aspect :: WGPUTextureAspect
aspect = WGPUTextureAspect
n_aspect
        }

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

-- | Layout of a texture in a buffer's memory.
data TextureDataLayout = TextureDataLayout
  { -- | Offset into the buffer that is the start of the texture. Must be a
    -- multiple of texture block size. For non-compressed textures, this is 1.
    TextureDataLayout -> Word64
textureOffset :: !Word64,
    -- | Bytes per "row" in an image.
    TextureDataLayout -> Word32
bytesPerRow :: !Word32,
    -- | Rows that make up a single image. Used if there are multiple images.
    TextureDataLayout -> Word32
rowsPerImage :: !Word32
  }
  deriving (TextureDataLayout -> TextureDataLayout -> Bool
(TextureDataLayout -> TextureDataLayout -> Bool)
-> (TextureDataLayout -> TextureDataLayout -> Bool)
-> Eq TextureDataLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureDataLayout -> TextureDataLayout -> Bool
$c/= :: TextureDataLayout -> TextureDataLayout -> Bool
== :: TextureDataLayout -> TextureDataLayout -> Bool
$c== :: TextureDataLayout -> TextureDataLayout -> Bool
Eq, Int -> TextureDataLayout -> ShowS
[TextureDataLayout] -> ShowS
TextureDataLayout -> String
(Int -> TextureDataLayout -> ShowS)
-> (TextureDataLayout -> String)
-> ([TextureDataLayout] -> ShowS)
-> Show TextureDataLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureDataLayout] -> ShowS
$cshowList :: [TextureDataLayout] -> ShowS
show :: TextureDataLayout -> String
$cshow :: TextureDataLayout -> String
showsPrec :: Int -> TextureDataLayout -> ShowS
$cshowsPrec :: Int -> TextureDataLayout -> ShowS
Show)

instance ToRaw TextureDataLayout WGPUTextureDataLayout where
  raw :: TextureDataLayout -> ContT r IO WGPUTextureDataLayout
raw TextureDataLayout {Word32
Word64
rowsPerImage :: Word32
bytesPerRow :: Word32
textureOffset :: Word64
rowsPerImage :: TextureDataLayout -> Word32
bytesPerRow :: TextureDataLayout -> Word32
textureOffset :: TextureDataLayout -> Word64
..} =
    WGPUTextureDataLayout -> ContT r IO WGPUTextureDataLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureDataLayout -> ContT r IO WGPUTextureDataLayout)
-> WGPUTextureDataLayout -> ContT r IO WGPUTextureDataLayout
forall a b. (a -> b) -> a -> b
$
      WGPUTextureDataLayout :: Ptr WGPUChainedStruct
-> Word64 -> Word32 -> Word32 -> WGPUTextureDataLayout
WGPUTextureDataLayout.WGPUTextureDataLayout
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          offset :: Word64
offset = Word64
textureOffset,
          bytesPerRow :: Word32
bytesPerRow = Word32
bytesPerRow,
          rowsPerImage :: Word32
rowsPerImage = Word32
rowsPerImage
        }

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

-- | Format of indices used within a pipeline.
data IndexFormat
  = -- | Indices are 16-bit unsigned integers ('Word16')
    IndexFormatUint16
  | -- | Indices are 32-bit unsigned integers ('Word32')
    IndexFormatUint32
  deriving (IndexFormat -> IndexFormat -> Bool
(IndexFormat -> IndexFormat -> Bool)
-> (IndexFormat -> IndexFormat -> Bool) -> Eq IndexFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexFormat -> IndexFormat -> Bool
$c/= :: IndexFormat -> IndexFormat -> Bool
== :: IndexFormat -> IndexFormat -> Bool
$c== :: IndexFormat -> IndexFormat -> Bool
Eq, Int -> IndexFormat -> ShowS
[IndexFormat] -> ShowS
IndexFormat -> String
(Int -> IndexFormat -> ShowS)
-> (IndexFormat -> String)
-> ([IndexFormat] -> ShowS)
-> Show IndexFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexFormat] -> ShowS
$cshowList :: [IndexFormat] -> ShowS
show :: IndexFormat -> String
$cshow :: IndexFormat -> String
showsPrec :: Int -> IndexFormat -> ShowS
$cshowsPrec :: Int -> IndexFormat -> ShowS
Show)

-- | Convert an 'IndexFormat' to its raw value.
instance ToRaw IndexFormat WGPUIndexFormat where
  raw :: IndexFormat -> ContT r IO WGPUIndexFormat
raw IndexFormat
idxFmt =
    WGPUIndexFormat -> ContT r IO WGPUIndexFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUIndexFormat -> ContT r IO WGPUIndexFormat)
-> WGPUIndexFormat -> ContT r IO WGPUIndexFormat
forall a b. (a -> b) -> a -> b
$
      case IndexFormat
idxFmt of
        IndexFormat
IndexFormatUint16 -> WGPUIndexFormat
forall a. (Eq a, Num a) => a
WGPUIndexFormat.Uint16
        IndexFormat
IndexFormatUint32 -> WGPUIndexFormat
forall a. (Eq a, Num a) => a
WGPUIndexFormat.Uint32