keid-sound-openal-0.2.0.0: src/Resource/Opus.hs

module Resource.Opus
  ( Config(..)
  , Source
  , load
  , loadPCM
  ) where

import RIO

import Foreign qualified
import Foreign.C.Types (CFloat(..))
import GHC.Stack (withFrozenCallStack)
import Sound.OpenAL.FFI.AL qualified as AL
import Sound.OpenAL.FFI.ALC qualified as ALC
import Sound.OpusFile qualified as OpusFile

import Resource.Source qualified as Resource

data Config = Config
  { gain        :: Float
  , loopingMode :: Bool
  , byteSource  :: Resource.Source
  }

type Source = (Double, AL.Source)

load
  :: ( MonadIO m
     , MonadReader env m
     , HasLogFunc env
     , HasCallStack
     )
  => ALC.Device
  -> Config
  -> m Source
load _device Config{..} = do
  pcm <- withFrozenCallStack $
    Resource.load loadPCM byteSource

  alFormat <-
    case OpusFile.pcmChannels pcm of
      Right OpusFile.Stereo ->
        pure AL.FORMAT_STEREO16
      Right OpusFile.Mono ->
        pure AL.FORMAT_MONO16
      Left n -> do
        logError $ mconcat
          [ "unexpected channels in "
          , displayShow byteSource
          , ": "
          , displayShow n
          ]
        exitFailure

  buffer@(AL.Buffer bufId) <- liftIO $
    Foreign.alloca \bufPtr -> do
      AL.alGenBuffers 1 bufPtr
      Foreign.peek bufPtr

  liftIO $
    Foreign.withForeignPtr (OpusFile.pcmData pcm) \pcmData ->
      AL.alBufferData
        buffer
        alFormat
        (Foreign.castPtr pcmData)
        (fromIntegral $ OpusFile.pcmSize pcm)
        48000

  source <- liftIO $
    Foreign.alloca \sourcePtr -> do
      AL.alGenSources 1 sourcePtr
      Foreign.peek sourcePtr

  liftIO do
    AL.alSourcei source AL.BUFFER (fromIntegral bufId) -- XXX: unsigned to signed conversion

    AL.alSourcei source AL.LOOPING (bool 0 1 loopingMode)

    Foreign.with (CFloat gain) $
      AL.alSourcefv source AL.GAIN

    -- XXX: exempt from distance attenuation
    Foreign.with (CFloat 0) $
      AL.alSourcefv source AL.ROLLOFF_FACTOR

  pure (OpusFile.pcmTime pcm, source)

-- TODO: extract to `opusfile`
loadPCM :: MonadIO m => ByteString -> m (OpusFile.Pcm Int16)
loadPCM bytes = do
  !opusBytes <- liftIO $
    OpusFile.openMemoryBS bytes >>= \case
      Left err ->
        throwString $ "Opus loader error: " <> show err
      Right res ->
        pure res
  !pcmInt16 <- liftIO $ OpusFile.decodeInt16 opusBytes
  liftIO $ OpusFile.free opusBytes
  pure pcmInt16