{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : WGPU.Internal.Texture
-- Description : Textures and texture views.
module WGPU.Internal.Texture
  ( -- * Types
    TextureView (..),
    TextureFormat (..),
    TextureUsage (..),
    TextureViewDimension (..),

    -- * Functions
    textureFormatFromRaw,
  )
where

import WGPU.Internal.Memory (ToRaw, raw, showWithPtr)
import WGPU.Raw.Generated.Enum.WGPUTextureFormat (WGPUTextureFormat)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureFormat as WGPUTextureFormat
import WGPU.Raw.Generated.Enum.WGPUTextureUsage (WGPUTextureUsage)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureUsage as WGPUTextureUsage
import WGPU.Raw.Generated.Enum.WGPUTextureViewDimension (WGPUTextureViewDimension)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureViewDimension as WGPUTextureViewDimension
import WGPU.Raw.Types (WGPUTextureView (WGPUTextureView))

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

-- | Handle to a texture view.
--
-- A 'TextureView' describes a texture and associated metadata needed by a
-- rendering pipeline or bind group.
newtype TextureView = TextureView {TextureView -> WGPUTextureView
wgpuTextureView :: WGPUTextureView}

instance Show TextureView where
  show :: TextureView -> String
show TextureView
v =
    let TextureView (WGPUTextureView Ptr ()
ptr) = TextureView
v
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"TextureView" Ptr ()
ptr

instance Eq TextureView where
  == :: TextureView -> TextureView -> Bool
(==) TextureView
v1 TextureView
v2 =
    let TextureView (WGPUTextureView Ptr ()
v1_ptr) = TextureView
v1
        TextureView (WGPUTextureView Ptr ()
v2_ptr) = TextureView
v2
     in Ptr ()
v1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
v2_ptr

instance ToRaw TextureView WGPUTextureView where
  raw :: TextureView -> ContT c IO WGPUTextureView
raw = WGPUTextureView -> ContT c IO WGPUTextureView
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureView -> ContT c IO WGPUTextureView)
-> (TextureView -> WGPUTextureView)
-> TextureView
-> ContT c IO WGPUTextureView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureView -> WGPUTextureView
wgpuTextureView

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

-- | Dimensions of a particular texture view.
data TextureViewDimension
  = TextureViewDimension1D
  | TextureViewDimension2D
  | TextureViewDimension2DArray
  | TextureViewDimensionCube
  | TextureViewDimensionCubeArray
  | TextureViewDimension3D
  deriving (TextureViewDimension -> TextureViewDimension -> Bool
(TextureViewDimension -> TextureViewDimension -> Bool)
-> (TextureViewDimension -> TextureViewDimension -> Bool)
-> Eq TextureViewDimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureViewDimension -> TextureViewDimension -> Bool
$c/= :: TextureViewDimension -> TextureViewDimension -> Bool
== :: TextureViewDimension -> TextureViewDimension -> Bool
$c== :: TextureViewDimension -> TextureViewDimension -> Bool
Eq, Int -> TextureViewDimension -> ShowS
[TextureViewDimension] -> ShowS
TextureViewDimension -> String
(Int -> TextureViewDimension -> ShowS)
-> (TextureViewDimension -> String)
-> ([TextureViewDimension] -> ShowS)
-> Show TextureViewDimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureViewDimension] -> ShowS
$cshowList :: [TextureViewDimension] -> ShowS
show :: TextureViewDimension -> String
$cshow :: TextureViewDimension -> String
showsPrec :: Int -> TextureViewDimension -> ShowS
$cshowsPrec :: Int -> TextureViewDimension -> ShowS
Show)

instance ToRaw TextureViewDimension WGPUTextureViewDimension where
  raw :: TextureViewDimension -> ContT c IO WGPUTextureViewDimension
raw TextureViewDimension
tvd =
    WGPUTextureViewDimension -> ContT c IO WGPUTextureViewDimension
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureViewDimension -> ContT c IO WGPUTextureViewDimension)
-> WGPUTextureViewDimension -> ContT c IO WGPUTextureViewDimension
forall a b. (a -> b) -> a -> b
$
      case TextureViewDimension
tvd of
        TextureViewDimension
TextureViewDimension1D -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.D1D
        TextureViewDimension
TextureViewDimension2D -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.D2D
        TextureViewDimension
TextureViewDimension2DArray -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.D2DArray
        TextureViewDimension
TextureViewDimensionCube -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.Cube
        TextureViewDimension
TextureViewDimensionCubeArray -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.CubeArray
        TextureViewDimension
TextureViewDimension3D -> WGPUTextureViewDimension
forall a. (Eq a, Num a) => a
WGPUTextureViewDimension.D3D

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

-- | Different ways you can use a texture.
--
-- The usages determine from what kind of memory the texture is allocated, and
-- in what actions the texture can partake.
data TextureUsage
  = TextureUsageCopySrc
  | TextureUsageCopyDst
  | TextureUsageSampled
  | TextureUsageStorage
  | TextureUsageRenderAttachment
  deriving (TextureUsage -> TextureUsage -> Bool
(TextureUsage -> TextureUsage -> Bool)
-> (TextureUsage -> TextureUsage -> Bool) -> Eq TextureUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureUsage -> TextureUsage -> Bool
$c/= :: TextureUsage -> TextureUsage -> Bool
== :: TextureUsage -> TextureUsage -> Bool
$c== :: TextureUsage -> TextureUsage -> Bool
Eq, Int -> TextureUsage -> ShowS
[TextureUsage] -> ShowS
TextureUsage -> String
(Int -> TextureUsage -> ShowS)
-> (TextureUsage -> String)
-> ([TextureUsage] -> ShowS)
-> Show TextureUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureUsage] -> ShowS
$cshowList :: [TextureUsage] -> ShowS
show :: TextureUsage -> String
$cshow :: TextureUsage -> String
showsPrec :: Int -> TextureUsage -> ShowS
$cshowsPrec :: Int -> TextureUsage -> ShowS
Show)

instance ToRaw TextureUsage WGPUTextureUsage where
  raw :: TextureUsage -> ContT c IO WGPUTextureUsage
raw TextureUsage
tu =
    WGPUTextureUsage -> ContT c IO WGPUTextureUsage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureUsage -> ContT c IO WGPUTextureUsage)
-> WGPUTextureUsage -> ContT c IO WGPUTextureUsage
forall a b. (a -> b) -> a -> b
$
      case TextureUsage
tu of
        TextureUsage
TextureUsageCopySrc -> WGPUTextureUsage
forall a. (Eq a, Num a) => a
WGPUTextureUsage.CopySrc
        TextureUsage
TextureUsageCopyDst -> WGPUTextureUsage
forall a. (Eq a, Num a) => a
WGPUTextureUsage.CopyDst
        TextureUsage
TextureUsageSampled -> WGPUTextureUsage
forall a. (Eq a, Num a) => a
WGPUTextureUsage.Sampled
        TextureUsage
TextureUsageStorage -> WGPUTextureUsage
forall a. (Eq a, Num a) => a
WGPUTextureUsage.Storage
        TextureUsage
TextureUsageRenderAttachment -> WGPUTextureUsage
forall a. (Eq a, Num a) => a
WGPUTextureUsage.RenderAttachment

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

-- | Texture data format.
data TextureFormat
  = TextureFormatR8Unorm
  | TextureFormatR8Snorm
  | TextureFormatR8Uint
  | TextureFormatR8Sint
  | TextureFormatR16Uint
  | TextureFormatR16Sint
  | TextureFormatR16Float
  | TextureFormatRG8Unorm
  | TextureFormatRG8Snorm
  | TextureFormatRG8Uint
  | TextureFormatRG8Sint
  | TextureFormatR32Float
  | TextureFormatR32Uint
  | TextureFormatR32Sint
  | TextureFormatRG16Uint
  | TextureFormatRG16Sint
  | TextureFormatRG16Float
  | TextureFormatRGBA8Unorm
  | TextureFormatRGBA8UnormSrgb
  | TextureFormatRGBA8Snorm
  | TextureFormatRGBA8Uint
  | TextureFormatRGBA8Sint
  | TextureFormatBGRA8Unorm
  | TextureFormatBGRA8UnormSrgb
  | TextureFormatRGB10A2Unorm
  | TextureFormatRG11B10Ufloat
  | TextureFormatRGB9E5Ufloat
  | TextureFormatRG32Float
  | TextureFormatRG32Uint
  | TextureFormatRG32Sint
  | TextureFormatRGBA16Uint
  | TextureFormatRGBA16Sint
  | TextureFormatRGBA16Float
  | TextureFormatRGBA32Float
  | TextureFormatRGBA32Uint
  | TextureFormatRGBA32Sint
  | TextureFormatDepth32Float
  | TextureFormatDepth24Plus
  | TextureFormatDepth24PlusStencil8
  | TextureFormatStencil8
  | TextureFormatBC1RGBAUnorm
  | TextureFormatBC1RGBAUnormSrgb
  | TextureFormatBC2RGBAUnorm
  | TextureFormatBC2RGBAUnormSrgb
  | TextureFormatBC3RGBAUnorm
  | TextureFormatBC3RGBAUnormSrgb
  | TextureFormatBC4RUnorm
  | TextureFormatBC4RSnorm
  | TextureFormatBC5RGUnorm
  | TextureFormatBC5RGSnorm
  | TextureFormatBC6HRGBUfloat
  | TextureFormatBC6HRGBFloat
  | TextureFormatBC7RGBAUnorm
  | TextureFormatBC7RGBAUnormSrgb
  deriving (TextureFormat -> TextureFormat -> Bool
(TextureFormat -> TextureFormat -> Bool)
-> (TextureFormat -> TextureFormat -> Bool) -> Eq TextureFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureFormat -> TextureFormat -> Bool
$c/= :: TextureFormat -> TextureFormat -> Bool
== :: TextureFormat -> TextureFormat -> Bool
$c== :: TextureFormat -> TextureFormat -> Bool
Eq, Int -> TextureFormat -> ShowS
[TextureFormat] -> ShowS
TextureFormat -> String
(Int -> TextureFormat -> ShowS)
-> (TextureFormat -> String)
-> ([TextureFormat] -> ShowS)
-> Show TextureFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureFormat] -> ShowS
$cshowList :: [TextureFormat] -> ShowS
show :: TextureFormat -> String
$cshow :: TextureFormat -> String
showsPrec :: Int -> TextureFormat -> ShowS
$cshowsPrec :: Int -> TextureFormat -> ShowS
Show)

instance ToRaw TextureFormat WGPUTextureFormat where
  raw :: TextureFormat -> ContT c IO WGPUTextureFormat
raw TextureFormat
tf =
    WGPUTextureFormat -> ContT c IO WGPUTextureFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureFormat -> ContT c IO WGPUTextureFormat)
-> WGPUTextureFormat -> ContT c IO WGPUTextureFormat
forall a b. (a -> b) -> a -> b
$
      case TextureFormat
tf of
        TextureFormat
TextureFormatR8Unorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R8Unorm
        TextureFormat
TextureFormatR8Snorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R8Snorm
        TextureFormat
TextureFormatR8Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R8Uint
        TextureFormat
TextureFormatR8Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R8Sint
        TextureFormat
TextureFormatR16Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R16Uint
        TextureFormat
TextureFormatR16Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R16Sint
        TextureFormat
TextureFormatR16Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R16Float
        TextureFormat
TextureFormatRG8Unorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG8Unorm
        TextureFormat
TextureFormatRG8Snorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG8Snorm
        TextureFormat
TextureFormatRG8Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG8Uint
        TextureFormat
TextureFormatRG8Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG8Sint
        TextureFormat
TextureFormatR32Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R32Float
        TextureFormat
TextureFormatR32Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R32Uint
        TextureFormat
TextureFormatR32Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.R32Sint
        TextureFormat
TextureFormatRG16Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG16Uint
        TextureFormat
TextureFormatRG16Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG16Sint
        TextureFormat
TextureFormatRG16Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG16Float
        TextureFormat
TextureFormatRGBA8Unorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA8Unorm
        TextureFormat
TextureFormatRGBA8UnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA8UnormSrgb
        TextureFormat
TextureFormatRGBA8Snorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA8Snorm
        TextureFormat
TextureFormatRGBA8Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA8Uint
        TextureFormat
TextureFormatRGBA8Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA8Sint
        TextureFormat
TextureFormatBGRA8Unorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BGRA8Unorm
        TextureFormat
TextureFormatBGRA8UnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BGRA8UnormSrgb
        TextureFormat
TextureFormatRGB10A2Unorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGB10A2Unorm
        TextureFormat
TextureFormatRG11B10Ufloat -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG11B10Ufloat
        TextureFormat
TextureFormatRGB9E5Ufloat -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGB9E5Ufloat
        TextureFormat
TextureFormatRG32Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG32Float
        TextureFormat
TextureFormatRG32Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG32Uint
        TextureFormat
TextureFormatRG32Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RG32Sint
        TextureFormat
TextureFormatRGBA16Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA16Uint
        TextureFormat
TextureFormatRGBA16Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA16Sint
        TextureFormat
TextureFormatRGBA16Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA16Float
        TextureFormat
TextureFormatRGBA32Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA32Float
        TextureFormat
TextureFormatRGBA32Uint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA32Uint
        TextureFormat
TextureFormatRGBA32Sint -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.RGBA32Sint
        TextureFormat
TextureFormatDepth32Float -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.Depth32Float
        TextureFormat
TextureFormatDepth24Plus -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.Depth24Plus
        TextureFormat
TextureFormatDepth24PlusStencil8 ->
          WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.Depth24PlusStencil8
        TextureFormat
TextureFormatStencil8 -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.Stencil8
        TextureFormat
TextureFormatBC1RGBAUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC1RGBAUnorm
        TextureFormat
TextureFormatBC1RGBAUnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC1RGBAUnormSrgb
        TextureFormat
TextureFormatBC2RGBAUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC2RGBAUnorm
        TextureFormat
TextureFormatBC2RGBAUnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC2RGBAUnormSrgb
        TextureFormat
TextureFormatBC3RGBAUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC3RGBAUnorm
        TextureFormat
TextureFormatBC3RGBAUnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC3RGBAUnormSrgb
        TextureFormat
TextureFormatBC4RUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC4RUnorm
        TextureFormat
TextureFormatBC4RSnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC4RSnorm
        TextureFormat
TextureFormatBC5RGUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC5RGUnorm
        TextureFormat
TextureFormatBC5RGSnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC5RGSnorm
        TextureFormat
TextureFormatBC6HRGBUfloat -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC6HRGBUfloat
        TextureFormat
TextureFormatBC6HRGBFloat -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC6HRGBFloat
        TextureFormat
TextureFormatBC7RGBAUnorm -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC7RGBAUnorm
        TextureFormat
TextureFormatBC7RGBAUnormSrgb -> WGPUTextureFormat
forall a. (Eq a, Num a) => a
WGPUTextureFormat.BC7RGBAUnormSrgb

textureFormatFromRaw :: WGPUTextureFormat -> TextureFormat
textureFormatFromRaw :: WGPUTextureFormat -> TextureFormat
textureFormatFromRaw WGPUTextureFormat
rt =
  case WGPUTextureFormat
rt of
    WGPUTextureFormat
WGPUTextureFormat.R8Unorm -> TextureFormat
TextureFormatR8Unorm
    WGPUTextureFormat
WGPUTextureFormat.R8Snorm -> TextureFormat
TextureFormatR8Snorm
    WGPUTextureFormat
WGPUTextureFormat.R8Uint -> TextureFormat
TextureFormatR8Uint
    WGPUTextureFormat
WGPUTextureFormat.R8Sint -> TextureFormat
TextureFormatR8Sint
    WGPUTextureFormat
WGPUTextureFormat.R16Uint -> TextureFormat
TextureFormatR16Uint
    WGPUTextureFormat
WGPUTextureFormat.R16Sint -> TextureFormat
TextureFormatR16Sint
    WGPUTextureFormat
WGPUTextureFormat.R16Float -> TextureFormat
TextureFormatR16Float
    WGPUTextureFormat
WGPUTextureFormat.RG8Unorm -> TextureFormat
TextureFormatRG8Unorm
    WGPUTextureFormat
WGPUTextureFormat.RG8Snorm -> TextureFormat
TextureFormatRG8Snorm
    WGPUTextureFormat
WGPUTextureFormat.RG8Uint -> TextureFormat
TextureFormatRG8Uint
    WGPUTextureFormat
WGPUTextureFormat.RG8Sint -> TextureFormat
TextureFormatRG8Sint
    WGPUTextureFormat
WGPUTextureFormat.R32Float -> TextureFormat
TextureFormatR32Float
    WGPUTextureFormat
WGPUTextureFormat.R32Uint -> TextureFormat
TextureFormatR32Uint
    WGPUTextureFormat
WGPUTextureFormat.R32Sint -> TextureFormat
TextureFormatR32Sint
    WGPUTextureFormat
WGPUTextureFormat.RG16Uint -> TextureFormat
TextureFormatRG16Uint
    WGPUTextureFormat
WGPUTextureFormat.RG16Sint -> TextureFormat
TextureFormatRG16Sint
    WGPUTextureFormat
WGPUTextureFormat.RG16Float -> TextureFormat
TextureFormatRG16Float
    WGPUTextureFormat
WGPUTextureFormat.RGBA8Unorm -> TextureFormat
TextureFormatRGBA8Unorm
    WGPUTextureFormat
WGPUTextureFormat.RGBA8UnormSrgb -> TextureFormat
TextureFormatRGBA8UnormSrgb
    WGPUTextureFormat
WGPUTextureFormat.RGBA8Snorm -> TextureFormat
TextureFormatRGBA8Snorm
    WGPUTextureFormat
WGPUTextureFormat.RGBA8Uint -> TextureFormat
TextureFormatRGBA8Uint
    WGPUTextureFormat
WGPUTextureFormat.RGBA8Sint -> TextureFormat
TextureFormatRGBA8Sint
    WGPUTextureFormat
WGPUTextureFormat.BGRA8Unorm -> TextureFormat
TextureFormatBGRA8Unorm
    WGPUTextureFormat
WGPUTextureFormat.BGRA8UnormSrgb -> TextureFormat
TextureFormatBGRA8UnormSrgb
    WGPUTextureFormat
WGPUTextureFormat.RGB10A2Unorm -> TextureFormat
TextureFormatRGB10A2Unorm
    WGPUTextureFormat
WGPUTextureFormat.RG11B10Ufloat -> TextureFormat
TextureFormatRG11B10Ufloat
    WGPUTextureFormat
WGPUTextureFormat.RGB9E5Ufloat -> TextureFormat
TextureFormatRGB9E5Ufloat
    WGPUTextureFormat
WGPUTextureFormat.RG32Float -> TextureFormat
TextureFormatRG32Float
    WGPUTextureFormat
WGPUTextureFormat.RG32Uint -> TextureFormat
TextureFormatRG32Uint
    WGPUTextureFormat
WGPUTextureFormat.RG32Sint -> TextureFormat
TextureFormatRG32Sint
    WGPUTextureFormat
WGPUTextureFormat.RGBA16Uint -> TextureFormat
TextureFormatRGBA16Uint
    WGPUTextureFormat
WGPUTextureFormat.RGBA16Sint -> TextureFormat
TextureFormatRGBA16Sint
    WGPUTextureFormat
WGPUTextureFormat.RGBA16Float -> TextureFormat
TextureFormatRGBA16Float
    WGPUTextureFormat
WGPUTextureFormat.RGBA32Float -> TextureFormat
TextureFormatRGBA32Float
    WGPUTextureFormat
WGPUTextureFormat.RGBA32Uint -> TextureFormat
TextureFormatRGBA32Uint
    WGPUTextureFormat
WGPUTextureFormat.RGBA32Sint -> TextureFormat
TextureFormatRGBA32Sint
    WGPUTextureFormat
WGPUTextureFormat.Depth32Float -> TextureFormat
TextureFormatDepth32Float
    WGPUTextureFormat
WGPUTextureFormat.Depth24Plus -> TextureFormat
TextureFormatDepth24Plus
    WGPUTextureFormat
WGPUTextureFormat.Depth24PlusStencil8 -> TextureFormat
TextureFormatDepth24PlusStencil8
    WGPUTextureFormat
WGPUTextureFormat.Stencil8 -> TextureFormat
TextureFormatStencil8
    WGPUTextureFormat
WGPUTextureFormat.BC1RGBAUnorm -> TextureFormat
TextureFormatBC1RGBAUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC1RGBAUnormSrgb -> TextureFormat
TextureFormatBC1RGBAUnormSrgb
    WGPUTextureFormat
WGPUTextureFormat.BC2RGBAUnorm -> TextureFormat
TextureFormatBC2RGBAUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC2RGBAUnormSrgb -> TextureFormat
TextureFormatBC2RGBAUnormSrgb
    WGPUTextureFormat
WGPUTextureFormat.BC3RGBAUnorm -> TextureFormat
TextureFormatBC3RGBAUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC3RGBAUnormSrgb -> TextureFormat
TextureFormatBC3RGBAUnormSrgb
    WGPUTextureFormat
WGPUTextureFormat.BC4RUnorm -> TextureFormat
TextureFormatBC4RUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC4RSnorm -> TextureFormat
TextureFormatBC4RSnorm
    WGPUTextureFormat
WGPUTextureFormat.BC5RGUnorm -> TextureFormat
TextureFormatBC5RGUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC5RGSnorm -> TextureFormat
TextureFormatBC5RGSnorm
    WGPUTextureFormat
WGPUTextureFormat.BC6HRGBUfloat -> TextureFormat
TextureFormatBC6HRGBUfloat
    WGPUTextureFormat
WGPUTextureFormat.BC6HRGBFloat -> TextureFormat
TextureFormatBC6HRGBFloat
    WGPUTextureFormat
WGPUTextureFormat.BC7RGBAUnorm -> TextureFormat
TextureFormatBC7RGBAUnorm
    WGPUTextureFormat
WGPUTextureFormat.BC7RGBAUnormSrgb -> TextureFormat
TextureFormatBC7RGBAUnormSrgb
    WGPUTextureFormat
_ -> String -> TextureFormat
forall a. HasCallStack => String -> a
error (String -> TextureFormat) -> String -> TextureFormat
forall a b. (a -> b) -> a -> b
$ String
"Unexpected WGPUTextureFormat" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WGPUTextureFormat -> String
forall a. Show a => a -> String
show WGPUTextureFormat
rt