Sound/EsounD/Filter.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , KindSignatures
   5   , MultiParamTypeClasses
   6   , UnicodeSyntax
   7   , ScopedTypeVariables
   8   #-}
   9 -- | EsounD filtering streams.
  10 module Sound.EsounD.Filter
  11     ( Filter
  12     , openFilter
  13     )
  14     where
  15 import Bindings.EsounD
  16 import Control.Exception.Peel
  17 import Control.Monad.IO.Class
  18 import Control.Monad.IO.Peel
  19 import Control.Monad.Trans.Region
  20 import Control.Monad.Trans.Region.OnExit
  21 import Control.Monad.Unicode
  22 import Data.Bits
  23 import Data.StorableVector      as S
  24 import Data.StorableVector.Lazy as L
  25 import Network
  26 import Prelude.Unicode
  27 import Sound.EsounD.Streams
  28 import Sound.EsounD.Internals
  29 import System.IO
  30 import System.IO.SaferFileHandles.Unsafe
  31 import Text.Printf
  32
  33 -- ^ An opaque ESD handle for filtering sound produced by ESD.
  34 --
  35 -- Reading from the stream will give a block of audio frames, which is
  36 -- the mixed output from other players and filters. The filter is free
  37 -- to process this block as it likes, but must then write an
  38 -- identically sized block to the stream. The frames so returned is
  39 -- played by the ESD, possibly after applying more filters to it.
  40 data Filter fr ch (r ∷ ★ → ★)
  41     = Filter {
  42         fiRate   ∷ !Int
  43       , fiHandle ∷ !Handle
  44       , fiCloseH ∷ !(FinalizerHandle r)
  45       }
  46
  47 instance Dup (Filter fr ch) where
  48     dup fi = do ch' ← dup (fiCloseH fi)
  49                 return fi { fiCloseH = ch' }
  50
  51 instance Stream (Filter fr ch) where
  52     streamSampleRate = fiRate
  53
  54 instance Frame fr ⇒ ReadableStream (Filter fr Mono) (L.Vector fr) where
  55     readFrames fi nFrames
  56         = liftIO $
  57           sanitizeIOError $
  58           fmap toLSV $
  59           S.hGet (fiHandle fi) nFrames
  60
  61 instance Frame fr ⇒ ReadableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
  62     readFrames fi nFrames
  63         = liftIO $
  64           sanitizeIOError $
  65           fmap (deinterleave ∘ toLSV) $
  66           S.hGet (fiHandle fi) nFrames
  67
  68 instance Frame fr ⇒ WritableStream (Filter fr Mono) (L.Vector fr) where
  69     writeFrames fi v
  70         = liftIO $
  71           sanitizeIOError $
  72           do L.hPut (fiHandle fi) v
  73              hFlush (fiHandle fi)
  74
  75 instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
  76     writeFrames fi (l, r)
  77         = liftIO $
  78           sanitizeIOError $
  79           do L.hPut (fiHandle fi) (interleave l r)
  80              hFlush (fiHandle fi)
  81
  82 -- | Open an ESD handle for filtering sound produced by ESD.
  83 --
  84 -- The new filter will be placed at the head of the list of filters:
  85 -- i.e. it will receive data for processing first, and the next filter
  86 -- will receive the resultant processed data.
  87 openFilter ∷ ∀fr ch s pr.
  88               ( Frame fr
  89               , Channels ch
  90               , MonadPeelIO pr
  91               )
  92            ⇒ Int            -- ^ sample rate for the stream.
  93            → Maybe HostName -- ^ host to connect to.
  94            → Maybe String   -- ^ name used to identify this stream to
  95                              --   ESD (if any).
  96            → RegionT s pr (Filter fr ch (RegionT s pr))
  97 openFilter rate host name
  98     = block $
  99       do h  ← liftIO openSocket
 100          ch ← onExit $ sanitizeIOError $ closeSocket h
 101          return Filter {
 102                       fiRate   = rate
 103                     , fiHandle = h
 104                     , fiCloseH = ch
 105                     }
 106     where
 107       fmt ∷ C'esd_format_t
 108       fmt = frameFmt   ((⊥) ∷ fr) .|.
 109             channelFmt ((⊥) ∷ ch) .|.
 110             c'ESD_STREAM
 111
 112       openSocket ∷ IO Handle
 113       openSocket = withCStrOrNull host $ \hostPtr →
 114                    withCStrOrNull name $ \namePtr →
 115                        c'esd_filter_stream
 116                        fmt
 117                        (fromIntegral rate)
 118                        hostPtr
 119                        namePtr
 120                        ≫= wrapSocket
 121                                ( printf "esd_filter_stream(%s, %s, %s, %s) returned an error"
 122                                         (show fmt )
 123                                         (show rate)
 124                                         (show host)
 125                                         (show name)
 126                                )