, lock
, unlock
+
+ , standby
+ , resume
+
+ , Sample
+ , SampleSource(..)
+ , playSample
+ , loopSample
+ , stopSample
+ , killSample
+
+ , ServerInfo(..)
+ , FrameType(..)
+ , NumChannels(..)
+ , getServerInfo
)
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 Foreign.Ptr
+import Foreign.Storable
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 )
+ ((⊥) ∷ Stereo)
+ (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 ()
+
+
+
+-- | A data type to represent the server info.
+data ServerInfo
+ = ServerInfo {
+ serverVersion ∷ !Int
+ , serverFrameType ∷ !FrameType
+ , serverChannels ∷ !NumChannels
+ , serverSampleRate ∷ !Int
+ }
+ deriving (Show, Eq)
+
+data FrameType
+ = Int8 | Int16
+ deriving (Show, Eq)
+
+data NumChannels
+ = Mono | Stereo
+ deriving (Show, Eq)
+
+-- | Retrieve server properties.
+getServerInfo ∷ ( AncestorRegion pr cr
+ , MonadIO cr
+ )
+ ⇒ Controller pr
+ → cr ServerInfo
+getServerInfo co
+ = liftIO $
+ sanitizeIOError $
+ bracket retrieve dispose extract
+ where
+ retrieve ∷ IO (Ptr C'esd_server_info)
+ retrieve = do siPtr ← c'esd_get_server_info (fdToCInt $ coSocket co)
+ if siPtr ≡ nullPtr then
+ fail "esd_resume(fd) returned an error"
+ else
+ return siPtr
+
+ dispose ∷ Ptr C'esd_server_info → IO ()
+ dispose = c'esd_free_server_info
+
+ extract ∷ Ptr C'esd_server_info → IO ServerInfo
+ extract siPtr
+ = do si ← peek siPtr
+ return ServerInfo {
+ serverVersion
+ = fromIntegral $
+ c'esd_server_info'version si
+ , serverFrameType
+ = case c'esd_server_info'format si of
+ fmt | fmt .&. c'ESD_BITS8 ≡ 1 → Int8
+ | fmt .&. c'ESD_BITS16 ≡ 1 → Int16
+ | otherwise → error ("Unknown format: " ⧺ show fmt)
+ , serverChannels
+ = case c'esd_server_info'format si of
+ fmt | fmt .&. c'ESD_MONO ≡ 1 → Mono
+ | fmt .&. c'ESD_STEREO ≡ 1 → Stereo
+ | otherwise → error ("Unknown format: " ⧺ show fmt)
+ , serverSampleRate
+ = fromIntegral $
+ c'esd_server_info'rate si
+ }
projects / EsounD.git / blobdiff