Device.hs

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 = do
  soundDevice <- create
  soundDeviceDestroy <- toIO $ destroy soundDevice
  soundDeviceKey <- Resource.register soundDeviceDestroy
  pure (soundDeviceKey, soundDevice)

create
  :: ( MonadReader env m
     , HasLogFunc env
     , MonadUnliftIO m
     )
  => m ALC.Device
create = do
  device <- liftIO $ ALC.alcOpenDevice nullPtr
  context <- liftIO $ ALC.alcCreateContext device nullPtr

  ok <- liftIO $ ALC.alcMakeContextCurrent context
  if ok == 1 then
    pure device
  else do
    logError "OpenAL: alcMakeContextCurrent failed"
    exitFailure

destroy
  :: (MonadIO m, MonadReader env m, HasLogFunc env)
  => ALC.Device
  -> m ()
destroy device = do
  -- ALC.alcDestroyContext context
  ok <- liftIO $ ALC.alcCloseDevice device
  unless (ok == 1) $
    logWarn "OpenAL: closeDevice error"