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)
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
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)
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