Exposed-Modules:
Sound.EsounD
+ Sound.EsounD.Monitor
Sound.EsounD.Player
Sound.EsounD.Streams
Sound.EsounD.Types
( 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
, Mono
, Stereo
, interleave
+ , deinterleave
, wrapSocket
, closeSocket
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
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
--- /dev/null
+{-# 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)
+ )
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 ∷ ★ → ★)
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
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)
)
#-}
-- | 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 ()
→ Double
→ cr ()
playMono16Sine pl sampleFreq sec noteFreq
- = write pl buffer
+ = writeFrames pl buffer
where
buffer ∷ L.Vector Int16
buffer = L.pack L.defaultChunkSize frames