Recorder

diff --git a/EsounD.cabal b/EsounD.cabal
index 769b4cf9dcc807ae0031c0235278f39e076735a9..28e18d0bfec6305faf0d63910f314f29123b2199 100644 (file)
--- a/EsounD.cabal
+++ b/EsounD.cabal
@@ -41,6 +41,7 @@ Library
         Sound.EsounD
         Sound.EsounD.Monitor
         Sound.EsounD.Player
+        Sound.EsounD.Recorder
         Sound.EsounD.Streams
         Sound.EsounD.Types
 

diff --git a/Sound/EsounD.hs b/Sound/EsounD.hs
index 98e7c5aa324813d91c52424ccbd4c318f95a030f..ecac99f12faf2eb911d63627c95dba6f84444cc9 100644 (file)
--- a/Sound/EsounD.hs
+++ b/Sound/EsounD.hs
@@ -3,11 +3,13 @@ module Sound.EsounD
     ( module Sound.EsounD.Types
     , module Sound.EsounD.Streams
     , module Sound.EsounD.Player
+    , module Sound.EsounD.Recorder
     , module Sound.EsounD.Monitor
     )
     where
 
 import Sound.EsounD.Monitor
 import Sound.EsounD.Player
+import Sound.EsounD.Recorder
 import Sound.EsounD.Streams
 import Sound.EsounD.Types

diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs
index fcaff1e5e88d84d5c887bf0a45e3d34f93b1e865..60cf4b922b39d02aea0e26ab24e6b7047691ee75 100644 (file)
--- a/Sound/EsounD/Internals.hs
+++ b/Sound/EsounD/Internals.hs
@@ -13,6 +13,8 @@ module Sound.EsounD.Internals
     , interleave
     , deinterleave
 
+    , toLSV
+
     , wrapSocket
     , closeSocket
     , withCStrOrNull
@@ -20,6 +22,7 @@ module Sound.EsounD.Internals
     where
 import Bindings.EsounD
 import Data.Int
+import Data.StorableVector      as S
 import Data.StorableVector.Lazy as L
 import Foreign.C.String
 import Foreign.C.Types
@@ -79,6 +82,9 @@ deinterleave v
               (L.cons lFr l', L.cons rFr r')
 
 -- Utility functions
+toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α
+toLSV v = L.fromChunks [v]
+
 wrapSocket ∷ String → CInt → IO Handle
 wrapSocket e (-1) = fail e
 wrapSocket _ fd   = fdToHandle (Fd fd)

diff --git a/Sound/EsounD/Monitor.hs b/Sound/EsounD/Monitor.hs
index 7a06b80019820bd9c2c3c131103368268878a020..0fadfd775bc3606dea15f08f3e24af6354a8facf 100644 (file)
--- a/Sound/EsounD/Monitor.hs
+++ b/Sound/EsounD/Monitor.hs
@@ -22,7 +22,6 @@ 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
@@ -46,9 +45,6 @@ instance Dup (Monitor fr ch) where
 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 $

diff --git a/Sound/EsounD/Recorder.hs b/Sound/EsounD/Recorder.hs
new file mode 100644 (file)
index 0000000..7a843c3
--- /dev/null
+++ b/Sound/EsounD/Recorder.hs
@@ -0,0 +1,103 @@
+{-# LANGUAGE
+    FlexibleContexts
+  , FlexibleInstances
+  , KindSignatures
+  , MultiParamTypeClasses
+  , UnicodeSyntax
+  , ScopedTypeVariables
+  #-}
+-- | EsounD recording streams.
+module Sound.EsounD.Recorder
+    ( Recorder
+    , openRecorder
+    )
+    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 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 recording data from the soundcard via ESD.
+data Recorder fr ch (r ∷ ★ → ★)
+    = Recorder {
+        reRate   ∷ !Int
+      , reHandle ∷ !Handle
+      , reCloseH ∷ !(FinalizerHandle r)
+      }
+
+instance Dup (Recorder fr ch) where
+    dup re = do ch' ← dup (reCloseH re)
+                return re { reCloseH = ch' }
+
+instance Stream (Recorder fr ch) where
+    streamSampleRate = reRate
+
+instance Frame fr ⇒ ReadableStream (Recorder fr Mono) (L.Vector fr) where
+    readFrames re nFrames
+        = liftIO $
+          sanitizeIOError $
+          fmap toLSV $
+          S.hGet (reHandle re) nFrames
+
+instance Frame fr ⇒ ReadableStream (Recorder fr Stereo) (L.Vector fr, L.Vector fr) where
+    readFrames re nFrames
+        = liftIO $
+          sanitizeIOError $
+          fmap (deinterleave ∘ toLSV) $
+          S.hGet (reHandle re) nFrames
+
+-- | Open an ESD handle for recording data from the soundcard via ESD.
+openRecorder ∷ ∀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 (Recorder fr ch (RegionT s pr))
+openRecorder rate host name
+    = block $
+      do h  ← liftIO openSocket
+         ch ← onExit $ sanitizeIOError $ closeSocket h
+         return Recorder {
+                      reRate   = rate
+                    , reHandle = h
+                    , reCloseH = ch
+                    }
+    where
+      fmt ∷ C'esd_format_t
+      fmt = frameFmt   ((⊥) ∷ fr) .|.
+            channelFmt ((⊥) ∷ ch) .|.
+            c'ESD_STREAM            .|.
+            c'ESD_RECORD
+
+      openSocket ∷ IO Handle
+      openSocket = withCStrOrNull host $ \hostPtr →
+                   withCStrOrNull name $ \namePtr →
+                       c'esd_record_stream
+                       fmt
+                       (fromIntegral rate)
+                       hostPtr
+                       namePtr
+                       ≫= wrapSocket
+                               ( printf "esd_record_stream(%s, %s, %s, %s) returned an error"
+                                        (show fmt )
+                                        (show rate)
+                                        (show host)
+                                        (show name)
+                               )