5 , MultiParamTypeClasses
9 -- | EsounD controlling handles.
10 module Sound.EsounD.Controller
44 import Bindings.EsounD
45 import Control.Exception.Control
46 import Control.Monad.IO.Class
47 import Control.Monad.IO.Control
48 import Control.Monad.Trans.Region
49 import Control.Monad.Trans.Region.OnExit
50 import Control.Monad.Unicode
53 import qualified Data.StorableVector.Lazy as L
54 import Foreign.C.Types
56 import Foreign.Storable
58 import Prelude hiding (pi)
59 import Prelude.Unicode
60 import Sound.EsounD.Internals
61 import System.IO.SaferFileHandles.Unsafe
62 import System.Posix.IO hiding (dup)
63 import System.Posix.Types
66 -- ^ An opaque ESD handle for controlling ESD.
67 data Controller (r ∷ ★ → ★)
70 , coCloseH ∷ !(FinalizerHandle r)
73 instance Dup Controller where
74 dup co = do ch' ← dup (coCloseH co)
75 return co { coCloseH = ch' }
77 -- | Open an ESD handle for controlling ESD.
78 openController ∷ MonadControlIO pr
79 ⇒ Maybe HostName -- ^ host to connect to.
80 → RegionT s pr (Controller (RegionT s pr))
83 do s ← liftIO openSocket
84 ch ← onExit $ closeSocket' s
91 openSocket = withCStrOrNull host $ \hostPtr →
92 c'esd_open_sound hostPtr
95 wrapSocket' ∷ Monad m ⇒ CInt → m Fd
96 wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error"
99 wrapSocket' fd = return $ Fd fd
101 closeSocket' ∷ Fd → IO ()
103 = do _ ← c'esd_close $ fdToCInt fd
107 fdToCInt (Fd fd) = fromIntegral fd
109 -- | Lock the ESD so that it won't accept connections from remote
111 lock ∷ ( AncestorRegion pr cr
118 c'esd_lock (fdToCInt $ coSocket co)
119 ≫= failOnError "esd_lock(fd) returned an error" (≤ 0)
122 -- | Unlock the ESD so that it will accept connections from remote
124 unlock ∷ ( AncestorRegion pr cr
131 c'esd_unlock (fdToCInt $ coSocket co)
132 ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0)
135 -- | Let ESD stop playing sounds and release its connection to the
136 -- audio device so that other processes may use it.
137 standby ∷ ( AncestorRegion pr cr
144 c'esd_standby (fdToCInt $ coSocket co)
145 ≫= failOnError "esd_standby(fd) returned an error" (≤ 0)
148 -- | Let ESD attempt to reconnect to the audio device and start
149 -- playing sounds again.
150 resume ∷ ( AncestorRegion pr cr
157 c'esd_resume (fdToCInt $ coSocket co)
158 ≫= failOnError "esd_resume(fd) returned an error" (≤ 0)
161 -- | An opaque ESD sample handle.
162 data Sample (r ∷ ★ → ★)
165 , saCtrl ∷ !(Controller r)
166 , saCloseH ∷ !(FinalizerHandle r)
169 instance Dup Sample where
170 dup sa = do ctrl' ← dup (saCtrl sa)
171 ch' ← dup (saCloseH sa)
177 class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where
178 -- | Cache a sample in the server.
179 cacheSample ∷ (MonadControlIO pr)
180 ⇒ Controller (RegionT s pr)
181 → Maybe String -- ^ name used to identify this sample to
182 → Int -- ^ sample rate
183 → dvec -- ^ frames in deinterleaved vectors
184 → RegionT s pr (Sample (RegionT s pr))
186 instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where
187 cacheSample co name rate v
198 do h ← fdToHandle $ coSocket co
200 (Fd fd) ← handleToFd h
201 c'esd_confirm_sample_cache fd
202 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
205 instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
206 cacheSample co name rate (l, r)
217 do h ← fdToHandle $ coSocket co
218 _ ← L.hPut h (interleave l r)
219 (Fd fd) ← handleToFd h
220 c'esd_confirm_sample_cache fd
221 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
224 createSample ∷ ∀fr ch s pr.
229 ⇒ Controller (RegionT s pr)
235 → RegionT s pr (Sample (RegionT s pr))
236 createSample co name rate _ _ len
238 do sid ← liftIO newCache
239 ch ← onExit $ deleteCache sid
247 fmt = frameFmt ((⊥) ∷ fr) .|.
248 channelFmt ((⊥) ∷ ch) .|.
253 ⋅ frameSize ((⊥) ∷ fr)
254 ⋅ numChannels ((⊥) ∷ ch)
257 newCache = withCStrOrNull name $ \namePtr →
259 (fdToCInt $ coSocket co)
262 (fromIntegral sampleSize)
264 ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error"
272 deleteCache ∷ CInt → IO ()
274 = c'esd_sample_free (fdToCInt $ coSocket co) sid
275 ≫= failOnError ( printf "esd_sample_free(%s) returned an error"
281 -- | Play a cached sample once.
282 playSample ∷ ( AncestorRegion pr cr
289 c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
290 ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error"
291 (show $ coSocket $ saCtrl sa)
296 -- | Play a cached sample repeatedly.
297 loopSample ∷ ( AncestorRegion pr cr
304 c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
305 ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error"
306 (show $ coSocket $ saCtrl sa)
311 -- | Stop a looping sample at end.
312 stopSample ∷ ( AncestorRegion pr cr
319 c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
320 ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error"
321 (show $ coSocket $ saCtrl sa)
326 -- | Stop a playing sample immediately.
327 killSample ∷ ( AncestorRegion pr cr
334 c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
335 ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error"
336 (show $ coSocket $ saCtrl sa)
349 -- | A data type to represent the server info.
353 , serverFrameType ∷ !FrameType
354 , serverChannels ∷ !NumChannels
355 , serverSampleRate ∷ !Int
359 extractServerInfo ∷ Ptr C'esd_server_info → IO ServerInfo
360 extractServerInfo siPtr
364 = fromIntegral $ c'esd_server_info'version si
366 = extractFrameType $ c'esd_server_info'format si
368 = extractNumChannels $ c'esd_server_info'format si
370 = fromIntegral $ c'esd_server_info'rate si
373 extractFrameType ∷ C'esd_format_t → FrameType
375 | fmt .&. c'ESD_BITS8 ≢ 0 = Int8
376 | fmt .&. c'ESD_BITS16 ≢ 0 = Int16
377 | otherwise = error ("Unknown format: " ⧺ show fmt)
379 extractNumChannels ∷ C'esd_format_t → NumChannels
380 extractNumChannels fmt
381 | fmt .&. c'ESD_MONO ≢ 0 = Mono
382 | fmt .&. c'ESD_STEREO ≢ 0 = Stereo
383 | otherwise = error ("Unknown format: " ⧺ show fmt)
385 -- | Retrieve server properties.
386 getServerInfo ∷ ( AncestorRegion pr cr
393 bracket retrieve dispose extractServerInfo
395 retrieve ∷ IO (Ptr C'esd_server_info)
396 retrieve = c'esd_get_server_info (fdToCInt $ coSocket co)
397 ≫= failOnError "esd_get_server_info(fd) returned an error" (≡ nullPtr)
399 dispose ∷ Ptr C'esd_server_info → IO ()
400 dispose = c'esd_free_server_info
402 -- | A data type to represent a player stream info.
406 , playerName ∷ !String
407 , playerSampleRate ∷ !Int
408 , playerFrameType ∷ !FrameType
409 , playerChannels ∷ !NumChannels
410 , playerLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
411 , playerRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
415 extractPlayerInfo ∷ Ptr C'esd_player_info → IO [PlayerInfo]
416 extractPlayerInfo piPtr
417 | piPtr ≡ nullPtr = return []
420 let next = c'esd_player_info'next pi
423 = fromIntegral $ c'esd_player_info'source_id pi
425 = map (chr ∘ fromIntegral) $ c'esd_player_info'name pi
427 = fromIntegral $ c'esd_player_info'rate pi
429 = extractFrameType $ c'esd_player_info'format pi
431 = extractNumChannels $ c'esd_player_info'format pi
432 , playerLeftVolumeScale
433 = (fromIntegral $ c'esd_player_info'left_vol_scale pi)
436 , playerRightVolumeScale
437 = (fromIntegral $ c'esd_player_info'right_vol_scale pi)
441 pi'' ← extractPlayerInfo next
444 -- | A data type to represent a cached sample info.
448 , sampleName ∷ !String
449 , sampleSampleRate ∷ !Int
450 , sampleFrameType ∷ !FrameType
451 , sampleChannels ∷ !NumChannels
452 , sampleLength ∷ !Int
453 , sampleLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
454 , sampleRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
458 extractSampleLength ∷ FrameType → NumChannels → Int → Int
459 extractSampleLength fr ch bufLen
470 extractSampleInfo ∷ Ptr C'esd_sample_info → IO [SampleInfo]
471 extractSampleInfo piPtr
472 | piPtr ≡ nullPtr = return []
475 let next = c'esd_sample_info'next pi
476 fr = extractFrameType $ c'esd_sample_info'format pi
477 ch = extractNumChannels $ c'esd_sample_info'format pi
480 = fromIntegral $ c'esd_sample_info'sample_id pi
482 = map (chr ∘ fromIntegral) $ c'esd_sample_info'name pi
484 = fromIntegral $ c'esd_sample_info'rate pi
490 = extractSampleLength fr ch $
491 fromIntegral $ c'esd_sample_info'length pi
492 , sampleLeftVolumeScale
493 = (fromIntegral $ c'esd_sample_info'left_vol_scale pi)
496 , sampleRightVolumeScale
497 = (fromIntegral $ c'esd_sample_info'right_vol_scale pi)
501 pi'' ← extractSampleInfo next
504 -- | A data type to represent all info in the ESD server.
507 serverInfo ∷ !ServerInfo
508 , playersInfo ∷ ![PlayerInfo]
509 , samplesInfo ∷ ![SampleInfo]
513 extractAllInfo ∷ Ptr C'esd_info → IO AllInfo
516 srv ← extractServerInfo $ c'esd_info'server ei
517 pis ← extractPlayerInfo $ c'esd_info'player_list ei
518 sis ← extractSampleInfo $ c'esd_info'sample_list ei
525 -- | Retrieve all info in the ESD server.
526 getAllInfo ∷ ( AncestorRegion pr cr
533 bracket retrieve dispose extractAllInfo
535 retrieve ∷ IO (Ptr C'esd_info)
536 retrieve = c'esd_get_all_info (fdToCInt $ coSocket co)
537 ≫= failOnError "esd_get_all_info(fd) returned an error" (≡ nullPtr)
539 dispose ∷ Ptr C'esd_info → IO ()
540 dispose = c'esd_free_all_info
542 -- | Reset the volume panning for a stream.
543 setStreamPan ∷ ( AncestorRegion pr cr
548 → Double -- ^ left volume: 0 <= scale <= 1
549 → Double -- ^ right volume: 0 <= scale <= 1
551 setStreamPan co sid l r
553 c'esd_set_stream_pan (fdToCInt $ coSocket co)
555 (floor $ l ⋅ c'ESD_VOLUME_BASE)
556 (floor $ r ⋅ c'ESD_VOLUME_BASE)
557 ≫= failOnError ( printf "esd_set_stream_pan(%s, %s, %s, %s) returned an error"
565 -- | Reset the default volume panning for a sample.
566 setDefaultSamplePan ∷ ( AncestorRegion pr cr
571 → Double -- ^ left volume: 0 <= scale <= 1
572 → Double -- ^ right volume: 0 <= scale <= 1
574 setDefaultSamplePan co sid l r
576 c'esd_set_default_sample_pan (fdToCInt $ coSocket co)
578 (floor $ l ⋅ c'ESD_VOLUME_BASE)
579 (floor $ r ⋅ c'ESD_VOLUME_BASE)
580 ≫= failOnError ( printf "esd_set_default_sample_pan(%s, %s, %s, %s) returned an error"
588 -- | A data type to represent server's state.
595 extractServerState ∷ C'esd_standby_mode_t → ServerState
596 extractServerState st
597 | st ≡ c'ESM_ON_STANDBY = Standby
598 | st ≡ c'ESM_ON_AUTOSTANDBY = AutoStandby
599 | st ≡ c'ESM_RUNNING = Running
600 | otherwise = error ("unknown state: " ⧺ show st)
602 -- | Retrieve the server's state.
603 getServerState ∷ ( AncestorRegion pr cr
610 fmap extractServerState $
611 c'esd_get_standby_mode (fdToCInt $ coSocket co)
612 ≫= failOnError "esd_get_standby_mode(fd) returned an error" (≡ c'ESM_ERROR)