module Engine.Sound.Device
( ALC.Device
, allocate
, create
, destroy
) where
import RIO
import Foreign (nullPtr)
import Sound.OpenAL.FFI.ALC qualified as ALC
import UnliftIO.Resource qualified as Resource
allocate
:: ( Resource.MonadResource m
, MonadUnliftIO m
, MonadReader env m
, HasLogFunc env
)
=> m (Resource.ReleaseKey, ALC.Device)
allocate :: m (ReleaseKey, Device)
allocate = do
Device
soundDevice <- m Device
forall env (m :: * -> *).
(MonadReader env m, HasLogFunc env, MonadUnliftIO m) =>
m Device
create
IO ()
soundDeviceDestroy <- m () -> m (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (m () -> m (IO ())) -> m () -> m (IO ())
forall a b. (a -> b) -> a -> b
$ Device -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env) =>
Device -> m ()
destroy Device
soundDevice
ReleaseKey
soundDeviceKey <- IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
Resource.register IO ()
soundDeviceDestroy
pure (ReleaseKey
soundDeviceKey, Device
soundDevice)
create
:: ( MonadReader env m
, HasLogFunc env
, MonadUnliftIO m
)
=> m ALC.Device
create :: m Device
create = do
Device
device <- IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ CString -> IO Device
ALC.alcOpenDevice CString
forall a. Ptr a
nullPtr
Context
context <- IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ Device -> Ptr CInt -> IO Context
ALC.alcCreateContext Device
device Ptr CInt
forall a. Ptr a
nullPtr
CChar
ok <- IO CChar -> m CChar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CChar -> m CChar) -> IO CChar -> m CChar
forall a b. (a -> b) -> a -> b
$ Context -> IO CChar
ALC.alcMakeContextCurrent Context
context
if CChar
ok CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
== CChar
1 then
Device -> m Device
forall (f :: * -> *) a. Applicative f => a -> f a
pure Device
device
else do
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"OpenAL: alcMakeContextCurrent failed"
m Device
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
destroy
:: (MonadIO m, MonadReader env m, HasLogFunc env)
=> ALC.Device
-> m ()
destroy :: Device -> m ()
destroy Device
device = do
CChar
ok <- IO CChar -> m CChar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CChar -> m CChar) -> IO CChar -> m CChar
forall a b. (a -> b) -> a -> b
$ Device -> IO CChar
ALC.alcCloseDevice Device
device
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CChar
ok CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
== CChar
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"OpenAL: closeDevice error"