X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Sound%2FEsounD%2FPlayer.hs;h=4d3c719cdf9fe09cd527da7a32e370bc68d1bb45;hb=HEAD;hp=0525a7bea358e40cb458dd081583f453d80d6acc;hpb=2c9350d4762d69bbfcdc58212e27506c3d4f7494;p=EsounD.git

diff --git a/Sound/EsounD/Player.hs b/Sound/EsounD/Player.hs
index 0525a7b..4d3c719 100644
--- a/Sound/EsounD/Player.hs
+++ b/Sound/EsounD/Player.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    FlexibleInstances
+    FlexibleContexts
+  , FlexibleInstances
   , KindSignatures
   , MultiParamTypeClasses
   , UnicodeSyntax
@@ -12,20 +13,21 @@ module Sound.EsounD.Player
     )
     where
 import Bindings.EsounD
+import Control.Exception.Control
 import Control.Monad.IO.Class
+import Control.Monad.IO.Control
 import Control.Monad.Trans.Region
 import Control.Monad.Trans.Region.OnExit
 import Control.Monad.Unicode
 import Data.Bits
-import Data.StorableVector.Lazy as Lazy
-import Foreign.C.String
+import Data.StorableVector.Lazy as L
 import Network
 import Prelude.Unicode
-import Sound.EsounD.Streams 
+import Sound.EsounD.Streams
 import Sound.EsounD.Internals
 import System.IO
 import System.IO.SaferFileHandles.Unsafe
-
+import Text.Printf
 
 -- ^ An opaque ESD handle for playing a stream.
 data Player fr ch (r ∷ ★ → ★)
@@ -42,23 +44,37 @@ instance Dup (Player fr ch) where
     dup pl = do ch' ← dup (plCloseH pl)
                 return pl { plCloseH = ch' }
 
-instance Frame fr ⇒ Writable (Player fr Mono) (Lazy.Vector fr) where
-    write pl v
-        = liftIO $ sanitizeIOError $ Lazy.hPut (plHandle pl) v
+instance Stream (Player fr ch) where
+    streamSampleRate = plRate
+
+instance Frame fr ⇒ WritableStream (Player fr Mono) (L.Vector fr) where 
+    writeFrames pl v
+        = liftIO $
+          sanitizeIOError $
+          do L.hPut (plHandle pl) v
+             hFlush (plHandle pl)
+
+instance Frame fr ⇒ WritableStream (Player fr Stereo) (L.Vector fr, L.Vector fr) where
+    writeFrames pl (l, r)
+        = liftIO $
+          sanitizeIOError $
+          do L.hPut (plHandle pl) (interleave l r)
+             hFlush (plHandle pl)
 
 -- | Open an ESD handle for playing a stream.
 openPlayer ∷ ∀fr ch s pr.
-               ( Frame fr
-               , Channels ch
-               , MonadIO pr
-               )
-           ⇒ Int          -- ^ sample rate for the stream.
-           → HostName     -- ^ host to connect to.
-           → Maybe String -- ^ name used to identify this stream to
-                           --   ESD (if any).
+              ( Frame fr
+              , Channels ch
+              , MonadControlIO pr
+              )
+           ⇒ Int            -- ^ sample rate for the stream.
+           → Maybe HostName -- ^ host to connect to.
+           → Maybe String   -- ^ name used to identify this stream to
+                             --   ESD (if any).
            → RegionT s pr (Player fr ch (RegionT s pr))
 openPlayer rate host name
-    = do h  ← liftIO openSocket
+    = mask_ $
+      do h  ← liftIO openSocket
          ch ← onExit $ sanitizeIOError $ closeSocket h
          return Player {
                       plRate   = rate
@@ -67,17 +83,23 @@ openPlayer rate host name
                     }
     where
       fmt :: C'esd_format_t
-      fmt = frameFmt   ((⊥) ∷ fr) .&.
-            channelFmt ((⊥) ∷ ch) .&.
-            c'ESD_STREAM            .&.
+      fmt = frameFmt   ((⊥) ∷ fr) .|.
+            channelFmt ((⊥) ∷ ch) .|.
+            c'ESD_STREAM            .|.
             c'ESD_PLAY
 
       openSocket :: IO Handle
-      openSocket = withCString    host $ \hostPtr →
+      openSocket = withCStrOrNull host $ \hostPtr →
                    withCStrOrNull name $ \namePtr →
                        c'esd_play_stream
                        fmt
                        (fromIntegral rate)
                        hostPtr
                        namePtr
-                       ≫= wrapSocket "esd_play_stream() returned an error"
+                       ≫= wrapSocket
+                               ( printf "esd_play_stream(%s, %s, %s, %s) returned an error"
+                                        (show fmt )
+                                        (show rate)
+                                        (show host)
+                                        (show name)
+                               )