{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module WGPU.Internal.Adapter
(
Adapter (..),
AdapterType (..),
BackendType (..),
AdapterProperties (..),
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,
)
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
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
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
}
requestAdapter ::
(MonadIO m) =>
Surface ->
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
}
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
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"