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

-- {-# LANGUAGE Strict #-}

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

import RIO

import Foreign qualified
import Foreign.C.Types (CFloat(..))
import RIO.ByteString qualified as ByteString
import Sound.OpenAL qualified as OpenAL
import Sound.OpusFile qualified as OpusFile

data Config = Config
  { gain        :: Float
  , loopingMode :: Bool
  , filePath    :: FilePath
  }

type Source = (Double, OpenAL.Source)

load
  :: (MonadIO m, MonadReader env m, HasLogFunc env)
  => OpenAL.Device
  -> Config
  -> m Source
load _device Config{..} = do
  logInfo $ "Loading " <> displayShow filePath
  !pcm <- liftIO do
    Right file <- ByteString.readFile filePath >>= OpusFile.openMemoryBS
    pcmInt16 <- OpusFile.decodeInt16 file
    OpusFile.free file
    pure pcmInt16

  alFormat <-
    case OpusFile.pcmChannels pcm of
      Right OpusFile.Stereo ->
        pure OpenAL.Stereo16
      Right OpusFile.Mono ->
        pure OpenAL.Mono16
      Left n -> do
        logError $ mconcat
          [ "unexpected channels in "
          , displayShow filePath
          , ": "
          , displayShow n
          ]
        exitFailure

  !buffer <- liftIO OpenAL.genObjectName
  liftIO $
    Foreign.withForeignPtr (OpusFile.pcmData pcm) \ptr -> do
      let
        mreg =
          OpenAL.MemoryRegion ptr (fromIntegral $ OpusFile.pcmSize pcm)
      OpenAL.bufferData buffer OpenAL.$=! OpenAL.BufferData mreg alFormat 48000

  !source <- liftIO $ OpenAL.genObjectName
  liftIO do
    OpenAL.buffer source OpenAL.$=! Just buffer
    OpenAL.loopingMode source OpenAL.$=! loopingMode'
    OpenAL.sourceGain source OpenAL.$=! gain'
    OpenAL.rolloffFactor source OpenAL.$=! 0 -- XXX: exempt from distance attenuation

  pure (OpusFile.pcmTime pcm, source)
  where
    loopingMode' =
      if loopingMode then
        OpenAL.Looping
      else
        OpenAL.OneShot
    gain' = CFloat gain