5 , MultiParamTypeClasses
9 -- | EsounD controlling handles.
10 module Sound.EsounD.Controller
44 import Bindings.EsounD
45 import Control.Exception.Peel
46 import Control.Monad.IO.Class
47 import Control.Monad.IO.Peel
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 ∷ MonadPeelIO pr
79 ⇒ Maybe HostName -- ^ host to connect to.
80 → RegionT s pr (Controller (RegionT s pr))
83 do s ← liftIO openSocket
84 ch ← onExit $ sanitizeIOError $ 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
119 c'esd_lock (fdToCInt $ coSocket co)
120 ≫= failOnError "esd_lock(fd) returned an error" (≤ 0)
123 -- | Unlock the ESD so that it will accept connections from remote
125 unlock ∷ ( AncestorRegion pr cr
133 c'esd_unlock (fdToCInt $ coSocket co)
134 ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0)
137 -- | Let ESD stop playing sounds and release its connection to the
138 -- audio device so that other processes may use it.
139 standby ∷ ( AncestorRegion pr cr
147 c'esd_standby (fdToCInt $ coSocket co)
148 ≫= failOnError "esd_standby(fd) returned an error" (≤ 0)
151 -- | Let ESD attempt to reconnect to the audio device and start
152 -- playing sounds again.
153 resume ∷ ( AncestorRegion pr cr
161 c'esd_resume (fdToCInt $ coSocket co)
162 ≫= failOnError "esd_resume(fd) returned an error" (≤ 0)
165 -- | An opaque ESD sample handle.
166 data Sample (r ∷ ★ → ★)
169 , saCtrl ∷ !(Controller r)
170 , saCloseH ∷ !(FinalizerHandle r)
173 instance Dup Sample where
174 dup sa = do ctrl' ← dup (saCtrl sa)
175 ch' ← dup (saCloseH sa)
181 class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where
182 -- | Cache a sample in the server.
183 cacheSample ∷ (MonadPeelIO pr)
184 ⇒ Controller (RegionT s pr)
185 → Maybe String -- ^ name used to identify this sample to
186 → Int -- ^ sample rate
187 → dvec -- ^ frames in deinterleaved vectors
188 → RegionT s pr (Sample (RegionT s pr))
190 instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where
191 cacheSample co name rate v
202 do h ← fdToHandle $ coSocket co
204 (Fd fd) ← handleToFd h
205 c'esd_confirm_sample_cache fd
206 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
209 instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
210 cacheSample co name rate (l, r)
221 do h ← fdToHandle $ coSocket co
222 _ ← L.hPut h (interleave l r)
223 (Fd fd) ← handleToFd h
224 c'esd_confirm_sample_cache fd
225 ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0)
228 createSample ∷ ∀fr ch s pr.
233 ⇒ Controller (RegionT s pr)
239 → RegionT s pr (Sample (RegionT s pr))
240 createSample co name rate _ _ len
242 do sid ← liftIO newCache
243 ch ← onExit $ sanitizeIOError $ deleteCache sid
251 fmt = frameFmt ((⊥) ∷ fr) .|.
252 channelFmt ((⊥) ∷ ch) .|.
257 ⋅ frameSize ((⊥) ∷ fr)
258 ⋅ numChannels ((⊥) ∷ ch)
261 newCache = withCStrOrNull name $ \namePtr →
263 (fdToCInt $ coSocket co)
266 (fromIntegral sampleSize)
268 ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error"
276 deleteCache ∷ CInt → IO ()
278 = c'esd_sample_free (fdToCInt $ coSocket co) sid
279 ≫= failOnError ( printf "esd_sample_free(%s) returned an error"
285 -- | Play a cached sample once.
286 playSample ∷ ( AncestorRegion pr cr
294 c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
295 ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error"
296 (show $ coSocket $ saCtrl sa)
301 -- | Play a cached sample repeatedly.
302 loopSample ∷ ( AncestorRegion pr cr
310 c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
311 ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error"
312 (show $ coSocket $ saCtrl sa)
317 -- | Stop a looping sample at end.
318 stopSample ∷ ( AncestorRegion pr cr
326 c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
327 ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error"
328 (show $ coSocket $ saCtrl sa)
333 -- | Stop a playing sample immediately.
334 killSample ∷ ( AncestorRegion pr cr
342 c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa)
343 ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error"
344 (show $ coSocket $ saCtrl sa)
357 -- | A data type to represent the server info.
361 , serverFrameType ∷ !FrameType
362 , serverChannels ∷ !NumChannels
363 , serverSampleRate ∷ !Int
367 extractServerInfo ∷ Ptr C'esd_server_info → IO ServerInfo
368 extractServerInfo siPtr
372 = fromIntegral $ c'esd_server_info'version si
374 = extractFrameType $ c'esd_server_info'format si
376 = extractNumChannels $ c'esd_server_info'format si
378 = fromIntegral $ c'esd_server_info'rate si
381 extractFrameType ∷ C'esd_format_t → FrameType
383 | fmt .&. c'ESD_BITS8 ≢ 0 = Int8
384 | fmt .&. c'ESD_BITS16 ≢ 0 = Int16
385 | otherwise = error ("Unknown format: " ⧺ show fmt)
387 extractNumChannels ∷ C'esd_format_t → NumChannels
388 extractNumChannels fmt
389 | fmt .&. c'ESD_MONO ≢ 0 = Mono
390 | fmt .&. c'ESD_STEREO ≢ 0 = Stereo
391 | otherwise = error ("Unknown format: " ⧺ show fmt)
393 -- | Retrieve server properties.
394 getServerInfo ∷ ( AncestorRegion pr cr
402 bracket retrieve dispose extractServerInfo
404 retrieve ∷ IO (Ptr C'esd_server_info)
405 retrieve = c'esd_get_server_info (fdToCInt $ coSocket co)
406 ≫= failOnError "esd_get_server_info(fd) returned an error" (≡ nullPtr)
408 dispose ∷ Ptr C'esd_server_info → IO ()
409 dispose = c'esd_free_server_info
411 -- | A data type to represent a player stream info.
415 , playerName ∷ !String
416 , playerSampleRate ∷ !Int
417 , playerFrameType ∷ !FrameType
418 , playerChannels ∷ !NumChannels
419 , playerLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
420 , playerRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
424 extractPlayerInfo ∷ Ptr C'esd_player_info → IO [PlayerInfo]
425 extractPlayerInfo piPtr
426 | piPtr ≡ nullPtr = return []
429 let next = c'esd_player_info'next pi
432 = fromIntegral $ c'esd_player_info'source_id pi
434 = map (chr ∘ fromIntegral) $ c'esd_player_info'name pi
436 = fromIntegral $ c'esd_player_info'rate pi
438 = extractFrameType $ c'esd_player_info'format pi
440 = extractNumChannels $ c'esd_player_info'format pi
441 , playerLeftVolumeScale
442 = (fromIntegral $ c'esd_player_info'left_vol_scale pi)
445 , playerRightVolumeScale
446 = (fromIntegral $ c'esd_player_info'right_vol_scale pi)
450 pi'' ← extractPlayerInfo next
453 -- | A data type to represent a cached sample info.
457 , sampleName ∷ !String
458 , sampleSampleRate ∷ !Int
459 , sampleFrameType ∷ !FrameType
460 , sampleChannels ∷ !NumChannels
461 , sampleLength ∷ !Int
462 , sampleLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
463 , sampleRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1
467 extractSampleLength ∷ FrameType → NumChannels → Int → Int
468 extractSampleLength fr ch bufLen
479 extractSampleInfo ∷ Ptr C'esd_sample_info → IO [SampleInfo]
480 extractSampleInfo piPtr
481 | piPtr ≡ nullPtr = return []
484 let next = c'esd_sample_info'next pi
485 fr = extractFrameType $ c'esd_sample_info'format pi
486 ch = extractNumChannels $ c'esd_sample_info'format pi
489 = fromIntegral $ c'esd_sample_info'sample_id pi
491 = map (chr ∘ fromIntegral) $ c'esd_sample_info'name pi
493 = fromIntegral $ c'esd_sample_info'rate pi
499 = extractSampleLength fr ch $
500 fromIntegral $ c'esd_sample_info'length pi
501 , sampleLeftVolumeScale
502 = (fromIntegral $ c'esd_sample_info'left_vol_scale pi)
505 , sampleRightVolumeScale
506 = (fromIntegral $ c'esd_sample_info'right_vol_scale pi)
510 pi'' ← extractSampleInfo next
513 -- | A data type to represent all info in the ESD server.
516 serverInfo ∷ !ServerInfo
517 , playersInfo ∷ ![PlayerInfo]
518 , samplesInfo ∷ ![SampleInfo]
522 extractAllInfo ∷ Ptr C'esd_info → IO AllInfo
525 srv ← extractServerInfo $ c'esd_info'server ei
526 pis ← extractPlayerInfo $ c'esd_info'player_list ei
527 sis ← extractSampleInfo $ c'esd_info'sample_list ei
534 -- | Retrieve all info in the ESD server.
535 getAllInfo ∷ ( AncestorRegion pr cr
543 bracket retrieve dispose extractAllInfo
545 retrieve ∷ IO (Ptr C'esd_info)
546 retrieve = c'esd_get_all_info (fdToCInt $ coSocket co)
547 ≫= failOnError "esd_get_all_info(fd) returned an error" (≡ nullPtr)
549 dispose ∷ Ptr C'esd_info → IO ()
550 dispose = c'esd_free_all_info
552 -- | Reset the volume panning for a stream.
553 setStreamPan ∷ ( AncestorRegion pr cr
558 → Double -- ^ left volume: 0 <= scale <= 1
559 → Double -- ^ right volume: 0 <= scale <= 1
561 setStreamPan co sid l r
564 c'esd_set_stream_pan (fdToCInt $ coSocket co)
566 (floor $ l ⋅ c'ESD_VOLUME_BASE)
567 (floor $ r ⋅ c'ESD_VOLUME_BASE)
568 ≫= failOnError ( printf "esd_set_stream_pan(%s, %s, %s, %s) returned an error"
576 -- | Reset the default volume panning for a sample.
577 setDefaultSamplePan ∷ ( AncestorRegion pr cr
582 → Double -- ^ left volume: 0 <= scale <= 1
583 → Double -- ^ right volume: 0 <= scale <= 1
585 setDefaultSamplePan co sid l r
588 c'esd_set_default_sample_pan (fdToCInt $ coSocket co)
590 (floor $ l ⋅ c'ESD_VOLUME_BASE)
591 (floor $ r ⋅ c'ESD_VOLUME_BASE)
592 ≫= failOnError ( printf "esd_set_default_sample_pan(%s, %s, %s, %s) returned an error"
600 -- | A data type to represent server's state.
607 extractServerState ∷ C'esd_standby_mode_t → ServerState
608 extractServerState st
609 | st ≡ c'ESM_ON_STANDBY = Standby
610 | st ≡ c'ESM_ON_AUTOSTANDBY = AutoStandby
611 | st ≡ c'ESM_RUNNING = Running
612 | otherwise = error ("unknown state: " ⧺ show st)
614 -- | Retrieve the server's state.
615 getServerState ∷ ( AncestorRegion pr cr
623 fmap extractServerState $
624 c'esd_get_standby_mode (fdToCInt $ coSocket co)
625 ≫= failOnError "esd_get_standby_mode(fd) returned an error" (≡ c'ESM_ERROR)