5 , MultiParamTypeClasses
9 -- | EsounD controlling handles.
10 module Sound.EsounD.Controller
28 import Bindings.EsounD
29 import Control.Exception.Peel
30 import Control.Monad.IO.Class
31 import Control.Monad.IO.Peel
32 import Control.Monad.Trans.Region
33 import Control.Monad.Trans.Region.OnExit
34 import Control.Monad.Unicode
36 import Data.StorableVector.Lazy as L
37 import Foreign.C.Types
39 import Prelude.Unicode
40 import Sound.EsounD.Internals
41 import System.IO.SaferFileHandles.Unsafe
42 import System.Posix.IO hiding (dup)
43 import System.Posix.Types
46 -- ^ An opaque ESD handle for controlling ESD.
47 data Controller (r ∷ ★ → ★)
50 , coCloseH ∷ !(FinalizerHandle r)
53 instance Dup Controller where
54 dup co = do ch' ← dup (coCloseH co)
55 return co { coCloseH = ch' }
57 -- | Open an ESD handle for controlling ESD.
58 openController ∷ MonadPeelIO pr
59 ⇒ Maybe HostName -- ^ host to connect to.
60 → RegionT s pr (Controller (RegionT s pr))
63 do s ← liftIO openSocket
64 ch ← onExit $ sanitizeIOError $ closeSocket' s
71 openSocket = withCStrOrNull host $ \hostPtr →
72 c'esd_open_sound hostPtr
75 wrapSocket' ∷ Monad m ⇒ CInt → m Fd
76 wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error"
79 wrapSocket' fd = return $ Fd fd
81 closeSocket' ∷ Fd → IO ()
83 = do _ ← c'esd_close $ fdToCInt fd
87 fdToCInt (Fd fd) = fromIntegral fd
89 -- | Lock the ESD so that it won't accept connections from remote
91 lock ∷ ( AncestorRegion pr cr
99 c'esd_lock (fdToCInt $ coSocket co)
100 ≫= failOnError "esd_lock(fd) returned an error" (≤ 0)
103 -- | Unlock the ESD so that it will accept connections from remote
105 unlock ∷ ( AncestorRegion pr cr
113 c'esd_unlock (fdToCInt $ coSocket co)
114 ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0)
117 -- | Let ESD stop playing sounds and release its connection to the
118 -- audio device so that other processes may use it.
119 standby ∷ ( AncestorRegion pr cr
127 c'esd_standby (fdToCInt $ coSocket co)
128 ≫= failOnError "esd_standby(fd) returned an error" (≤ 0)
131 -- | Let ESD attempt to reconnect to the audio device and start
132 -- playing sounds again.
133 resume ∷ ( AncestorRegion pr cr
141 c'esd_resume (fdToCInt $ coSocket co)
142 ≫= failOnError "esd_resume(fd) returned an error" (≤ 0)
145 -- | An opaque ESD sample handle.
146 data Sample (r ∷ ★ → ★)
149 , saCtrl ∷ !(Controller r)
150 , saCloseH ∷ !(FinalizerHandle r)
153 instance Dup Sample where
154 dup sa = do ctrl' ← dup (saCtrl sa)
155 ch' ← dup (saCloseH sa)
161 class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where
162 -- | Cache a sample in the server.
163 cacheSample ∷ (MonadPeelIO pr)
164 ⇒ Controller (RegionT s pr)
165 → Maybe String -- ^ name used to identify this sample to
166 → Int -- ^ sample rate
167 → dvec -- ^ frames in deinterleaved vectors
168 → RegionT s pr (Sample (RegionT s pr))
170 instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where
171 cacheSample co name rate v
182 do h ← fdToHandle $ coSocket co
184 (Fd fd) ← handleToFd h
185 c'esd_confirm_sample_cache fd
186 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
189 instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
190 cacheSample co name rate (l, r)
201 do h ← fdToHandle $ coSocket co
202 _ ← L.hPut h (interleave l r)
203 (Fd fd) ← handleToFd h
204 c'esd_confirm_sample_cache fd
205 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
208 createSample ∷ ∀fr ch s pr.
213 ⇒ Controller (RegionT s pr)
219 → RegionT s pr (Sample (RegionT s pr))
220 createSample co name rate _ _ size
222 do sid ← liftIO newCache
223 ch ← onExit $ sanitizeIOError $ deleteCache sid
231 fmt = frameFmt ((⊥) ∷ fr) .|.
232 channelFmt ((⊥) ∷ ch) .|.
236 newCache = withCStrOrNull name $ \namePtr →
238 (fdToCInt $ coSocket co)
243 ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error"
251 deleteCache ∷ CInt → IO ()
253 = c'esd_sample_free (fdToCInt $ coSocket co) sid
254 ≫= failOnError ( printf "esd_sample_free(%s) returned an error"
260 -- | Play a cached sample once.
261 playSample ∷ ( AncestorRegion pr cr
269 c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
270 ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error"
271 (show $ coSocket $ saCtrl sa)
276 -- | Play a cached sample repeatedly.
277 loopSample ∷ ( AncestorRegion pr cr
285 c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
286 ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error"
287 (show $ coSocket $ saCtrl sa)
292 -- | Stop a looping sample at end.
293 stopSample ∷ ( AncestorRegion pr cr
301 c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
302 ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error"
303 (show $ coSocket $ saCtrl sa)
308 -- | Stop a playing sample immediately.
309 killSample ∷ ( AncestorRegion pr cr
317 c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
318 ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error"
319 (show $ coSocket $ saCtrl sa)