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 qualified as OpenAL
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, OpenAL.Source)
load
:: ( MonadIO m
, MonadReader env m
, HasLogFunc env
, HasCallStack
)
=> OpenAL.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
Format
alFormat <-
case Pcm Int16 -> Either Int Channels
forall a. Pcm a -> Either Int Channels
OpusFile.pcmChannels Pcm Int16
pcm of
Right Channels
OpusFile.Stereo ->
Format -> m Format
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
OpenAL.Stereo16
Right Channels
OpusFile.Mono ->
Format -> m Format
forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
OpenAL.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 Format
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
!Buffer
buffer <- IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Buffer
forall a (m :: * -> *). (GeneratableObjectName a, MonadIO m) => m a
OpenAL.genObjectName
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
ptr -> do
let
mreg :: MemoryRegion Int16
mreg =
Ptr Int16 -> ALsizei -> MemoryRegion Int16
forall a. Ptr a -> ALsizei -> MemoryRegion a
OpenAL.MemoryRegion Ptr Int16
ptr (Int -> ALsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ALsizei) -> Int -> ALsizei
forall a b. (a -> b) -> a -> b
$ Pcm Int16 -> Int
forall a. Pcm a -> Int
OpusFile.pcmSize Pcm Int16
pcm)
Buffer -> StateVar (BufferData Int16)
forall a. Buffer -> StateVar (BufferData a)
OpenAL.bufferData Buffer
buffer StateVar (BufferData Int16) -> BufferData Int16 -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! MemoryRegion Int16 -> Format -> Float -> BufferData Int16
forall a. MemoryRegion a -> Format -> Float -> BufferData a
OpenAL.BufferData MemoryRegion Int16
mreg Format
alFormat Float
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
$ IO Source
forall a (m :: * -> *). (GeneratableObjectName a, MonadIO m) => m a
OpenAL.genObjectName
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
Source -> StateVar (Maybe Buffer)
OpenAL.buffer Source
source StateVar (Maybe Buffer) -> Maybe Buffer -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just Buffer
buffer
Source -> StateVar LoopingMode
OpenAL.loopingMode Source
source StateVar LoopingMode -> LoopingMode -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! LoopingMode
loopingMode'
Source -> StateVar Gain
OpenAL.sourceGain Source
source StateVar Gain -> Gain -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! Gain
gain'
Source -> StateVar Gain
OpenAL.rolloffFactor Source
source StateVar Gain -> Gain -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
OpenAL.$=! Gain
0
pure (Pcm Int16 -> Double
forall a. Pcm a -> Double
OpusFile.pcmTime Pcm Int16
pcm, Source
source)
where
loopingMode' :: LoopingMode
loopingMode' =
if Bool
loopingMode then
LoopingMode
OpenAL.Looping
else
LoopingMode
OpenAL.OneShot
gain' :: Gain
gain' = Float -> Gain
CFloat Float
gain
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