Monitor

[EsounD.git] / Sound / EsounD / Monitor.hs

diff --git a/Sound/EsounD/Monitor.hs b/Sound/EsounD/Monitor.hs
new file mode 100644 (file)
index 0000000..7a06b80
--- /dev/null
+++ b/Sound/EsounD/Monitor.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE
+    FlexibleContexts
+  , FlexibleInstances
+  , KindSignatures
+  , MultiParamTypeClasses
+  , UnicodeSyntax
+  , ScopedTypeVariables
+  #-}
+-- | EsounD monitoring streams.
+module Sound.EsounD.Monitor
+    ( Monitor
+    , openMonitor
+    )
+    where
+import Bindings.EsounD
+import Control.Exception.Peel
+import Control.Monad.IO.Class
+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      as S
+import Data.StorableVector.Lazy as L
+import Foreign.Storable
+import Network
+import Prelude.Unicode
+import Sound.EsounD.Streams
+import Sound.EsounD.Internals
+import System.IO
+import System.IO.SaferFileHandles.Unsafe
+import Text.Printf
+
+-- ^ An opaque ESD handle for monitoring the output from the ESD.
+data Monitor fr ch (r ∷ ★ → ★)
+    = Monitor {
+        moRate   ∷ !Int
+      , moHandle ∷ !Handle
+      , moCloseH ∷ !(FinalizerHandle r)
+      }
+
+instance Dup (Monitor fr ch) where
+    dup mo = do ch' ← dup (moCloseH mo)
+                return mo { moCloseH = ch' }
+
+instance Stream (Monitor fr ch) where
+    streamSampleRate = moRate
+
+toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α
+toLSV v = L.fromChunks [v]
+
+instance Frame fr ⇒ ReadableStream (Monitor fr Mono) (L.Vector fr) where
+    readFrames mo nFrames
+        = liftIO $
+          sanitizeIOError $
+          fmap toLSV $
+          S.hGet (moHandle mo) nFrames
+
+instance Frame fr ⇒ ReadableStream (Monitor fr Stereo) (L.Vector fr, L.Vector fr) where
+    readFrames mo nFrames
+        = liftIO $
+          sanitizeIOError $
+          fmap (deinterleave ∘ toLSV) $
+          S.hGet (moHandle mo) nFrames
+
+-- | Open an ESD handle for monitoring the output from the ESD.
+openMonitor ∷ ∀fr ch s pr.
+               ( Frame fr
+               , Channels ch
+               , MonadPeelIO 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 (Monitor fr ch (RegionT s pr))
+openMonitor rate host name
+    = block $
+      do h  ← liftIO openSocket
+         ch ← onExit $ sanitizeIOError $ closeSocket h
+         return Monitor {
+                      moRate   = rate
+                    , moHandle = h
+                    , moCloseH = ch
+                    }
+    where
+      fmt ∷ C'esd_format_t
+      fmt = frameFmt   ((⊥) ∷ fr) .|.
+            channelFmt ((⊥) ∷ ch) .|.
+            c'ESD_STREAM            .|.
+            c'ESD_MONITOR
+
+      openSocket ∷ IO Handle
+      openSocket = withCStrOrNull host $ \hostPtr →
+                   withCStrOrNull name $ \namePtr →
+                       c'esd_monitor_stream
+                       fmt
+                       (fromIntegral rate)
+                       hostPtr
+                       namePtr
+                       ≫= wrapSocket
+                               ( printf "esd_monitor_stream(%s, %s, %s, %s) returned an error"
+                                        (show fmt )
+                                        (show rate)
+                                        (show host)
+                                        (show name)
+                               )