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
  { Config -> Float
gain        :: Float
  , Config -> Bool
loopingMode :: Bool
  , Config -> Source
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 -> m Source
load Device
_device Config{Bool
Float
Source
byteSource :: Source
loopingMode :: Bool
gain :: Float
$sel:byteSource:Config :: Config -> Source
$sel:loopingMode:Config :: Config -> Bool
$sel:gain:Config :: Config -> Float
..} = do
  Pcm Int16
pcm <- (HasCallStack => m (Pcm Int16)) -> m (Pcm Int16)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m (Pcm Int16)) -> m (Pcm Int16))
-> (HasCallStack => m (Pcm Int16)) -> m (Pcm Int16)
forall a b. (a -> b) -> a -> b
$
    (ByteString -> m (Pcm Int16)) -> Source -> m (Pcm Int16)
forall a (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, Typeable a,
 HasCallStack) =>
(ByteString -> m a) -> Source -> m a
Resource.load ByteString -> m (Pcm Int16)
forall (m :: * -> *). MonadIO m => ByteString -> m (Pcm Int16)
loadPCM Source
byteSource

  CInt
alFormat <-
    case Pcm Int16 -> Either Int Channels
forall a. Pcm a -> Either Int Channels
OpusFile.pcmChannels Pcm Int16
pcm of
      Right Channels
OpusFile.Stereo ->
        CInt -> m CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
forall a. (Eq a, Num a) => a
AL.FORMAT_STEREO16
      Right Channels
OpusFile.Mono ->
        CInt -> m CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
forall a. (Eq a, Num a) => a
AL.FORMAT_MONO16
      Left Int
n -> do
        Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat
          [ Utf8Builder
"unexpected channels in "
          , Source -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Source
byteSource
          , Utf8Builder
": "
          , Int -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Int
n
          ]
        m CInt
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

  buffer :: Buffer
buffer@(AL.Buffer CUInt
bufId) <- IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$
    (Ptr Buffer -> IO Buffer) -> IO Buffer
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca \Ptr Buffer
bufPtr -> do
      CInt -> Ptr Buffer -> IO ()
AL.alGenBuffers CInt
1 Ptr Buffer
bufPtr
      Ptr Buffer -> IO Buffer
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr Buffer
bufPtr

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    ForeignPtr Int16 -> (Ptr Int16 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr (Pcm Int16 -> ForeignPtr Int16
forall a. Pcm a -> ForeignPtr a
OpusFile.pcmData Pcm Int16
pcm) \Ptr Int16
pcmData ->
      Buffer -> CInt -> Ptr () -> CInt -> CInt -> IO ()
AL.alBufferData
        Buffer
buffer
        CInt
alFormat
        (Ptr Int16 -> Ptr ()
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr Int16
pcmData)
        (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Pcm Int16 -> Int
forall a. Pcm a -> Int
OpusFile.pcmSize Pcm Int16
pcm)
        CInt
48000

  Source
source <- IO Source -> m Source
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Source -> m Source) -> IO Source -> m Source
forall a b. (a -> b) -> a -> b
$
    (Ptr Source -> IO Source) -> IO Source
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.alloca \Ptr Source
sourcePtr -> do
      CInt -> Ptr Source -> IO ()
AL.alGenSources CInt
1 Ptr Source
sourcePtr
      Ptr Source -> IO Source
forall a. Storable a => Ptr a -> IO a
Foreign.peek Ptr Source
sourcePtr

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
    Source -> CInt -> CInt -> IO ()
AL.alSourcei Source
source CInt
forall a. (Eq a, Num a) => a
AL.BUFFER (CUInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
bufId) -- XXX: unsigned to signed conversion

    Source -> CInt -> CInt -> IO ()
AL.alSourcei Source
source CInt
forall a. (Eq a, Num a) => a
AL.LOOPING (CInt -> CInt -> Bool -> CInt
forall a. a -> a -> Bool -> a
bool CInt
0 CInt
1 Bool
loopingMode)

    CFloat -> (Ptr CFloat -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Foreign.with (Float -> CFloat
CFloat Float
gain) ((Ptr CFloat -> IO ()) -> IO ()) -> (Ptr CFloat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      Source -> CInt -> Ptr CFloat -> IO ()
AL.alSourcefv Source
source CInt
forall a. (Eq a, Num a) => a
AL.GAIN

    -- XXX: exempt from distance attenuation
    CFloat -> (Ptr CFloat -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Foreign.with (Float -> CFloat
CFloat Float
0) ((Ptr CFloat -> IO ()) -> IO ()) -> (Ptr CFloat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      Source -> CInt -> Ptr CFloat -> IO ()
AL.alSourcefv Source
source CInt
forall a. (Eq a, Num a) => a
AL.ROLLOFF_FACTOR

  pure (Pcm Int16 -> Double
forall a. Pcm a -> Double
OpusFile.pcmTime Pcm Int16
pcm, Source
source)

-- TODO: extract to `opusfile`
loadPCM :: MonadIO m => ByteString -> m (OpusFile.Pcm Int16)
loadPCM :: ByteString -> m (Pcm Int16)
loadPCM ByteString
bytes = do
  !Handle
opusBytes <- IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$
    ByteString -> IO (Either Int Handle)
OpusFile.openMemoryBS ByteString
bytes IO (Either Int Handle)
-> (Either Int Handle -> IO Handle) -> IO Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Int
err ->
        String -> IO Handle
forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString (String -> IO Handle) -> String -> IO Handle
forall a b. (a -> b) -> a -> b
$ String
"Opus loader error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
err
      Right Handle
res ->
        Handle -> IO Handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
res
  !Pcm Int16
pcmInt16 <- IO (Pcm Int16) -> m (Pcm Int16)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pcm Int16) -> m (Pcm Int16))
-> IO (Pcm Int16) -> m (Pcm Int16)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Pcm Int16)
OpusFile.decodeInt16 Handle
opusBytes
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
OpusFile.free Handle
opusBytes
  pure Pcm Int16
pcmInt16