From 080d77f8aece1d14f71f6fd337f0cda9cdf7d740 Mon Sep 17 00:00:00 2001 From: PHO Date: Sun, 2 Jan 2011 14:59:00 +0900 Subject: [PATCH] samples --- Sound/EsounD/Controller.hs | 227 ++++++++++++++++++++++++++++++++++++- Sound/EsounD/Filter.hs | 10 +- Sound/EsounD/Internals.hs | 9 +- Sound/EsounD/Player.hs | 10 +- 4 files changed, 245 insertions(+), 11 deletions(-) diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs index 1353d06..aa9daba 100644 --- a/Sound/EsounD/Controller.hs +++ b/Sound/EsounD/Controller.hs @@ -13,6 +13,16 @@ module Sound.EsounD.Controller , lock , unlock + + , standby + , resume + + , Sample + , SampleSource(..) + , playSample + , loopSample + , stopSample + , killSample ) where import Bindings.EsounD @@ -22,10 +32,14 @@ import Control.Monad.IO.Peel import Control.Monad.Trans.Region import Control.Monad.Trans.Region.OnExit import Control.Monad.Unicode +import Data.Bits +import Data.StorableVector.Lazy as L import Foreign.C.Types import Network +import Prelude.Unicode import Sound.EsounD.Internals import System.IO.SaferFileHandles.Unsafe +import System.Posix.IO hiding (dup) import System.Posix.Types import Text.Printf @@ -83,7 +97,8 @@ lock co = liftIO $ sanitizeIOError $ c'esd_lock (fdToCInt $ coSocket co) - ≫= failOnError "esd_lock(fd) returned an error" + ≫= failOnError "esd_lock(fd) returned an error" (≤ 0) + ≫ return () -- | Unlock the ESD so that it will accept connections from remote -- hosts. @@ -96,4 +111,212 @@ unlock co = liftIO $ sanitizeIOError $ c'esd_unlock (fdToCInt $ coSocket co) - ≫= failOnError "esd_unlock(fd) returned an error" + ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0) + ≫ return () + +-- | Let ESD stop playing sounds and release its connection to the +-- audio device so that other processes may use it. +standby ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +standby co + = liftIO $ + sanitizeIOError $ + c'esd_standby (fdToCInt $ coSocket co) + ≫= failOnError "esd_standby(fd) returned an error" (≤ 0) + ≫ return () + +-- | Let ESD attempt to reconnect to the audio device and start +-- playing sounds again. +resume ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +resume co + = liftIO $ + sanitizeIOError $ + c'esd_resume (fdToCInt $ coSocket co) + ≫= failOnError "esd_resume(fd) returned an error" (≤ 0) + ≫ return () + +-- | An opaque ESD sample handle. +data Sample (r ∷ ★ → ★) + = Sample { + saID ∷ !CInt + , saCtrl ∷ !(Controller r) + , saCloseH ∷ !(FinalizerHandle r) + } + +instance Dup Sample where + dup sa = do ctrl' ← dup (saCtrl sa) + ch' ← dup (saCloseH sa) + return sa { + saCtrl = ctrl' + , saCloseH = ch' + } + +class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where + -- | Cache a sample in the server. + cacheSample ∷ (MonadPeelIO pr) + ⇒ Controller (RegionT s pr) + → Maybe String -- ^ name used to identify this sample to + → Int -- ^ sample rate + → dvec -- ^ frames in deinterleaved vectors + → RegionT s pr (Sample (RegionT s pr)) + +instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where + cacheSample co name rate v + = block $ + do sa ← createSample + co + name + rate + ((⊥) ∷ fr ) + ((⊥) ∷ Mono) + (L.length v) + _ ← liftIO $ + sanitizeIOError $ + do h ← fdToHandle $ coSocket co + _ ← L.hPut h v + (Fd fd) ← handleToFd h + c'esd_confirm_sample_cache fd + ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0) + return sa + +instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where + cacheSample co name rate (l, r) + = block $ + do sa ← createSample + co + name + rate + ((⊥) ∷ fr ) + ((⊥) ∷ Mono) + (L.length l) + _ ← liftIO $ + sanitizeIOError $ + do h ← fdToHandle $ coSocket co + _ ← L.hPut h (interleave l r) + (Fd fd) ← handleToFd h + c'esd_confirm_sample_cache fd + ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0) + return sa + +createSample ∷ ∀fr ch s pr. + ( Frame fr + , Channels ch + , MonadPeelIO pr + ) + ⇒ Controller (RegionT s pr) + → Maybe String + → Int + → fr + → ch + → Int + → RegionT s pr (Sample (RegionT s pr)) +createSample co name rate _ _ size + = block $ + do sid ← liftIO newCache + ch ← onExit $ sanitizeIOError $ deleteCache sid + return Sample { + saID = sid + , saCtrl = co + , saCloseH = ch + } + where + fmt ∷ C'esd_format_t + fmt = frameFmt ((⊥) ∷ fr) .|. + channelFmt ((⊥) ∷ ch) .|. + c'ESD_SAMPLE + + newCache ∷ IO CInt + newCache = withCStrOrNull name $ \namePtr → + c'esd_sample_cache + (fdToCInt $ coSocket co) + fmt + (fromIntegral rate) + (fromIntegral size) + namePtr + ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error" + (show $ coSocket co) + (show fmt) + (show rate) + (show size) + (show name) + ) (< 0) + + deleteCache ∷ CInt → IO () + deleteCache sid + = c'esd_sample_free (fdToCInt $ coSocket co) sid + ≫= failOnError ( printf "esd_sample_free(%s) returned an error" + (show $ coSocket co) + (show sid) + ) (< 0) + ≫ return () + +-- | Play a cached sample once. +playSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +playSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Play a cached sample repeatedly. +loopSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +loopSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Stop a looping sample at end. +stopSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +stopSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Stop a playing sample immediately. +killSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +killSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () diff --git a/Sound/EsounD/Filter.hs b/Sound/EsounD/Filter.hs index 2141364..26b6336 100644 --- a/Sound/EsounD/Filter.hs +++ b/Sound/EsounD/Filter.hs @@ -67,11 +67,17 @@ instance Frame fr ⇒ ReadableStream (Filter fr Stereo) (L.Vector fr, L.Vector f instance Frame fr ⇒ WritableStream (Filter fr Mono) (L.Vector fr) where writeFrames fi v - = liftIO $ sanitizeIOError $ L.hPut (fiHandle fi) v + = liftIO $ + sanitizeIOError $ + do L.hPut (fiHandle fi) v + hFlush (fiHandle fi) instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where writeFrames fi (l, r) - = liftIO $ sanitizeIOError $ L.hPut (fiHandle fi) (interleave l r) + = liftIO $ + sanitizeIOError $ + do L.hPut (fiHandle fi) (interleave l r) + hFlush (fiHandle fi) -- | Open an ESD handle for filtering sound produced by ESD. -- diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs index f4b067f..735ce63 100644 --- a/Sound/EsounD/Internals.hs +++ b/Sound/EsounD/Internals.hs @@ -28,7 +28,6 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Ptr import Foreign.Storable -import Prelude.Unicode import System.IO import System.Posix.IO import System.Posix.Types @@ -99,7 +98,7 @@ withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a withCStrOrNull Nothing f = f nullPtr withCStrOrNull (Just s) f = withCString s f -failOnError ∷ Monad m ⇒ String → CInt → m () -failOnError msg rv - | rv ≤ 0 = fail msg - | otherwise = return () +failOnError ∷ Monad m ⇒ String → (CInt → Bool) → CInt → m CInt +failOnError msg isErr rv + | isErr rv = fail msg + | otherwise = return rv diff --git a/Sound/EsounD/Player.hs b/Sound/EsounD/Player.hs index 49740fc..56781da 100644 --- a/Sound/EsounD/Player.hs +++ b/Sound/EsounD/Player.hs @@ -49,11 +49,17 @@ instance Stream (Player fr ch) where instance Frame fr ⇒ WritableStream (Player fr Mono) (L.Vector fr) where writeFrames pl v - = liftIO $ sanitizeIOError $ L.hPut (plHandle pl) v + = liftIO $ + sanitizeIOError $ + do L.hPut (plHandle pl) v + hFlush (plHandle pl) instance Frame fr ⇒ WritableStream (Player fr Stereo) (L.Vector fr, L.Vector fr) where writeFrames pl (l, r) - = liftIO $ sanitizeIOError $ L.hPut (plHandle pl) (interleave l r) + = liftIO $ + sanitizeIOError $ + do L.hPut (plHandle pl) (interleave l r) + hFlush (plHandle pl) -- | Open an ESD handle for playing a stream. openPlayer ∷ ∀fr ch s pr. -- 2.40.0