keid-sound-openal 0.1.1.0 → 0.2.0.0

raw patch · 4 files changed

+78/−64 lines, 4 filesdep +openal-ffidep −OpenALPVP ok

version bump matches the API change (PVP)

Dependencies added: openal-ffi

Dependencies removed: OpenAL

API changes (from Hackage documentation)

Files

• keid-sound-openal.cabal +3/−3
• src/Engine/Sound/Device.hs +20/−23
• src/Engine/Sound/Source.hs +22/−15
• src/Resource/Opus.hs +33/−23

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           keid-sound-openal-version:        0.1.1.0+version:        0.2.0.0 synopsis:       OpenAL sound system for Keid engine. category:       Game Engine author:         IC Rainbow@@ -90,9 +90,9 @@       ViewPatterns   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints   build-depends:-      OpenAL-    , base >=4.7 && <5+      base >=4.7 && <5     , keid-core >=0.1.2.0+    , openal-ffi >=0.0.1     , opusfile >=0.1.0.1     , resourcet     , rio >=0.1.12.0

@@ -1,5 +1,5 @@ module Engine.Sound.Device-  ( OpenAL.Device+  ( ALC.Device   , allocate   , create   , destroy@@ -7,7 +7,8 @@  import RIO -import Sound.OpenAL qualified as OpenAL+import Foreign (nullPtr)+import Sound.OpenAL.FFI.ALC qualified as ALC import UnliftIO.Resource qualified as Resource  allocate@@ -16,7 +17,7 @@      , MonadReader env m      , HasLogFunc env      )-  => m (Resource.ReleaseKey, OpenAL.Device)+  => m (Resource.ReleaseKey, ALC.Device) allocate = do   soundDevice <- create   soundDeviceDestroy <- toIO $ destroy soundDevice@@ -28,28 +29,24 @@      , HasLogFunc env      , MonadUnliftIO m      )-  => m OpenAL.Device+  => m ALC.Device create = do-  OpenAL.openDevice Nothing >>= \case-    Nothing -> do-      logError "OpenAL: no devices"-      exitFailure-    Just device -> do-      OpenAL.createContext device [] >>= \case-        Nothing -> do-          logError "OpenAL.createContext failed"-          exitFailure-        Just ctx -> do-          OpenAL.currentContext OpenAL.$=! Just ctx-          pure device+  device <- liftIO $ ALC.alcOpenDevice nullPtr+  context <- liftIO $ ALC.alcCreateContext device nullPtr +  ok <- liftIO $ ALC.alcMakeContextCurrent context+  if ok == 1 then+    pure device+  else do+    logError "OpenAL: alcMakeContextCurrent failed"+    exitFailure+ destroy   :: (MonadIO m, MonadReader env m, HasLogFunc env)-  => OpenAL.Device+  => ALC.Device   -> m ()-destroy device =-  OpenAL.closeDevice device >>= \case-    True ->-      pure ()-    False ->-      logWarn "OpenAL: closeDevice error"+destroy device = do+  -- ALC.alcDestroyContext context+  ok <- liftIO $ ALC.alcCloseDevice device+  unless (ok == 1) $+    logWarn "OpenAL: closeDevice error"

@@ -2,16 +2,17 @@  import RIO -import Sound.OpenAL qualified as OpenAL+import Sound.OpenAL.FFI.AL qualified as AL import UnliftIO.Resource qualified as Resource+import Foreign qualified  class HasSource a where-  getSource :: a -> OpenAL.Source+  getSource :: a -> AL.Source -instance HasSource OpenAL.Source where+instance HasSource AL.Source where   getSource = id -instance HasSource (a, OpenAL.Source) where+instance HasSource (a, AL.Source) where   getSource = snd  allocateCollectionWith@@ -26,11 +27,13 @@   loaded <- traverse action collection    key <- Resource.register do-    let sources = map getSource $ toList loaded-    OpenAL.stop sources-    for_ sources \source ->-      OpenAL.buffer source OpenAL.$= Nothing-    OpenAL.deleteObjectNames sources+    -- let sources = map getSource $ toList loaded+    -- stop loaded+    -- for_ sources \source ->+    --   OpenAL.buffer source OpenAL.$= Nothing+    -- OpenAL.deleteObjectNames sources+    Foreign.withArrayLen (map getSource $ toList loaded) \num ->+      AL.alDeleteSources (fromIntegral num)    pure (key, loaded) @@ -40,7 +43,10 @@  {-# INLINE play #-} play :: (Foldable t, HasSource a, MonadIO m) => t a -> m ()-play = OpenAL.play . map getSource . toList+play (toList -> sources) =+  liftIO $+    Foreign.withArrayLen (map getSource sources) \num ->+      AL.alSourcePlayv (fromIntegral num)  {-# INLINE stop1 #-} stop1 :: (HasSource a, MonadIO m) => a -> m ()@@ -48,14 +54,15 @@  {-# INLINE stop #-} stop :: (Foldable t, HasSource a, MonadIO m) => t a -> m ()-stop = OpenAL.stop . map getSource . toList+stop (toList -> sources) =+  liftIO $+    Foreign.withArrayLen (map getSource sources) \num ->+      AL.alSourceStopv (fromIntegral num)  {-# INLINE toggle #-} toggle :: (HasSource a, MonadIO m) => Bool -> a -> m () toggle active src =   if active then-    OpenAL.play srcs+    play1 src   else-    OpenAL.stop srcs-  where-    srcs = [getSource src]+    stop1 src

@@ -10,7 +10,8 @@ import Foreign qualified import Foreign.C.Types (CFloat(..)) import GHC.Stack (withFrozenCallStack)-import Sound.OpenAL qualified as OpenAL+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@@ -21,7 +22,7 @@   , byteSource  :: Resource.Source   } -type Source = (Double, OpenAL.Source)+type Source = (Double, AL.Source)  load   :: ( MonadIO m@@ -29,7 +30,7 @@      , HasLogFunc env      , HasCallStack      )-  => OpenAL.Device+  => ALC.Device   -> Config   -> m Source load _device Config{..} = do@@ -39,9 +40,9 @@   alFormat <-     case OpusFile.pcmChannels pcm of       Right OpusFile.Stereo ->-        pure OpenAL.Stereo16+        pure AL.FORMAT_STEREO16       Right OpusFile.Mono ->-        pure OpenAL.Mono16+        pure AL.FORMAT_MONO16       Left n -> do         logError $ mconcat           [ "unexpected channels in "@@ -51,29 +52,38 @@           ]         exitFailure -  !buffer <- liftIO OpenAL.genObjectName+  buffer@(AL.Buffer bufId) <- liftIO $+    Foreign.alloca \bufPtr -> do+      AL.alGenBuffers 1 bufPtr+      Foreign.peek bufPtr+   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+    Foreign.withForeignPtr (OpusFile.pcmData pcm) \pcmData ->+      AL.alBufferData+        buffer+        alFormat+        (Foreign.castPtr pcmData)+        (fromIntegral $ OpusFile.pcmSize pcm)+        48000 -  !source <- liftIO $ OpenAL.genObjectName+  source <- liftIO $+    Foreign.alloca \sourcePtr -> do+      AL.alGenSources 1 sourcePtr+      Foreign.peek sourcePtr+   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+    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)-  where-    loopingMode' =-      if loopingMode then-        OpenAL.Looping-      else-        OpenAL.OneShot-    gain' = CFloat gain  -- TODO: extract to `opusfile` loadPCM :: MonadIO m => ByteString -> m (OpusFile.Pcm Int16)