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
  -- ALC.alcDestroyContext context
  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"