openPlayer now works? (not tested)

diff --git a/EsounD.cabal b/EsounD.cabal
index 47960a398a664806c5e40588cfe18e06f7657fa2..108bba01a692aecc3c3c4662bc51d3e2bce5a62a 100644 (file)
--- a/EsounD.cabal
+++ b/EsounD.cabal
@@ -29,7 +29,9 @@ Library
         network                   == 2.2.*,
         regions                   == 0.7.*,
         safer-file-handles        == 0.8.*,
         network                   == 2.2.*,
         regions                   == 0.7.*,
         safer-file-handles        == 0.8.*,

-        storablevector            == 0.2.*
+        storablevector            == 0.2.*,
+        transformers              == 0.2.*,
+        unix                      == 2.4.*

 
     Exposed-Modules:
         Sound.EsounD
 
     Exposed-Modules:
         Sound.EsounD

diff --git a/Sound/EsounD.hs b/Sound/EsounD.hs
index a088e9072c79e8fbac137a5250c1f1fb769d87ee..f6de9a028fde75807cb7378d4bfff98693e7c252 100644 (file)
--- a/Sound/EsounD.hs
+++ b/Sound/EsounD.hs
@@ -13,12 +13,21 @@ module Sound.EsounD
 
 import Bindings.EsounD
 import Control.Monad.CatchIO
 
 import Bindings.EsounD
 import Control.Monad.CatchIO

-import Control.Monad.Trans.Region
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Region as R
+import Control.Monad.Trans.Region.OnExit
+import Control.Monad.Unicode

 import Data.Bits
 import Data.Int
 import Data.Bits
 import Data.Int

+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Ptr

 import Network
 import Prelude.Unicode
 import Network
 import Prelude.Unicode

-import System.IO.SaferFileHandles
+import System.IO
+import System.IO.SaferFileHandles.Unsafe
+import System.Posix.IO
+import System.Posix.Types

 
 class Frame fr where
     frameFmt ∷ fr → C'esd_format_t
 
 class Frame fr where
     frameFmt ∷ fr → C'esd_format_t


@@ -44,17 +53,20 @@ instance Channels Stereo where
 -- ^ An ESD handle for playing a stream.
 data Player fr ch (r ∷ * → *)
     = Player {
 -- ^ An ESD handle for playing a stream.
 data Player fr ch (r ∷ * → *)
     = Player {

-        plRate   ∷ Int
-      , plHandle ∷ RegionalFileHandle WriteMode r
+        plRate   ∷ !Int
+      -- THINKME: We really want to use RegionalFileHandle but we
+      -- can't, because safer-file-handles currently provides no ways
+      -- to wrap ordinary handles.
+      , plHandle ∷ !Handle
+      , plCloseH ∷ !(CloseHandle r)

       }
 
 instance Dup (Player fr ch) where
       }
 
 instance Dup (Player fr ch) where

-    dup pl
-        = do h' ← dup (plHandle pl)
-             return pl { plHandle = h' }
+    dup pl = do ch' ← R.dup (plCloseH pl)
+                return pl { plCloseH = ch' }

 
 -- | Open an ESD handle for playing a stream.
 
 -- | Open an ESD handle for playing a stream.

-openPlayer ∷ ∀ fr ch s pr.
+openPlayer ∷ ∀fr ch s pr.

                ( Frame fr
                , Channels ch
                , MonadCatchIO pr
                ( Frame fr
                , Channels ch
                , MonadCatchIO pr


@@ -65,11 +77,39 @@ openPlayer ∷ ∀ fr ch s pr.
                            --   ESD (if any).
            → RegionT s pr (Player fr ch (RegionT s pr))
 openPlayer rate host name
                            --   ESD (if any).
            → RegionT s pr (Player fr ch (RegionT s pr))
 openPlayer rate host name

-    = do let fmt = frameFmt   ((⊥) ∷ fr) .&.
-                   channelFmt ((⊥) ∷ ch) .&.
-                   c'ESD_STREAM            .&.
-                   c'ESD_PLAY
+    = do h  ← liftIO openSocket
+         ch ← onExit $ sanitizeIOError $ closeSocket h

          return Player {
                       plRate   = rate
          return Player {
                       plRate   = rate

-                    , plHandle = error "FIXME: not implemented"
+                    , plHandle = h
+                    , plCloseH = ch

                     }
                     }

+    where
+      fmt :: C'esd_format_t
+      fmt = frameFmt   ((⊥) ∷ fr) .&.
+            channelFmt ((⊥) ∷ ch) .&.
+            c'ESD_STREAM            .&.
+            c'ESD_PLAY
+
+      openSocket :: IO Handle
+      openSocket = withCString    host $ \hostPtr →
+                   withCStrOrNull name $ \namePtr →
+                       c'esd_play_stream
+                       fmt
+                       (fromIntegral rate)
+                       hostPtr
+                       namePtr
+                       ≫= wrapSocket "esd_play_stream() returned an error"
+
+wrapSocket :: String -> CInt → IO Handle
+wrapSocket e (-1) = fail e
+wrapSocket _ fd   = fdToHandle (Fd fd)
+
+closeSocket :: Handle → IO ()
+closeSocket h = do (Fd fd) ← handleToFd h
+                   _       ← c'esd_close (fromIntegral fd)
+                   return ()
+
+withCStrOrNull :: Maybe String → (CString → IO a) → IO a
+withCStrOrNull Nothing  f = f nullPtr
+withCStrOrNull (Just s) f = withCString s f