--- /dev/null
+{-# LANGUAGE
+ FlexibleContexts
+ , FlexibleInstances
+ , KindSignatures
+ , MultiParamTypeClasses
+ , UnicodeSyntax
+ , ScopedTypeVariables
+ #-}
+-- | EsounD filtering streams.
+module Sound.EsounD.Filter
+ ( Filter
+ , openFilter
+ )
+ 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 filtering sound produced by ESD.
+--
+-- Reading from the stream will give a block of audio frames, which is
+-- the mixed output from other players and filters. The filter is free
+-- to process this block as it likes, but must then write an
+-- identically sized block to the stream. The frames so returned is
+-- played by the ESD, possibly after applying more filters to it.
+data Filter fr ch (r ∷ ★ → ★)
+ = Filter {
+ fiRate ∷ !Int
+ , fiHandle ∷ !Handle
+ , fiCloseH ∷ !(FinalizerHandle r)
+ }
+
+instance Dup (Filter fr ch) where
+ dup fi = do ch' ← dup (fiCloseH fi)
+ return fi { fiCloseH = ch' }
+
+instance Stream (Filter fr ch) where
+ streamSampleRate = fiRate
+
+instance Frame fr ⇒ ReadableStream (Filter fr Mono) (L.Vector fr) where
+ readFrames fi nFrames
+ = liftIO $
+ sanitizeIOError $
+ fmap toLSV $
+ S.hGet (fiHandle fi) nFrames
+
+instance Frame fr ⇒ ReadableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
+ readFrames fi nFrames
+ = liftIO $
+ sanitizeIOError $
+ fmap (deinterleave ∘ toLSV) $
+ S.hGet (fiHandle fi) nFrames
+
+instance Frame fr ⇒ WritableStream (Filter fr Mono) (L.Vector fr) where
+ writeFrames fi v
+ = liftIO $ sanitizeIOError $ L.hPut (fiHandle fi) v
+
+instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
+ writeFrames fi (l, r)
+ = liftIO $ sanitizeIOError $ L.hPut (fiHandle fi) (interleave l r)
+
+-- | Open an ESD handle for filtering sound produced by ESD.
+--
+-- The new filter will be placed at the head of the list of filters:
+-- i.e. it will receive data for processing first, and the next filter
+-- will receive the resultant processed data.
+openFilter ∷ ∀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 (Filter fr ch (RegionT s pr))
+openFilter rate host name
+ = block $
+ do h ← liftIO openSocket
+ ch ← onExit $ sanitizeIOError $ closeSocket h
+ return Filter {
+ fiRate = rate
+ , fiHandle = h
+ , fiCloseH = ch
+ }
+ where
+ fmt ∷ C'esd_format_t
+ fmt = frameFmt ((⊥) ∷ fr) .|.
+ channelFmt ((⊥) ∷ ch) .|.
+ c'ESD_STREAM
+
+ openSocket ∷ IO Handle
+ openSocket = withCStrOrNull host $ \hostPtr →
+ withCStrOrNull name $ \namePtr →
+ c'esd_filter_stream
+ fmt
+ (fromIntegral rate)
+ hostPtr
+ namePtr
+ ≫= wrapSocket
+ ( printf "esd_filter_stream(%s, %s, %s, %s) returned an error"
+ (show fmt )
+ (show rate)
+ (show host)
+ (show name)
+ )