{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wno-missing-fields #-}

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

    -- * Functions
    createTexture,
    createView,
    textureFormatFromRaw,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.))
import Data.Default (Default, def)
import Data.Text (Text)
import Data.Word (Word32)
import Foreign (nullPtr)
import WGPU.Internal.Device (Device, deviceInst, wgpuDevice)
import WGPU.Internal.Instance (wgpuHsInstance)
import WGPU.Internal.Memory (ToRaw, evalContT, raw, rawPtr, showWithPtr)
import WGPU.Internal.Multipurpose
  ( Extent3D,
    Texture (Texture),
    TextureAspect,
    textureInst,
    wgpuTexture,
  )
import WGPU.Raw.Generated.Enum.WGPUTextureDimension (WGPUTextureDimension)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureDimension as WGPUTextureDimension
import WGPU.Raw.Generated.Enum.WGPUTextureFormat (WGPUTextureFormat)
import qualified WGPU.Raw.Generated.Enum.WGPUTextureFormat as WGPUTextureFormat
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 qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPUTextureDescriptor (WGPUTextureDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUTextureDescriptor as WGPUTextureDescriptor
import WGPU.Raw.Generated.Struct.WGPUTextureViewDescriptor (WGPUTextureViewDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUTextureViewDescriptor as WGPUTextureViewDescriptor
import WGPU.Raw.Types
  ( WGPUTextureUsageFlags,
    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 r IO WGPUTextureView
raw = WGPUTextureView -> ContT r IO WGPUTextureView
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureView -> ContT r IO WGPUTextureView)
-> (TextureView -> WGPUTextureView)
-> TextureView
-> ContT r 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 r IO WGPUTextureViewDimension
raw TextureViewDimension
tvd =
    WGPUTextureViewDimension -> ContT r IO WGPUTextureViewDimension
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureViewDimension -> ContT r IO WGPUTextureViewDimension)
-> WGPUTextureViewDimension -> ContT r 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 = TextureUsage
  { TextureUsage -> Bool
texCopySrc :: !Bool,
    TextureUsage -> Bool
texCopyDst :: !Bool,
    TextureUsage -> Bool
texSampled :: !Bool,
    TextureUsage -> Bool
texStorage :: !Bool,
    TextureUsage -> Bool
texRenderAttachment :: !Bool
  }
  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 WGPUTextureUsageFlags where
  raw :: TextureUsage -> ContT r IO WGPUTextureUsageFlags
raw TextureUsage {Bool
texRenderAttachment :: Bool
texStorage :: Bool
texSampled :: Bool
texCopyDst :: Bool
texCopySrc :: Bool
texRenderAttachment :: TextureUsage -> Bool
texStorage :: TextureUsage -> Bool
texSampled :: TextureUsage -> Bool
texCopyDst :: TextureUsage -> Bool
texCopySrc :: TextureUsage -> Bool
..} =
    WGPUTextureUsageFlags -> ContT r IO WGPUTextureUsageFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureUsageFlags -> ContT r IO WGPUTextureUsageFlags)
-> WGPUTextureUsageFlags -> ContT r IO WGPUTextureUsageFlags
forall a b. (a -> b) -> a -> b
$
      (if Bool
texCopySrc then WGPUTextureUsageFlags
forall a. (Eq a, Num a) => a
WGPUTextureUsage.CopySrc else WGPUTextureUsageFlags
0)
        WGPUTextureUsageFlags
-> WGPUTextureUsageFlags -> WGPUTextureUsageFlags
forall a. Bits a => a -> a -> a
.|. (if Bool
texCopyDst then WGPUTextureUsageFlags
forall a. (Eq a, Num a) => a
WGPUTextureUsage.CopyDst else WGPUTextureUsageFlags
0)
        WGPUTextureUsageFlags
-> WGPUTextureUsageFlags -> WGPUTextureUsageFlags
forall a. Bits a => a -> a -> a
.|. (if Bool
texSampled then WGPUTextureUsageFlags
forall a. (Eq a, Num a) => a
WGPUTextureUsage.Sampled else WGPUTextureUsageFlags
0)
        WGPUTextureUsageFlags
-> WGPUTextureUsageFlags -> WGPUTextureUsageFlags
forall a. Bits a => a -> a -> a
.|. (if Bool
texStorage then WGPUTextureUsageFlags
forall a. (Eq a, Num a) => a
WGPUTextureUsage.Storage else WGPUTextureUsageFlags
0)
        WGPUTextureUsageFlags
-> WGPUTextureUsageFlags -> WGPUTextureUsageFlags
forall a. Bits a => a -> a -> a
.|. (if Bool
texRenderAttachment then WGPUTextureUsageFlags
forall a. (Eq a, Num a) => a
WGPUTextureUsage.RenderAttachment else WGPUTextureUsageFlags
0)

instance Default TextureUsage where
  def :: TextureUsage
def =
    TextureUsage :: Bool -> Bool -> Bool -> Bool -> Bool -> TextureUsage
TextureUsage
      { texCopySrc :: Bool
texCopySrc = Bool
False,
        texCopyDst :: Bool
texCopyDst = Bool
False,
        texSampled :: Bool
texSampled = Bool
False,
        texStorage :: Bool
texStorage = Bool
False,
        texRenderAttachment :: Bool
texRenderAttachment = Bool
False
      }

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

-- | 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 r IO WGPUTextureFormat
raw TextureFormat
tf =
    WGPUTextureFormat -> ContT r IO WGPUTextureFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureFormat -> ContT r IO WGPUTextureFormat)
-> WGPUTextureFormat -> ContT r 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

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

-- | Dimensionality of a texture.
data TextureDimension
  = TextureDimension1D
  | TextureDimension2D
  | TextureDimension3D
  deriving (TextureDimension -> TextureDimension -> Bool
(TextureDimension -> TextureDimension -> Bool)
-> (TextureDimension -> TextureDimension -> Bool)
-> Eq TextureDimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureDimension -> TextureDimension -> Bool
$c/= :: TextureDimension -> TextureDimension -> Bool
== :: TextureDimension -> TextureDimension -> Bool
$c== :: TextureDimension -> TextureDimension -> Bool
Eq, Int -> TextureDimension -> ShowS
[TextureDimension] -> ShowS
TextureDimension -> String
(Int -> TextureDimension -> ShowS)
-> (TextureDimension -> String)
-> ([TextureDimension] -> ShowS)
-> Show TextureDimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureDimension] -> ShowS
$cshowList :: [TextureDimension] -> ShowS
show :: TextureDimension -> String
$cshow :: TextureDimension -> String
showsPrec :: Int -> TextureDimension -> ShowS
$cshowsPrec :: Int -> TextureDimension -> ShowS
Show)

instance ToRaw TextureDimension WGPUTextureDimension where
  raw :: TextureDimension -> ContT r IO WGPUTextureDimension
raw TextureDimension
td = WGPUTextureDimension -> ContT r IO WGPUTextureDimension
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureDimension -> ContT r IO WGPUTextureDimension)
-> WGPUTextureDimension -> ContT r IO WGPUTextureDimension
forall a b. (a -> b) -> a -> b
$
    case TextureDimension
td of
      TextureDimension
TextureDimension1D -> WGPUTextureDimension
forall a. (Eq a, Num a) => a
WGPUTextureDimension.D1D
      TextureDimension
TextureDimension2D -> WGPUTextureDimension
forall a. (Eq a, Num a) => a
WGPUTextureDimension.D2D
      TextureDimension
TextureDimension3D -> WGPUTextureDimension
forall a. (Eq a, Num a) => a
WGPUTextureDimension.D3D

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

-- | Describes a 'Texture'.
data TextureDescriptor = TextureDescriptor
  { TextureDescriptor -> Text
textureLabel :: !Text,
    TextureDescriptor -> Extent3D
textureSize :: !Extent3D,
    TextureDescriptor -> WGPUTextureUsageFlags
mipLevelCount :: !Word32,
    TextureDescriptor -> WGPUTextureUsageFlags
sampleCount :: !Word32,
    TextureDescriptor -> TextureDimension
dimension :: !TextureDimension,
    TextureDescriptor -> TextureFormat
format :: !TextureFormat,
    TextureDescriptor -> TextureUsage
textureUsage :: !TextureUsage
  }
  deriving (TextureDescriptor -> TextureDescriptor -> Bool
(TextureDescriptor -> TextureDescriptor -> Bool)
-> (TextureDescriptor -> TextureDescriptor -> Bool)
-> Eq TextureDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureDescriptor -> TextureDescriptor -> Bool
$c/= :: TextureDescriptor -> TextureDescriptor -> Bool
== :: TextureDescriptor -> TextureDescriptor -> Bool
$c== :: TextureDescriptor -> TextureDescriptor -> Bool
Eq, Int -> TextureDescriptor -> ShowS
[TextureDescriptor] -> ShowS
TextureDescriptor -> String
(Int -> TextureDescriptor -> ShowS)
-> (TextureDescriptor -> String)
-> ([TextureDescriptor] -> ShowS)
-> Show TextureDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureDescriptor] -> ShowS
$cshowList :: [TextureDescriptor] -> ShowS
show :: TextureDescriptor -> String
$cshow :: TextureDescriptor -> String
showsPrec :: Int -> TextureDescriptor -> ShowS
$cshowsPrec :: Int -> TextureDescriptor -> ShowS
Show)

instance ToRaw TextureDescriptor WGPUTextureDescriptor where
  raw :: TextureDescriptor -> ContT r IO WGPUTextureDescriptor
raw TextureDescriptor {WGPUTextureUsageFlags
Text
Extent3D
TextureDimension
TextureFormat
TextureUsage
textureUsage :: TextureUsage
format :: TextureFormat
dimension :: TextureDimension
sampleCount :: WGPUTextureUsageFlags
mipLevelCount :: WGPUTextureUsageFlags
textureSize :: Extent3D
textureLabel :: Text
textureUsage :: TextureDescriptor -> TextureUsage
format :: TextureDescriptor -> TextureFormat
dimension :: TextureDescriptor -> TextureDimension
sampleCount :: TextureDescriptor -> WGPUTextureUsageFlags
mipLevelCount :: TextureDescriptor -> WGPUTextureUsageFlags
textureSize :: TextureDescriptor -> Extent3D
textureLabel :: TextureDescriptor -> 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
textureLabel
    WGPUTextureUsageFlags
n_usage <- TextureUsage -> ContT r IO WGPUTextureUsageFlags
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureUsage
textureUsage
    WGPUTextureDimension
n_dimension <- TextureDimension -> ContT r IO WGPUTextureDimension
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureDimension
dimension
    WGPUExtent3D
n_size <- Extent3D -> ContT r IO WGPUExtent3D
forall a b r. ToRaw a b => a -> ContT r IO b
raw Extent3D
textureSize
    WGPUTextureFormat
n_format <- TextureFormat -> ContT r IO WGPUTextureFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureFormat
format
    WGPUTextureDescriptor -> ContT r IO WGPUTextureDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureDescriptor -> ContT r IO WGPUTextureDescriptor)
-> WGPUTextureDescriptor -> ContT r IO WGPUTextureDescriptor
forall a b. (a -> b) -> a -> b
$
      WGPUTextureDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> WGPUTextureUsageFlags
-> WGPUTextureDimension
-> WGPUExtent3D
-> WGPUTextureFormat
-> WGPUTextureUsageFlags
-> WGPUTextureUsageFlags
-> WGPUTextureDescriptor
WGPUTextureDescriptor.WGPUTextureDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          usage :: WGPUTextureUsageFlags
usage = WGPUTextureUsageFlags
n_usage,
          dimension :: WGPUTextureDimension
dimension = WGPUTextureDimension
n_dimension,
          size :: WGPUExtent3D
size = WGPUExtent3D
n_size,
          format :: WGPUTextureFormat
format = WGPUTextureFormat
n_format,
          mipLevelCount :: WGPUTextureUsageFlags
mipLevelCount = WGPUTextureUsageFlags
mipLevelCount,
          sampleCount :: WGPUTextureUsageFlags
sampleCount = WGPUTextureUsageFlags
sampleCount
        }

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

-- | Describes a 'TextureView'.
data TextureViewDescriptor = TextureViewDescriptor
  { TextureViewDescriptor -> Text
textureViewLabel :: !Text,
    TextureViewDescriptor -> TextureFormat
textureViewFormat :: !TextureFormat,
    TextureViewDescriptor -> TextureViewDimension
textureViewDimension :: !TextureViewDimension,
    TextureViewDescriptor -> WGPUTextureUsageFlags
textureViewBaseMipLevel :: !Word32,
    TextureViewDescriptor -> WGPUTextureUsageFlags
textureViewMipLevelCount :: !Word32,
    TextureViewDescriptor -> WGPUTextureUsageFlags
baseArrayLayer :: !Word32,
    TextureViewDescriptor -> WGPUTextureUsageFlags
arrayLayerCount :: !Word32,
    TextureViewDescriptor -> TextureAspect
textureViewAspect :: !TextureAspect
  }
  deriving (TextureViewDescriptor -> TextureViewDescriptor -> Bool
(TextureViewDescriptor -> TextureViewDescriptor -> Bool)
-> (TextureViewDescriptor -> TextureViewDescriptor -> Bool)
-> Eq TextureViewDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureViewDescriptor -> TextureViewDescriptor -> Bool
$c/= :: TextureViewDescriptor -> TextureViewDescriptor -> Bool
== :: TextureViewDescriptor -> TextureViewDescriptor -> Bool
$c== :: TextureViewDescriptor -> TextureViewDescriptor -> Bool
Eq, Int -> TextureViewDescriptor -> ShowS
[TextureViewDescriptor] -> ShowS
TextureViewDescriptor -> String
(Int -> TextureViewDescriptor -> ShowS)
-> (TextureViewDescriptor -> String)
-> ([TextureViewDescriptor] -> ShowS)
-> Show TextureViewDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureViewDescriptor] -> ShowS
$cshowList :: [TextureViewDescriptor] -> ShowS
show :: TextureViewDescriptor -> String
$cshow :: TextureViewDescriptor -> String
showsPrec :: Int -> TextureViewDescriptor -> ShowS
$cshowsPrec :: Int -> TextureViewDescriptor -> ShowS
Show)

instance ToRaw TextureViewDescriptor WGPUTextureViewDescriptor where
  raw :: TextureViewDescriptor -> ContT r IO WGPUTextureViewDescriptor
raw TextureViewDescriptor {WGPUTextureUsageFlags
Text
TextureAspect
TextureFormat
TextureViewDimension
textureViewAspect :: TextureAspect
arrayLayerCount :: WGPUTextureUsageFlags
baseArrayLayer :: WGPUTextureUsageFlags
textureViewMipLevelCount :: WGPUTextureUsageFlags
textureViewBaseMipLevel :: WGPUTextureUsageFlags
textureViewDimension :: TextureViewDimension
textureViewFormat :: TextureFormat
textureViewLabel :: Text
textureViewAspect :: TextureViewDescriptor -> TextureAspect
arrayLayerCount :: TextureViewDescriptor -> WGPUTextureUsageFlags
baseArrayLayer :: TextureViewDescriptor -> WGPUTextureUsageFlags
textureViewMipLevelCount :: TextureViewDescriptor -> WGPUTextureUsageFlags
textureViewBaseMipLevel :: TextureViewDescriptor -> WGPUTextureUsageFlags
textureViewDimension :: TextureViewDescriptor -> TextureViewDimension
textureViewFormat :: TextureViewDescriptor -> TextureFormat
textureViewLabel :: TextureViewDescriptor -> 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
textureViewLabel
    WGPUTextureFormat
n_format <- TextureFormat -> ContT r IO WGPUTextureFormat
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureFormat
textureViewFormat
    WGPUTextureViewDimension
n_dimension <- TextureViewDimension -> ContT r IO WGPUTextureViewDimension
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureViewDimension
textureViewDimension
    WGPUTextureAspect
n_aspect <- TextureAspect -> ContT r IO WGPUTextureAspect
forall a b r. ToRaw a b => a -> ContT r IO b
raw TextureAspect
textureViewAspect
    WGPUTextureViewDescriptor -> ContT r IO WGPUTextureViewDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUTextureViewDescriptor -> ContT r IO WGPUTextureViewDescriptor)
-> WGPUTextureViewDescriptor
-> ContT r IO WGPUTextureViewDescriptor
forall a b. (a -> b) -> a -> b
$
      WGPUTextureViewDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> WGPUTextureFormat
-> WGPUTextureViewDimension
-> WGPUTextureUsageFlags
-> WGPUTextureUsageFlags
-> WGPUTextureUsageFlags
-> WGPUTextureUsageFlags
-> WGPUTextureAspect
-> WGPUTextureViewDescriptor
WGPUTextureViewDescriptor.WGPUTextureViewDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          format :: WGPUTextureFormat
format = WGPUTextureFormat
n_format,
          dimension :: WGPUTextureViewDimension
dimension = WGPUTextureViewDimension
n_dimension,
          baseMipLevel :: WGPUTextureUsageFlags
baseMipLevel = WGPUTextureUsageFlags
textureViewBaseMipLevel,
          mipLevelCount :: WGPUTextureUsageFlags
mipLevelCount = WGPUTextureUsageFlags
textureViewMipLevelCount,
          baseArrayLayer :: WGPUTextureUsageFlags
baseArrayLayer = WGPUTextureUsageFlags
baseArrayLayer,
          arrayLayerCount :: WGPUTextureUsageFlags
arrayLayerCount = WGPUTextureUsageFlags
arrayLayerCount,
          aspect :: WGPUTextureAspect
aspect = WGPUTextureAspect
n_aspect
        }

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

-- | Create a texture.
createTexture ::
  MonadIO m =>
  -- | Device for which to create the texture.
  Device ->
  -- | Description of the texture to create.
  TextureDescriptor ->
  -- | Action to create the texture.
  m Texture
createTexture :: Device -> TextureDescriptor -> m Texture
createTexture Device
device TextureDescriptor
textureDescriptor = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture)
-> (ContT Texture IO Texture -> IO Texture)
-> ContT Texture IO Texture
-> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Texture IO Texture -> IO Texture
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT Texture IO Texture -> m Texture)
-> ContT Texture IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Device -> Instance
deviceInst Device
device
  Ptr WGPUTextureDescriptor
textureDescriptor_ptr <- TextureDescriptor -> ContT Texture IO (Ptr WGPUTextureDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr TextureDescriptor
textureDescriptor
  Instance -> WGPUTexture -> Texture
Texture Instance
inst
    (WGPUTexture -> Texture)
-> ContT Texture IO WGPUTexture -> ContT Texture IO Texture
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUTextureDescriptor
-> ContT Texture IO WGPUTexture
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUDevice -> Ptr WGPUTextureDescriptor -> m WGPUTexture
RawFun.wgpuDeviceCreateTexture
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Device -> WGPUDevice
wgpuDevice Device
device)
      Ptr WGPUTextureDescriptor
textureDescriptor_ptr

-- | Create a view of a texture.
createView ::
  MonadIO m =>
  -- | Texture for which the view should be created.
  Texture ->
  -- | Description of the texture view.
  TextureViewDescriptor ->
  -- | Created texture view.
  m TextureView
createView :: Texture -> TextureViewDescriptor -> m TextureView
createView Texture
texture TextureViewDescriptor
textureViewDescriptor = IO TextureView -> m TextureView
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextureView -> m TextureView)
-> (ContT TextureView IO TextureView -> IO TextureView)
-> ContT TextureView IO TextureView
-> m TextureView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT TextureView IO TextureView -> IO TextureView
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT TextureView IO TextureView -> m TextureView)
-> ContT TextureView IO TextureView -> m TextureView
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Texture -> Instance
textureInst Texture
texture
  Ptr WGPUTextureViewDescriptor
textureViewDescriptor_ptr <- TextureViewDescriptor
-> ContT TextureView IO (Ptr WGPUTextureViewDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr TextureViewDescriptor
textureViewDescriptor
  WGPUTextureView -> TextureView
TextureView
    (WGPUTextureView -> TextureView)
-> ContT TextureView IO WGPUTextureView
-> ContT TextureView IO TextureView
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance
-> WGPUTexture
-> Ptr WGPUTextureViewDescriptor
-> ContT TextureView IO WGPUTextureView
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUTexture
-> Ptr WGPUTextureViewDescriptor
-> m WGPUTextureView
RawFun.wgpuTextureCreateView
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Texture -> WGPUTexture
wgpuTexture Texture
texture)
      Ptr WGPUTextureViewDescriptor
textureViewDescriptor_ptr