, lock
, unlock
+
+ , standby
+ , resume
+
+ , Sample
+ , SampleSource(..)
+ , playSample
+ , loopSample
+ , stopSample
+ , killSample
)
where
import Bindings.EsounD
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
= 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.
= 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 ()
projects / EsounD.git / commitdiff