getServerInfo

diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs
index aa9dabae40c9db883635d3049e37937cb20187b9..433c032c1ec66d83be23b64d3aeae16491ca8a17 100644 (file)
--- a/Sound/EsounD/Controller.hs
+++ b/Sound/EsounD/Controller.hs
@@ -23,6 +23,11 @@ module Sound.EsounD.Controller
     , loopSample
     , stopSample
     , killSample
+
+    , ServerInfo(..)
+    , FrameType(..)
+    , NumChannels(..)
+    , getServerInfo
     )
     where
 import Bindings.EsounD
@@ -35,6 +40,8 @@ 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
@@ -193,8 +200,8 @@ instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where
                    co
                    name
                    rate
-                   ((⊥) ∷ fr  )
-                   ((⊥) ∷ Mono)
+                   ((⊥) ∷ fr    )
+                   ((⊥) ∷ Stereo)
                    (L.length l)
              _  ← liftIO $
                    sanitizeIOError $
@@ -320,3 +327,66 @@ killSample 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
+                          }