{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : WGPU.Internal.Adapter
-- Description : Adapter (physical device).
module WGPU.Internal.Adapter
  ( -- * Types
    Adapter (..),
    AdapterType (..),
    BackendType (..),
    AdapterProperties (..),

    -- * Functions
    requestAdapter,
    getAdapterProperties,
    adapterPropertiesToText,
  )
where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word32)
import Foreign (nullPtr)
import Foreign.Ptr (Ptr)
import Text.Printf (printf)
import WGPU.Internal.ChainedStruct (ChainedStruct (EmptyChain))
import WGPU.Internal.Instance (Instance, wgpuHsInstance)
import WGPU.Internal.Memory
  ( FromRaw,
    ToRaw,
    allocaC,
    evalContT,
    freeHaskellFunPtr,
    fromRaw,
    fromRawPtr,
    newEmptyMVar,
    putMVar,
    raw,
    rawPtr,
    showWithPtr,
    takeMVar,
  )
import WGPU.Internal.Surface (Surface, surfaceInst)
import WGPU.Raw.Generated.Enum.WGPUAdapterType (WGPUAdapterType)
import qualified WGPU.Raw.Generated.Enum.WGPUAdapterType as WGPUAdapterType
import WGPU.Raw.Generated.Enum.WGPUBackendType (WGPUBackendType)
import qualified WGPU.Raw.Generated.Enum.WGPUBackendType as WGPUBackendType
import qualified WGPU.Raw.Generated.Enum.WGPUNativeSType as WGPUSType
import qualified WGPU.Raw.Generated.Fun as RawFun
import WGPU.Raw.Generated.Struct.WGPUAdapterProperties (WGPUAdapterProperties)
import qualified WGPU.Raw.Generated.Struct.WGPUAdapterProperties as WGPUAdapterProperties
import WGPU.Raw.Generated.Struct.WGPURequestAdapterOptions
  ( WGPURequestAdapterOptions,
  )
import qualified WGPU.Raw.Generated.Struct.WGPURequestAdapterOptions as WGPURequestAdapterOptions
import WGPU.Raw.Types
  ( WGPUAdapter (WGPUAdapter),
    WGPUInstance (WGPUInstance),
    WGPURequestAdapterCallback,
  )

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

-- | Handle to a physical graphics and/or compute device.
--
-- Request an 'Adapter' for a 'Surface' using the 'requestAdapter' function.
data Adapter = Adapter
  { Adapter -> Instance
adapterInst :: !Instance,
    Adapter -> WGPUAdapter
wgpuAdapter :: !WGPUAdapter
  }

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

instance Eq Adapter where
  == :: Adapter -> Adapter -> Bool
(==) Adapter
a1 Adapter
a2 =
    let Adapter Instance
_ (WGPUAdapter Ptr ()
a1_ptr) = Adapter
a1
        Adapter Instance
_ (WGPUAdapter Ptr ()
a2_ptr) = Adapter
a2
     in Ptr ()
a1_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
a2_ptr

instance ToRaw Adapter WGPUAdapter where
  raw :: Adapter -> ContT r IO WGPUAdapter
raw = WGPUAdapter -> ContT r IO WGPUAdapter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WGPUAdapter -> ContT r IO WGPUAdapter)
-> (Adapter -> WGPUAdapter) -> Adapter -> ContT r IO WGPUAdapter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Adapter -> WGPUAdapter
wgpuAdapter

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

-- | Physical device type.
data AdapterType
  = AdapterTypeDiscreteGPU
  | AdapterTypeIntegratedGPU
  | AdapterTypeCPU
  | AdapterTypeUnknown
  deriving (AdapterType -> AdapterType -> Bool
(AdapterType -> AdapterType -> Bool)
-> (AdapterType -> AdapterType -> Bool) -> Eq AdapterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdapterType -> AdapterType -> Bool
$c/= :: AdapterType -> AdapterType -> Bool
== :: AdapterType -> AdapterType -> Bool
$c== :: AdapterType -> AdapterType -> Bool
Eq, Int -> AdapterType -> ShowS
[AdapterType] -> ShowS
AdapterType -> String
(Int -> AdapterType -> ShowS)
-> (AdapterType -> String)
-> ([AdapterType] -> ShowS)
-> Show AdapterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdapterType] -> ShowS
$cshowList :: [AdapterType] -> ShowS
show :: AdapterType -> String
$cshow :: AdapterType -> String
showsPrec :: Int -> AdapterType -> ShowS
$cshowsPrec :: Int -> AdapterType -> ShowS
Show)

instance ToRaw AdapterType WGPUAdapterType where
  raw :: AdapterType -> ContT r IO WGPUAdapterType
raw AdapterType
adapterType = case AdapterType
adapterType of
    AdapterType
AdapterTypeDiscreteGPU -> WGPUAdapterType -> ContT r IO WGPUAdapterType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUAdapterType
forall a. (Eq a, Num a) => a
WGPUAdapterType.DiscreteGPU
    AdapterType
AdapterTypeIntegratedGPU -> WGPUAdapterType -> ContT r IO WGPUAdapterType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUAdapterType
forall a. (Eq a, Num a) => a
WGPUAdapterType.IntegratedGPU
    AdapterType
AdapterTypeCPU -> WGPUAdapterType -> ContT r IO WGPUAdapterType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUAdapterType
forall a. (Eq a, Num a) => a
WGPUAdapterType.CPU
    AdapterType
AdapterTypeUnknown -> WGPUAdapterType -> ContT r IO WGPUAdapterType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUAdapterType
forall a. (Eq a, Num a) => a
WGPUAdapterType.Unknown

instance FromRaw WGPUAdapterType AdapterType where
  fromRaw :: WGPUAdapterType -> m AdapterType
fromRaw WGPUAdapterType
wAdapterType = AdapterType -> m AdapterType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AdapterType -> m AdapterType) -> AdapterType -> m AdapterType
forall a b. (a -> b) -> a -> b
$ case WGPUAdapterType
wAdapterType of
    WGPUAdapterType
WGPUAdapterType.DiscreteGPU -> AdapterType
AdapterTypeDiscreteGPU
    WGPUAdapterType
WGPUAdapterType.IntegratedGPU -> AdapterType
AdapterTypeIntegratedGPU
    WGPUAdapterType
WGPUAdapterType.CPU -> AdapterType
AdapterTypeCPU
    WGPUAdapterType
WGPUAdapterType.Unknown -> AdapterType
AdapterTypeUnknown
    WGPUAdapterType
_ -> AdapterType
AdapterTypeUnknown

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

-- | Backends supported by WGPU.
data BackendType
  = BackendTypeNull
  | BackendTypeD3D11
  | BackendTypeD3D12
  | BackendTypeMetal
  | BackendTypeVulkan
  | BackendTypeOpenGL
  | BackendTypeOpenGLES
  deriving (BackendType -> BackendType -> Bool
(BackendType -> BackendType -> Bool)
-> (BackendType -> BackendType -> Bool) -> Eq BackendType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackendType -> BackendType -> Bool
$c/= :: BackendType -> BackendType -> Bool
== :: BackendType -> BackendType -> Bool
$c== :: BackendType -> BackendType -> Bool
Eq, Int -> BackendType -> ShowS
[BackendType] -> ShowS
BackendType -> String
(Int -> BackendType -> ShowS)
-> (BackendType -> String)
-> ([BackendType] -> ShowS)
-> Show BackendType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackendType] -> ShowS
$cshowList :: [BackendType] -> ShowS
show :: BackendType -> String
$cshow :: BackendType -> String
showsPrec :: Int -> BackendType -> ShowS
$cshowsPrec :: Int -> BackendType -> ShowS
Show)

instance ToRaw BackendType WGPUBackendType where
  raw :: BackendType -> ContT r IO WGPUBackendType
raw BackendType
backendType = case BackendType
backendType of
    BackendType
BackendTypeNull -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.Null
    BackendType
BackendTypeD3D11 -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.D3D11
    BackendType
BackendTypeD3D12 -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.D3D12
    BackendType
BackendTypeMetal -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.Metal
    BackendType
BackendTypeVulkan -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.Vulkan
    BackendType
BackendTypeOpenGL -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.OpenGL
    BackendType
BackendTypeOpenGLES -> WGPUBackendType -> ContT r IO WGPUBackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure WGPUBackendType
forall a. (Eq a, Num a) => a
WGPUBackendType.OpenGLES

instance FromRaw WGPUBackendType BackendType where
  fromRaw :: WGPUBackendType -> m BackendType
fromRaw WGPUBackendType
wBackendType = BackendType -> m BackendType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackendType -> m BackendType) -> BackendType -> m BackendType
forall a b. (a -> b) -> a -> b
$ case WGPUBackendType
wBackendType of
    WGPUBackendType
WGPUBackendType.Null -> BackendType
BackendTypeNull
    WGPUBackendType
WGPUBackendType.D3D11 -> BackendType
BackendTypeD3D11
    WGPUBackendType
WGPUBackendType.D3D12 -> BackendType
BackendTypeD3D12
    WGPUBackendType
WGPUBackendType.Metal -> BackendType
BackendTypeMetal
    WGPUBackendType
WGPUBackendType.Vulkan -> BackendType
BackendTypeVulkan
    WGPUBackendType
WGPUBackendType.OpenGL -> BackendType
BackendTypeOpenGL
    WGPUBackendType
WGPUBackendType.OpenGLES -> BackendType
BackendTypeOpenGLES
    WGPUBackendType
_ -> BackendType
BackendTypeNull

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

data AdapterProperties = AdapterProperties
  { AdapterProperties -> Word32
deviceID :: !Word32,
    AdapterProperties -> Word32
vendorID :: !Word32,
    AdapterProperties -> Text
adapterName :: !Text,
    AdapterProperties -> Text
driverDescription :: !Text,
    AdapterProperties -> AdapterType
adapterType :: !AdapterType,
    AdapterProperties -> BackendType
backendType :: !BackendType
  }
  deriving (AdapterProperties -> AdapterProperties -> Bool
(AdapterProperties -> AdapterProperties -> Bool)
-> (AdapterProperties -> AdapterProperties -> Bool)
-> Eq AdapterProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdapterProperties -> AdapterProperties -> Bool
$c/= :: AdapterProperties -> AdapterProperties -> Bool
== :: AdapterProperties -> AdapterProperties -> Bool
$c== :: AdapterProperties -> AdapterProperties -> Bool
Eq, Int -> AdapterProperties -> ShowS
[AdapterProperties] -> ShowS
AdapterProperties -> String
(Int -> AdapterProperties -> ShowS)
-> (AdapterProperties -> String)
-> ([AdapterProperties] -> ShowS)
-> Show AdapterProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdapterProperties] -> ShowS
$cshowList :: [AdapterProperties] -> ShowS
show :: AdapterProperties -> String
$cshow :: AdapterProperties -> String
showsPrec :: Int -> AdapterProperties -> ShowS
$cshowsPrec :: Int -> AdapterProperties -> ShowS
Show)

instance ToRaw AdapterProperties WGPUAdapterProperties where
  raw :: AdapterProperties -> ContT r IO WGPUAdapterProperties
raw AdapterProperties {Word32
Text
BackendType
AdapterType
backendType :: BackendType
adapterType :: AdapterType
driverDescription :: Text
adapterName :: Text
vendorID :: Word32
deviceID :: Word32
backendType :: AdapterProperties -> BackendType
adapterType :: AdapterProperties -> AdapterType
driverDescription :: AdapterProperties -> Text
adapterName :: AdapterProperties -> Text
vendorID :: AdapterProperties -> Word32
deviceID :: AdapterProperties -> Word32
..} = do
    Ptr WGPUChainedStruct
chain_ptr <- ChainedStruct Any -> ContT r IO (Ptr WGPUChainedStruct)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr (WGPUSType -> ChainedStruct Any
forall a. WGPUSType -> ChainedStruct a
EmptyChain WGPUSType
forall a. (Eq a, Num a) => a
WGPUSType.AdapterExtras)
    Ptr CChar
name_ptr <- Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Text
adapterName
    Ptr CChar
driverDescription_ptr <- Text -> ContT r IO (Ptr CChar)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr Text
driverDescription
    WGPUAdapterType
n_adapterType <- AdapterType -> ContT r IO WGPUAdapterType
forall a b r. ToRaw a b => a -> ContT r IO b
raw AdapterType
adapterType
    WGPUBackendType
n_backendType <- BackendType -> ContT r IO WGPUBackendType
forall a b r. ToRaw a b => a -> ContT r IO b
raw BackendType
backendType
    WGPUAdapterProperties -> ContT r IO WGPUAdapterProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPUAdapterProperties :: Ptr WGPUChainedStruct
-> Word32
-> Word32
-> Ptr CChar
-> Ptr CChar
-> WGPUAdapterType
-> WGPUBackendType
-> WGPUAdapterProperties
WGPUAdapterProperties.WGPUAdapterProperties
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
chain_ptr,
          deviceID :: Word32
deviceID = Word32
deviceID,
          vendorID :: Word32
vendorID = Word32
vendorID,
          name :: Ptr CChar
name = Ptr CChar
name_ptr,
          driverDescription :: Ptr CChar
driverDescription = Ptr CChar
driverDescription_ptr,
          adapterType :: WGPUAdapterType
adapterType = WGPUAdapterType
n_adapterType,
          backendType :: WGPUBackendType
backendType = WGPUBackendType
n_backendType
        }

instance FromRaw WGPUAdapterProperties AdapterProperties where
  fromRaw :: WGPUAdapterProperties -> m AdapterProperties
fromRaw WGPUAdapterProperties.WGPUAdapterProperties {Word32
Ptr CChar
Ptr WGPUChainedStruct
WGPUBackendType
WGPUAdapterType
backendType :: WGPUBackendType
adapterType :: WGPUAdapterType
driverDescription :: Ptr CChar
name :: Ptr CChar
vendorID :: Word32
deviceID :: Word32
nextInChain :: Ptr WGPUChainedStruct
backendType :: WGPUAdapterProperties -> WGPUBackendType
adapterType :: WGPUAdapterProperties -> WGPUAdapterType
driverDescription :: WGPUAdapterProperties -> Ptr CChar
name :: WGPUAdapterProperties -> Ptr CChar
vendorID :: WGPUAdapterProperties -> Word32
deviceID :: WGPUAdapterProperties -> Word32
nextInChain :: WGPUAdapterProperties -> Ptr WGPUChainedStruct
..} = do
    Text
n_adapterName <- Ptr CChar -> m Text
forall b a (m :: * -> *). (FromRaw b a, MonadIO m) => b -> m a
fromRaw Ptr CChar
name
    Text
n_driverDescription <- Ptr CChar -> m Text
forall b a (m :: * -> *). (FromRaw b a, MonadIO m) => b -> m a
fromRaw Ptr CChar
driverDescription
    AdapterType
n_adapterType <- WGPUAdapterType -> m AdapterType
forall b a (m :: * -> *). (FromRaw b a, MonadIO m) => b -> m a
fromRaw WGPUAdapterType
adapterType
    BackendType
n_backendType <- WGPUBackendType -> m BackendType
forall b a (m :: * -> *). (FromRaw b a, MonadIO m) => b -> m a
fromRaw WGPUBackendType
backendType
    AdapterProperties -> m AdapterProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      AdapterProperties :: Word32
-> Word32
-> Text
-> Text
-> AdapterType
-> BackendType
-> AdapterProperties
AdapterProperties
        { deviceID :: Word32
deviceID = Word32
deviceID,
          vendorID :: Word32
vendorID = Word32
vendorID,
          adapterName :: Text
adapterName = Text
n_adapterName,
          driverDescription :: Text
driverDescription = Text
n_driverDescription,
          adapterType :: AdapterType
adapterType = AdapterType
n_adapterType,
          backendType :: BackendType
backendType = BackendType
n_backendType
        }

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

-- | Request an 'Adapter' that is compatible with a given 'Surface'.
--
-- This action blocks until an available adapter is returned.
requestAdapter ::
  (MonadIO m) =>
  -- | Existing surface for which to request an @Adapter@.
  Surface ->
  -- | The returned @Adapter@, if it could be retrieved.
  m (Maybe Adapter)
requestAdapter :: Surface -> m (Maybe Adapter)
requestAdapter Surface
surface = IO (Maybe Adapter) -> m (Maybe Adapter)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Adapter) -> m (Maybe Adapter))
-> (ContT (Maybe Adapter) IO (Maybe Adapter) -> IO (Maybe Adapter))
-> ContT (Maybe Adapter) IO (Maybe Adapter)
-> m (Maybe Adapter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Maybe Adapter) IO (Maybe Adapter) -> IO (Maybe Adapter)
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT (Maybe Adapter) IO (Maybe Adapter) -> m (Maybe Adapter))
-> ContT (Maybe Adapter) IO (Maybe Adapter) -> m (Maybe Adapter)
forall a b. (a -> b) -> a -> b
$ do
  let inst :: Instance
inst = Surface -> Instance
surfaceInst Surface
surface

  MVar WGPUAdapter
adaptmv <- ContT (Maybe Adapter) IO (MVar WGPUAdapter)
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  WGPURequestAdapterCallback
callback <- (WGPUAdapter -> Ptr () -> IO ())
-> ContT (Maybe Adapter) IO WGPURequestAdapterCallback
forall (m :: * -> *).
MonadIO m =>
(WGPUAdapter -> Ptr () -> IO ()) -> m WGPURequestAdapterCallback
mkAdapterCallback (\WGPUAdapter
a Ptr ()
_ -> MVar WGPUAdapter -> WGPUAdapter -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar WGPUAdapter
adaptmv WGPUAdapter
a)

  Ptr WGPURequestAdapterOptions
requestAdapterOptions_ptr <- RequestAdapterOptions
-> ContT (Maybe Adapter) IO (Ptr WGPURequestAdapterOptions)
forall a b r. ToRawPtr a b => a -> ContT r IO (Ptr b)
rawPtr (Surface -> RequestAdapterOptions
RequestAdapterOptions Surface
surface)
  WGPUHsInstance
-> WGPUInstance
-> Ptr WGPURequestAdapterOptions
-> WGPURequestAdapterCallback
-> Ptr ()
-> ContT (Maybe Adapter) IO ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance
-> WGPUInstance
-> Ptr WGPURequestAdapterOptions
-> WGPURequestAdapterCallback
-> Ptr ()
-> m ()
RawFun.wgpuInstanceRequestAdapter
    (Instance -> WGPUHsInstance
wgpuHsInstance Instance
inst)
    (Ptr () -> WGPUInstance
WGPUInstance Ptr ()
forall a. Ptr a
nullPtr)
    Ptr WGPURequestAdapterOptions
requestAdapterOptions_ptr
    WGPURequestAdapterCallback
callback
    Ptr ()
forall a. Ptr a
nullPtr

  WGPUAdapter
adapter <- MVar WGPUAdapter -> ContT (Maybe Adapter) IO WGPUAdapter
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar WGPUAdapter
adaptmv
  WGPURequestAdapterCallback -> ContT (Maybe Adapter) IO ()
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m ()
freeHaskellFunPtr WGPURequestAdapterCallback
callback

  Maybe Adapter -> ContT (Maybe Adapter) IO (Maybe Adapter)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Adapter -> ContT (Maybe Adapter) IO (Maybe Adapter))
-> Maybe Adapter -> ContT (Maybe Adapter) IO (Maybe Adapter)
forall a b. (a -> b) -> a -> b
$ case WGPUAdapter
adapter of
    WGPUAdapter Ptr ()
ptr | Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr -> Maybe Adapter
forall a. Maybe a
Nothing
    WGPUAdapter Ptr ()
_ -> Adapter -> Maybe Adapter
forall a. a -> Maybe a
Just (Instance -> WGPUAdapter -> Adapter
Adapter Instance
inst WGPUAdapter
adapter)

mkAdapterCallback ::
  MonadIO m =>
  (WGPUAdapter -> Ptr () -> IO ()) ->
  m WGPURequestAdapterCallback
mkAdapterCallback :: (WGPUAdapter -> Ptr () -> IO ()) -> m WGPURequestAdapterCallback
mkAdapterCallback = IO WGPURequestAdapterCallback -> m WGPURequestAdapterCallback
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WGPURequestAdapterCallback -> m WGPURequestAdapterCallback)
-> ((WGPUAdapter -> Ptr () -> IO ())
    -> IO WGPURequestAdapterCallback)
-> (WGPUAdapter -> Ptr () -> IO ())
-> m WGPURequestAdapterCallback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WGPUAdapter -> Ptr () -> IO ()) -> IO WGPURequestAdapterCallback
mkAdapterCallbackIO

foreign import ccall "wrapper"
  mkAdapterCallbackIO ::
    (WGPUAdapter -> Ptr () -> IO ()) -> IO WGPURequestAdapterCallback

newtype RequestAdapterOptions = RequestAdapterOptions {RequestAdapterOptions -> Surface
compatibleSurface :: Surface}

instance ToRaw RequestAdapterOptions WGPURequestAdapterOptions where
  raw :: RequestAdapterOptions -> ContT r IO WGPURequestAdapterOptions
raw RequestAdapterOptions {Surface
compatibleSurface :: Surface
compatibleSurface :: RequestAdapterOptions -> Surface
..} = do
    WGPUSurface
n_surface <- Surface -> ContT r IO WGPUSurface
forall a b r. ToRaw a b => a -> ContT r IO b
raw Surface
compatibleSurface
    WGPURequestAdapterOptions -> ContT r IO WGPURequestAdapterOptions
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      WGPURequestAdapterOptions :: Ptr WGPUChainedStruct -> WGPUSurface -> WGPURequestAdapterOptions
WGPURequestAdapterOptions.WGPURequestAdapterOptions
        { nextInChain :: Ptr WGPUChainedStruct
nextInChain = Ptr WGPUChainedStruct
forall a. Ptr a
nullPtr,
          compatibleSurface :: WGPUSurface
compatibleSurface = WGPUSurface
n_surface
        }

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

-- | Get information about an adapter.
getAdapterProperties :: MonadIO m => Adapter -> m AdapterProperties
getAdapterProperties :: Adapter -> m AdapterProperties
getAdapterProperties Adapter
adapter = IO AdapterProperties -> m AdapterProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AdapterProperties -> m AdapterProperties)
-> IO AdapterProperties -> m AdapterProperties
forall a b. (a -> b) -> a -> b
$
  ContT AdapterProperties IO AdapterProperties
-> IO AdapterProperties
forall (m :: * -> *) a. Monad m => ContT a m a -> m a
evalContT (ContT AdapterProperties IO AdapterProperties
 -> IO AdapterProperties)
-> ContT AdapterProperties IO AdapterProperties
-> IO AdapterProperties
forall a b. (a -> b) -> a -> b
$ do
    Ptr WGPUAdapterProperties
wgpuAdapterProperties_ptr <- ContT AdapterProperties IO (Ptr WGPUAdapterProperties)
forall a r. Storable a => ContT r IO (Ptr a)
allocaC
    WGPUHsInstance
-> WGPUAdapter
-> Ptr WGPUAdapterProperties
-> ContT AdapterProperties IO ()
forall (m :: * -> *).
MonadIO m =>
WGPUHsInstance -> WGPUAdapter -> Ptr WGPUAdapterProperties -> m ()
RawFun.wgpuAdapterGetProperties
      (Instance -> WGPUHsInstance
wgpuHsInstance (Instance -> WGPUHsInstance)
-> (Adapter -> Instance) -> Adapter -> WGPUHsInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Adapter -> Instance
adapterInst (Adapter -> WGPUHsInstance) -> Adapter -> WGPUHsInstance
forall a b. (a -> b) -> a -> b
$ Adapter
adapter)
      (Adapter -> WGPUAdapter
wgpuAdapter Adapter
adapter)
      Ptr WGPUAdapterProperties
wgpuAdapterProperties_ptr
    Ptr WGPUAdapterProperties
-> ContT AdapterProperties IO AdapterProperties
forall b a (m :: * -> *).
(FromRawPtr b a, MonadIO m) =>
Ptr b -> m a
fromRawPtr Ptr WGPUAdapterProperties
wgpuAdapterProperties_ptr

-- | Format adapter properties into a multi-line block of text.
--
-- This can be useful for debugging purposes.
adapterPropertiesToText :: AdapterProperties -> Text
adapterPropertiesToText :: AdapterProperties -> Text
adapterPropertiesToText AdapterProperties {Word32
Text
BackendType
AdapterType
backendType :: BackendType
adapterType :: AdapterType
driverDescription :: Text
adapterName :: Text
vendorID :: Word32
deviceID :: Word32
backendType :: AdapterProperties -> BackendType
adapterType :: AdapterProperties -> AdapterType
driverDescription :: AdapterProperties -> Text
adapterName :: AdapterProperties -> Text
vendorID :: AdapterProperties -> Word32
deviceID :: AdapterProperties -> Word32
..} =
  [Text] -> Text
Text.unlines
    [ Text
"Adapter Properties:",
      Text
"  device ID   : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"0x%08x" Word32
deviceID),
      Text
"  vendor ID   : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"0x%08x" Word32
vendorID),
      Text
"  name        : "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
adapterName
          then Text
"(unknown)"
          else Text
adapterName,
      Text
"  description : "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
driverDescription
          then Text
"(unknown)"
          else Text
driverDescription,
      Text
"  type        : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
adapterTypeTxt,
      Text
"  backend     : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
backendTypeTxt
    ]
  where
    adapterTypeTxt :: Text
    adapterTypeTxt :: Text
adapterTypeTxt = case AdapterType
adapterType of
      AdapterType
AdapterTypeDiscreteGPU -> Text
"Discrete GPU"
      AdapterType
AdapterTypeIntegratedGPU -> Text
"Integrated GPU"
      AdapterType
AdapterTypeCPU -> Text
"CPU"
      AdapterType
AdapterTypeUnknown -> Text
"(unknown)"

    backendTypeTxt :: Text
    backendTypeTxt :: Text
backendTypeTxt = case BackendType
backendType of
      BackendType
BackendTypeNull -> Text
"(unknown)"
      BackendType
BackendTypeD3D11 -> Text
"D3D 11"
      BackendType
BackendTypeD3D12 -> Text
"D3D 12"
      BackendType
BackendTypeMetal -> Text
"Metal"
      BackendType
BackendTypeVulkan -> Text
"Vulkan"
      BackendType
BackendTypeOpenGL -> Text
"OpenGL"
      BackendType
BackendTypeOpenGLES -> Text
"OpenGL ES"