{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-deferred-type-errors #-}

-- |
-- Module      : WGPU.Internal.Sampler
-- Description : Texture sampling.
module WGPU.Internal.Sampler
  ( -- * Types
    Sampler (..),
    AddressMode (..),
    FilterMode (..),
    SamplerDescriptor (..),

    -- * Functions
    createSampler,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import Data.Word (Word16)
import Foreign (nullPtr)
import Foreign.C (CFloat (CFloat))
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 (CompareFunction)
import WGPU.Raw.Generated.Enum.WGPUAddressMode (WGPUAddressMode)
import qualified WGPU.Raw.Generated.Enum.WGPUAddressMode as WGPUAddressMode
import qualified WGPU.Raw.Generated.Enum.WGPUAddressMode as WPUAddressMode
import WGPU.Raw.Generated.Enum.WGPUFilterMode (WGPUFilterMode)
import qualified WGPU.Raw.Generated.Enum.WGPUFilterMode as WGPUFilterMode
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPUSamplerDescriptor (WGPUSamplerDescriptor)
import qualified WGPU.Raw.Generated.Struct.WGPUSamplerDescriptor as WGPUSamplerDescriptor
import WGPU.Raw.Types (WGPUSampler (WGPUSampler))

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

-- | Handle to a 'Sampler'.
--
-- A 'Sampler' defines how a pipeline will sample from a 'TextureView'.
-- Samplers define image filters (include anisotropy) and address (wrapping)
-- modes, among other things.
newtype Sampler = Sampler {Sampler -> WGPUSampler
wgpuSampler :: WGPUSampler}

instance Show Sampler where
  show :: Sampler -> String
show Sampler
s =
    let Sampler (WGPUSampler Ptr ()
ptr) = Sampler
s
     in String -> Ptr () -> String
forall a. String -> Ptr a -> String
showWithPtr String
"Sampler" Ptr ()
ptr

instance Eq Sampler where
  == :: Sampler -> Sampler -> Bool
(==) Sampler
s1 Sampler
s2 =
    let Sampler (WGPUSampler Ptr ()
s1_ptr) = Sampler
s1
        Sampler (WGPUSampler Ptr ()
s2_ptr) = Sampler
s2
     in Ptr ()
s1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
s2_ptr

instance ToRaw Sampler WGPUSampler where
  raw :: Sampler -> ContT r IO WGPUSampler
raw = WGPUSampler -> ContT r IO WGPUSampler
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUSampler -> ContT r IO WGPUSampler)
-> (Sampler -> WGPUSampler) -> Sampler -> ContT r IO WGPUSampler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sampler -> WGPUSampler
wgpuSampler

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

-- | How edges should be handled in texture addressing.
data AddressMode
  = AddressModeClampToEdge
  | AddressModeRepeat
  | AddressModeMirrorRepeat
  deriving (AddressMode -> AddressMode -> Bool
(AddressMode -> AddressMode -> Bool)
-> (AddressMode -> AddressMode -> Bool) -> Eq AddressMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressMode -> AddressMode -> Bool
$c/= :: AddressMode -> AddressMode -> Bool
== :: AddressMode -> AddressMode -> Bool
$c== :: AddressMode -> AddressMode -> Bool
Eq, Int -> AddressMode -> ShowS
[AddressMode] -> ShowS
AddressMode -> String
(Int -> AddressMode -> ShowS)
-> (AddressMode -> String)
-> ([AddressMode] -> ShowS)
-> Show AddressMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressMode] -> ShowS
$cshowList :: [AddressMode] -> ShowS
show :: AddressMode -> String
$cshow :: AddressMode -> String
showsPrec :: Int -> AddressMode -> ShowS
$cshowsPrec :: Int -> AddressMode -> ShowS
Show)

instance ToRaw AddressMode WGPUAddressMode where
  raw :: AddressMode -> ContT r IO WGPUAddressMode
raw AddressMode
am =
    WGPUAddressMode -> ContT r IO WGPUAddressMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUAddressMode -> ContT r IO WGPUAddressMode)
-> WGPUAddressMode -> ContT r IO WGPUAddressMode
forall a b. (a -> b) -> a -> b
$ case AddressMode
am of
      AddressMode
AddressModeClampToEdge -> WGPUAddressMode
forall a. (Eq a, Num a) => a
WPUAddressMode.ClampToEdge
      AddressMode
AddressModeRepeat -> WGPUAddressMode
forall a. (Eq a, Num a) => a
WGPUAddressMode.Repeat
      AddressMode
AddressModeMirrorRepeat -> WGPUAddressMode
forall a. (Eq a, Num a) => a
WGPUAddressMode.MirrorRepeat

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

-- | Texel mixing mode when sampling between texels.
data FilterMode
  = FilterModeNearest
  | FilterModeLinear
  deriving (FilterMode -> FilterMode -> Bool
(FilterMode -> FilterMode -> Bool)
-> (FilterMode -> FilterMode -> Bool) -> Eq FilterMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterMode -> FilterMode -> Bool
$c/= :: FilterMode -> FilterMode -> Bool
== :: FilterMode -> FilterMode -> Bool
$c== :: FilterMode -> FilterMode -> Bool
Eq, Int -> FilterMode -> ShowS
[FilterMode] -> ShowS
FilterMode -> String
(Int -> FilterMode -> ShowS)
-> (FilterMode -> String)
-> ([FilterMode] -> ShowS)
-> Show FilterMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterMode] -> ShowS
$cshowList :: [FilterMode] -> ShowS
show :: FilterMode -> String
$cshow :: FilterMode -> String
showsPrec :: Int -> FilterMode -> ShowS
$cshowsPrec :: Int -> FilterMode -> ShowS
Show)

instance ToRaw FilterMode WGPUFilterMode where
  raw :: FilterMode -> ContT r IO WGPUFilterMode
raw FilterMode
fm =
    WGPUFilterMode -> ContT r IO WGPUFilterMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUFilterMode -> ContT r IO WGPUFilterMode)
-> WGPUFilterMode -> ContT r IO WGPUFilterMode
forall a b. (a -> b) -> a -> b
$ case FilterMode
fm of
      FilterMode
FilterModeNearest -> WGPUFilterMode
forall a. (Eq a, Num a) => a
WGPUFilterMode.Nearest
      FilterMode
FilterModeLinear -> WGPUFilterMode
forall a. (Eq a, Num a) => a
WGPUFilterMode.Linear

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

-- | Describes a 'Sampler'.
data SamplerDescriptor = SamplerDescriptor
  { SamplerDescriptor -> Text
samplerLabel :: !Text,
    SamplerDescriptor -> AddressMode
addressModeU :: !AddressMode,
    SamplerDescriptor -> AddressMode
addressModeV :: !AddressMode,
    SamplerDescriptor -> AddressMode
addressModeW :: !AddressMode,
    SamplerDescriptor -> FilterMode
magFilter :: !FilterMode,
    SamplerDescriptor -> FilterMode
minFilter :: !FilterMode,
    SamplerDescriptor -> FilterMode
mipmapFilter :: !FilterMode,
    SamplerDescriptor -> Float
lodMinClamp :: !Float,
    SamplerDescriptor -> Float
lodMaxClamp :: !Float,
    SamplerDescriptor -> CompareFunction
samplerCompare :: !CompareFunction,
    SamplerDescriptor -> Word16
maxAnisotropy :: !Word16
  }
  deriving (SamplerDescriptor -> SamplerDescriptor -> Bool
(SamplerDescriptor -> SamplerDescriptor -> Bool)
-> (SamplerDescriptor -> SamplerDescriptor -> Bool)
-> Eq SamplerDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerDescriptor -> SamplerDescriptor -> Bool
$c/= :: SamplerDescriptor -> SamplerDescriptor -> Bool
== :: SamplerDescriptor -> SamplerDescriptor -> Bool
$c== :: SamplerDescriptor -> SamplerDescriptor -> Bool
Eq, Int -> SamplerDescriptor -> ShowS
[SamplerDescriptor] -> ShowS
SamplerDescriptor -> String
(Int -> SamplerDescriptor -> ShowS)
-> (SamplerDescriptor -> String)
-> ([SamplerDescriptor] -> ShowS)
-> Show SamplerDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerDescriptor] -> ShowS
$cshowList :: [SamplerDescriptor] -> ShowS
show :: SamplerDescriptor -> String
$cshow :: SamplerDescriptor -> String
showsPrec :: Int -> SamplerDescriptor -> ShowS
$cshowsPrec :: Int -> SamplerDescriptor -> ShowS
Show)

instance ToRaw SamplerDescriptor WGPUSamplerDescriptor where
  raw :: SamplerDescriptor -> ContT r IO WGPUSamplerDescriptor
raw SamplerDescriptor {Float
Word16
Text
CompareFunction
FilterMode
AddressMode
maxAnisotropy :: Word16
samplerCompare :: CompareFunction
lodMaxClamp :: Float
lodMinClamp :: Float
mipmapFilter :: FilterMode
minFilter :: FilterMode
magFilter :: FilterMode
addressModeW :: AddressMode
addressModeV :: AddressMode
addressModeU :: AddressMode
samplerLabel :: Text
maxAnisotropy :: SamplerDescriptor -> Word16
samplerCompare :: SamplerDescriptor -> CompareFunction
lodMaxClamp :: SamplerDescriptor -> Float
lodMinClamp :: SamplerDescriptor -> Float
mipmapFilter :: SamplerDescriptor -> FilterMode
minFilter :: SamplerDescriptor -> FilterMode
magFilter :: SamplerDescriptor -> FilterMode
addressModeW :: SamplerDescriptor -> AddressMode
addressModeV :: SamplerDescriptor -> AddressMode
addressModeU :: SamplerDescriptor -> AddressMode
samplerLabel :: SamplerDescriptor -> 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
samplerLabel
    WGPUAddressMode
n_addressModeU <- AddressMode -> ContT r IO WGPUAddressMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw AddressMode
addressModeU
    WGPUAddressMode
n_addressModeV <- AddressMode -> ContT r IO WGPUAddressMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw AddressMode
addressModeV
    WGPUAddressMode
n_addressModeW <- AddressMode -> ContT r IO WGPUAddressMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw AddressMode
addressModeW
    WGPUFilterMode
n_magFilter <- FilterMode -> ContT r IO WGPUFilterMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw FilterMode
magFilter
    WGPUFilterMode
n_minFilter <- FilterMode -> ContT r IO WGPUFilterMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw FilterMode
minFilter
    WGPUFilterMode
n_mipmapFilter <- FilterMode -> ContT r IO WGPUFilterMode
forall a b r. ToRaw a b => a -> ContT r IO b
raw FilterMode
mipmapFilter
    WGPUCompareFunction
n_compare <- CompareFunction -> ContT r IO WGPUCompareFunction
forall a b r. ToRaw a b => a -> ContT r IO b
raw CompareFunction
samplerCompare
    WGPUSamplerDescriptor -> ContT r IO WGPUSamplerDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUSamplerDescriptor -> ContT r IO WGPUSamplerDescriptor)
-> WGPUSamplerDescriptor -> ContT r IO WGPUSamplerDescriptor
forall a b. (a -> b) -> a -> b
$
      WGPUSamplerDescriptor :: Ptr WGPUChainedStruct
-> Ptr CChar
-> WGPUAddressMode
-> WGPUAddressMode
-> WGPUAddressMode
-> WGPUFilterMode
-> WGPUFilterMode
-> WGPUFilterMode
-> CFloat
-> CFloat
-> WGPUCompareFunction
-> Word16
-> WGPUSamplerDescriptor
WGPUSamplerDescriptor.WGPUSamplerDescriptor
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          label :: Ptr CChar
label = Ptr CChar
label_ptr,
          addressModeU :: WGPUAddressMode
addressModeU = WGPUAddressMode
n_addressModeU,
          addressModeV :: WGPUAddressMode
addressModeV = WGPUAddressMode
n_addressModeV,
          addressModeW :: WGPUAddressMode
addressModeW = WGPUAddressMode
n_addressModeW,
          magFilter :: WGPUFilterMode
magFilter = WGPUFilterMode
n_magFilter,
          minFilter :: WGPUFilterMode
minFilter = WGPUFilterMode
n_minFilter,
          mipmapFilter :: WGPUFilterMode
mipmapFilter = WGPUFilterMode
n_mipmapFilter,
          lodMinClamp :: CFloat
lodMinClamp = Float -> CFloat
CFloat Float
lodMinClamp,
          lodMaxClamp :: CFloat
lodMaxClamp = Float -> CFloat
CFloat Float
lodMaxClamp,
          compare :: WGPUCompareFunction
compare = WGPUCompareFunction
n_compare,
          maxAnisotropy :: Word16
maxAnisotropy = Word16
maxAnisotropy
        }

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

-- | Create a 'Sampler'.
createSampler ::
  MonadIO m =>
  -- | Device for which to create the sampler.
  Device ->
  -- | Description of the sampler to create.
  SamplerDescriptor ->
  -- | Action to create the sampler.
  m Sampler
createSampler :: Device -> SamplerDescriptor -> m Sampler
createSampler Device
device SamplerDescriptor
samplerDescriptor = IO Sampler -> m Sampler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sampler -> m Sampler)
-> (ContT Sampler IO Sampler -> IO Sampler)
-> ContT Sampler IO Sampler
-> m Sampler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Sampler IO Sampler -> IO Sampler
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT Sampler IO Sampler -> m Sampler)
-> ContT Sampler IO Sampler -> m Sampler
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Device -> Instance
deviceInst Device
device
  Ptr WGPUSamplerDescriptor
samplerDescriptor_ptr <- SamplerDescriptor -> ContT Sampler IO (Ptr WGPUSamplerDescriptor)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr SamplerDescriptor
samplerDescriptor
  WGPUSampler -> Sampler
Sampler
    (WGPUSampler -> Sampler)
-> ContT Sampler IO WGPUSampler -> ContT Sampler IO Sampler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WGPUHsInstance
-> WGPUDevice
-> Ptr WGPUSamplerDescriptor
-> ContT Sampler IO WGPUSampler
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUDevice -> Ptr WGPUSamplerDescriptor -> m WGPUSampler
RawFun.wgpuDeviceCreateSampler
      (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
      (Device -> WGPUDevice
wgpuDevice Device
device)
      Ptr WGPUSamplerDescriptor
samplerDescriptor_ptr