From d4df6ebbadb94400304178fa4827e189462b57ec Mon Sep 17 00:00:00 2001 From: PHO Date: Sun, 2 Jan 2011 09:12:39 +0900 Subject: [PATCH] Recorder --- EsounD.cabal | 1 + Sound/EsounD.hs | 2 + Sound/EsounD/Internals.hs | 6 +++ Sound/EsounD/Monitor.hs | 4 -- Sound/EsounD/Recorder.hs | 103 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 112 insertions(+), 4 deletions(-) create mode 100644 Sound/EsounD/Recorder.hs diff --git a/EsounD.cabal b/EsounD.cabal index 769b4cf..28e18d0 100644 --- 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 98e7c5a..ecac99f 100644 --- 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 fcaff1e..60cf4b9 100644 --- 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 7a06b80..0fadfd7 100644 --- 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 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) + ) -- 2.40.0