Sound/EsounD/Recorder.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , KindSignatures
   5   , MultiParamTypeClasses
   6   , UnicodeSyntax
   7   , ScopedTypeVariables
   8   #-}
   9 -- | EsounD recording streams.
  10 module Sound.EsounD.Recorder
  11     ( Recorder
  12     , openRecorder
  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 recording data from the soundcard via ESD.
  34 data Recorder fr ch (r ∷ ★ → ★)
  35     = Recorder {
  36         reRate   ∷ !Int
  37       , reHandle ∷ !Handle
  38       , reCloseH ∷ !(FinalizerHandle r)
  39       }
  40
  41 instance Dup (Recorder fr ch) where
  42     dup re = do ch' ← dup (reCloseH re)
  43                 return re { reCloseH = ch' }
  44
  45 instance Stream (Recorder fr ch) where
  46     streamSampleRate = reRate
  47
  48 instance Frame fr ⇒ ReadableStream (Recorder fr Mono) (L.Vector fr) where
  49     readFrames re nFrames
  50         = liftIO $
  51           sanitizeIOError $
  52           fmap toLSV $
  53           S.hGet (reHandle re) nFrames
  54
  55 instance Frame fr ⇒ ReadableStream (Recorder fr Stereo) (L.Vector fr, L.Vector fr) where
  56     readFrames re nFrames
  57         = liftIO $
  58           sanitizeIOError $
  59           fmap (deinterleave ∘ toLSV) $
  60           S.hGet (reHandle re) nFrames
  61
  62 -- | Open an ESD handle for recording data from the soundcard via ESD.
  63 openRecorder ∷ ∀fr ch s pr.
  64                 ( Frame fr
  65                 , Channels ch
  66                 , MonadPeelIO pr
  67                 )
  68              ⇒ Int            -- ^ sample rate for the stream.
  69              → Maybe HostName -- ^ host to connect to.
  70              → Maybe String   -- ^ name used to identify this stream
  71                                --   to ESD (if any).
  72              → RegionT s pr (Recorder fr ch (RegionT s pr))
  73 openRecorder rate host name
  74     = block $
  75       do h  ← liftIO openSocket
  76          ch ← onExit $ sanitizeIOError $ closeSocket h
  77          return Recorder {
  78                       reRate   = rate
  79                     , reHandle = h
  80                     , reCloseH = ch
  81                     }
  82     where
  83       fmt ∷ C'esd_format_t
  84       fmt = frameFmt   ((⊥) ∷ fr) .|.
  85             channelFmt ((⊥) ∷ ch) .|.
  86             c'ESD_STREAM            .|.
  87             c'ESD_RECORD
  88
  89       openSocket ∷ IO Handle
  90       openSocket = withCStrOrNull host $ \hostPtr →
  91                    withCStrOrNull name $ \namePtr →
  92                        c'esd_record_stream
  93                        fmt
  94                        (fromIntegral rate)
  95                        hostPtr
  96                        namePtr
  97                        ≫= wrapSocket
  98                                ( printf "esd_record_stream(%s, %s, %s, %s) returned an error"
  99                                         (show fmt )
 100                                         (show rate)
 101                                         (show host)
 102                                         (show name)
 103                                )