From: PHO Date: Sun, 2 Jan 2011 00:03:44 +0000 (+0900) Subject: Monitor X-Git-Tag: RELEASE-0.1~8 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=4570a37d1fc8f21a4ee1221c6ed289d281f1b005;p=EsounD.git Monitor --- diff --git a/EsounD.cabal b/EsounD.cabal index 783ef47..769b4cf 100644 --- a/EsounD.cabal +++ b/EsounD.cabal @@ -39,6 +39,7 @@ Library Exposed-Modules: Sound.EsounD + Sound.EsounD.Monitor Sound.EsounD.Player Sound.EsounD.Streams Sound.EsounD.Types diff --git a/Sound/EsounD.hs b/Sound/EsounD.hs index c44e6dd..98e7c5a 100644 --- a/Sound/EsounD.hs +++ b/Sound/EsounD.hs @@ -3,9 +3,11 @@ module Sound.EsounD ( module Sound.EsounD.Types , module Sound.EsounD.Streams , module Sound.EsounD.Player + , module Sound.EsounD.Monitor ) where +import Sound.EsounD.Monitor +import Sound.EsounD.Player import Sound.EsounD.Streams import Sound.EsounD.Types -import Sound.EsounD.Player diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs index 8d28ed8..fcaff1e 100644 --- a/Sound/EsounD/Internals.hs +++ b/Sound/EsounD/Internals.hs @@ -11,6 +11,7 @@ module Sound.EsounD.Internals , Mono , Stereo , interleave + , deinterleave , wrapSocket , closeSocket @@ -53,7 +54,7 @@ instance Channels Stereo where channelFmt _ = c'ESD_STEREO {-# INLINE interleave #-} -interleave ∷ Frame fr ⇒ L.Vector fr → L.Vector fr → L.Vector fr +interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α interleave l r -- THINKME: consider using storablevector-streamfusion = let Just (lFr, l') = L.viewL l @@ -62,6 +63,21 @@ interleave l r in L.cons lFr (L.cons rFr lr') +{-# INLINE deinterleave #-} +deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α) +deinterleave v + -- THINKME: consider using storablevector-streamfusion + = let (lr, v') = L.splitAt 2 v + in + if L.null lr then + (L.empty, L.empty) + else + let Just (lFr, r) = L.viewL lr + Just (rFr, _) = L.viewL r + (l', r') = deinterleave v' + in + (L.cons lFr l', L.cons rFr r') + -- Utility functions wrapSocket ∷ String → CInt → IO Handle wrapSocket e (-1) = fail e diff --git a/Sound/EsounD/Monitor.hs b/Sound/EsounD/Monitor.hs new file mode 100644 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) + ) diff --git a/Sound/EsounD/Player.hs b/Sound/EsounD/Player.hs index b48dfee..49740fc 100644 --- a/Sound/EsounD/Player.hs +++ b/Sound/EsounD/Player.hs @@ -27,7 +27,7 @@ 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 ∷ ★ → ★) @@ -44,20 +44,23 @@ instance Dup (Player fr ch) where dup pl = do ch' ← dup (plCloseH pl) return pl { plCloseH = ch' } -instance Frame fr ⇒ Writable (Player fr Mono) (L.Vector fr) where - write 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 $ L.hPut (plHandle pl) v -instance Frame fr ⇒ Writable (Player fr Stereo) (L.Vector fr, L.Vector fr) where - write pl (l, r) +instance Frame fr ⇒ WritableStream (Player fr Stereo) (L.Vector fr, L.Vector fr) where + writeFrames pl (l, r) = liftIO $ sanitizeIOError $ L.hPut (plHandle pl) (interleave l r) -- | Open an ESD handle for playing a stream. openPlayer ∷ ∀fr ch s pr. - ( Frame fr - , Channels ch - , MonadPeelIO 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 @@ -88,13 +91,9 @@ openPlayer rate host name hostPtr namePtr ≫= wrapSocket - ( "esd_play_stream(" - ⧺ show fmt - ⧺ ", " - ⧺ show rate - ⧺ ", " - ⧺ show host - ⧺ ", " - ⧺ show name - ⧺ ") returned an error" + ( printf "esd_play_stream(%s, %s, %s, %s) returned an error" + (show fmt ) + (show rate) + (show host) + (show name) ) diff --git a/Sound/EsounD/Streams.hs b/Sound/EsounD/Streams.hs index 216fdaf..374b602 100644 --- a/Sound/EsounD/Streams.hs +++ b/Sound/EsounD/Streams.hs @@ -4,14 +4,32 @@ #-} -- | EsounD stream I/O module Sound.EsounD.Streams - ( Writable(..) + ( Stream(..) + , ReadableStream(..) + , WritableStream(..) ) where import Control.Monad.IO.Class import Control.Monad.Trans.Region -class Writable ws dvec where - write ∷ ( AncestorRegion pr cr - , MonadIO cr - ) - ⇒ ws pr → dvec → cr () +-- | ESD streams. +class Stream s where + streamSampleRate ∷ s pr → Int + +-- | ESD streams which behave as sources. +class Stream rs ⇒ ReadableStream rs dvec where + readFrames ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ rs pr + → Int -- ^ number of frames to read + → cr dvec -- ^ frames in deinterleaved vectors + +-- | ESD streams which behave as sinks. +class Stream ws ⇒ WritableStream ws dvec where + writeFrames ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ ws pr + → dvec -- ^ frames in deinterleaved vectors + → cr () diff --git a/examples/EsdPlayerExample.hs b/examples/EsdPlayerExample.hs index cddc9eb..e25b1be 100644 --- a/examples/EsdPlayerExample.hs +++ b/examples/EsdPlayerExample.hs @@ -24,7 +24,7 @@ playMono16Sine ∷ ( AncestorRegion pr cr → Double → cr () playMono16Sine pl sampleFreq sec noteFreq - = write pl buffer + = writeFrames pl buffer where buffer ∷ L.Vector Int16 buffer = L.pack L.defaultChunkSize frames