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 $ sanitizeIOError $ L.hPut (fiHandle fi) v
  71
  72 instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where
  73     writeFrames fi (l, r)
  74         = liftIO $ sanitizeIOError $ L.hPut (fiHandle fi) (interleave l r)
  75
  76 -- | Open an ESD handle for filtering sound produced by ESD.
  77 --
  78 -- The new filter will be placed at the head of the list of filters:
  79 -- i.e. it will receive data for processing first, and the next filter
  80 -- will receive the resultant processed data.
  81 openFilter ∷ ∀fr ch s pr.
  82               ( Frame fr
  83               , Channels ch
  84               , MonadPeelIO pr
  85               )
  86            ⇒ Int            -- ^ sample rate for the stream.
  87            → Maybe HostName -- ^ host to connect to.
  88            → Maybe String   -- ^ name used to identify this stream to
  89                              --   ESD (if any).
  90            → RegionT s pr (Filter fr ch (RegionT s pr))
  91 openFilter rate host name
  92     = block $
  93       do h  ← liftIO openSocket
  94          ch ← onExit $ sanitizeIOError $ closeSocket h
  95          return Filter {
  96                       fiRate   = rate
  97                     , fiHandle = h
  98                     , fiCloseH = ch
  99                     }
 100     where
 101       fmt ∷ C'esd_format_t
 102       fmt = frameFmt   ((⊥) ∷ fr) .|.
 103             channelFmt ((⊥) ∷ ch) .|.
 104             c'ESD_STREAM
 105
 106       openSocket ∷ IO Handle
 107       openSocket = withCStrOrNull host $ \hostPtr →
 108                    withCStrOrNull name $ \namePtr →
 109                        c'esd_filter_stream
 110                        fmt
 111                        (fromIntegral rate)
 112                        hostPtr
 113                        namePtr
 114                        ≫= wrapSocket
 115                                ( printf "esd_filter_stream(%s, %s, %s, %s) returned an error"
 116                                         (show fmt )
 117                                         (show rate)
 118                                         (show host)
 119                                         (show name)
 120                                )