X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=EsounD.git;a=blobdiff_plain;f=Sound%2FEsounD%2FFilter.hs;fp=Sound%2FEsounD%2FFilter.hs;h=21413647b2fc5e728fc03a98c221d1ef46edbf03;hp=0000000000000000000000000000000000000000;hb=cb4f21e26b30aff97bd7615fba86405e50b163b3;hpb=d4df6ebbadb94400304178fa4827e189462b57ec

diff --git a/Sound/EsounD/Filter.hs b/Sound/EsounD/Filter.hs
new file mode 100644
index 0000000..2141364
--- /dev/null
+++ b/Sound/EsounD/Filter.hs
@@ -0,0 +1,120 @@
+{-# 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)
+                               )