X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Sound%2FEsounD%2FController.hs;h=433c032c1ec66d83be23b64d3aeae16491ca8a17;hb=a3232311af5c412a47542ff5af7ea94af0c44422;hp=1353d065215d7ca8a02e70ef0becbffc39414639;hpb=808cc2f4700bc0b2f77cee443dd237d415b4d5d7;p=EsounD.git

diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs
index 1353d06..433c032 100644
--- a/Sound/EsounD/Controller.hs
+++ b/Sound/EsounD/Controller.hs
@@ -13,6 +13,21 @@ module Sound.EsounD.Controller
 
     , lock
     , unlock
+
+    , standby
+    , resume
+
+    , Sample
+    , SampleSource(..)
+    , playSample
+    , loopSample
+    , stopSample
+    , killSample
+
+    , ServerInfo(..)
+    , FrameType(..)
+    , NumChannels(..)
+    , getServerInfo
     )
     where
 import Bindings.EsounD
@@ -22,10 +37,16 @@ import Control.Monad.IO.Peel
 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
 
@@ -83,7 +104,8 @@ lock co
     = 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.
@@ -96,4 +118,275 @@ unlock co
     = 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
+                          }