Recorder

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

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)
+                               )