openPlayer now works? (not tested)

[EsounD.git] / Sound / EsounD.hs

diff --git a/Sound/EsounD.hs b/Sound/EsounD.hs
index ba46305e0af46eaaf354d81d9d16931e29d8a467..f6de9a028fde75807cb7378d4bfff98693e7c252 100644 (file)
--- a/Sound/EsounD.hs
+++ b/Sound/EsounD.hs
@@ -1,45 +1,115 @@
 -- | Type-safe bindings to EsounD with monadic regions.
 module Sound.EsounD
-    ( Player
+    ( Frame
+
+    , Channels
+    , Mono
+    , Stereo
+
+    , Player
     , openPlayer
     )
     where
 
+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 Foreign.C.String
+import Foreign.C.Types
+import Foreign.Ptr
 import Network
-import System.IO.SaferFileHandles
+import Prelude.Unicode
+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
+
+instance Frame Int8 where
+    frameFmt _ = c'ESD_BITS8
+
+instance Frame Int16 where
+    frameFmt _ = c'ESD_BITS16
+
+class Channels ch where
+    channelFmt ∷ ch → C'esd_format_t
 
-{-
 data Mono
+instance Channels Mono where
+    channelFmt _ = c'ESD_MONO
+
 data Stereo
+instance Channels Stereo where
+    channelFmt _ = c'ESD_STEREO
 
-data Recorder frame channels
-data Filter   frame channels
-data Sampler
--}
 
 -- ^ An ESD handle for playing a stream.
-data Player frame channels (r ∷ * → *)
+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 frame channels) where
-    dup pl
-        = do h' ← dup (plHandle pl)
-             return pl { plHandle = h' }
+instance Dup (Player fr ch) where
+    dup pl = do ch' ← R.dup (plCloseH pl)
+                return pl { plCloseH = ch' }
 
--- ^ Open an ESD handle for playing a stream.
-openPlayer ∷ MonadCatchIO pr
+-- | Open an ESD handle for playing a stream.
+openPlayer ∷ ∀fr ch s pr.
+               ( Frame fr
+               , Channels ch
+               , MonadCatchIO pr
+               )
            ⇒ Int          -- ^ sample rate for the stream.
            → HostName     -- ^ host to connect to.
            → Maybe String -- ^ name used to identify this stream to
                            --   ESD (if any).
-           → RegionT s pr (Player frame channels (RegionT s pr))
+           → RegionT s pr (Player fr ch (RegionT s pr))
 openPlayer rate host name
-    = return Player {
-        plRate   = rate
-      , plHandle = error "FIXME: not implemented"
-      }
+    = do h  ← liftIO openSocket
+         ch ← onExit $ sanitizeIOError $ closeSocket h
+         return Player {
+                      plRate   = rate
+                    , 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