Sound/EsounD/Player.hs

   1 {-# LANGUAGE
   2     FlexibleContexts
   3   , FlexibleInstances
   4   , KindSignatures
   5   , MultiParamTypeClasses
   6   , UnicodeSyntax
   7   , ScopedTypeVariables
   8   #-}
   9 -- | EsounD player streams.
  10 module Sound.EsounD.Player
  11     ( Player
  12     , openPlayer
  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.Lazy as L
  24 import Network
  25 import Prelude.Unicode
  26 import Sound.EsounD.Streams
  27 import Sound.EsounD.Internals
  28 import System.IO
  29 import System.IO.SaferFileHandles.Unsafe
  30 import Text.Printf
  31
  32 -- ^ An opaque ESD handle for playing a stream.
  33 data Player fr ch (r ∷ ★ → ★)
  34     = Player {
  35         plRate   ∷ !Int
  36       -- THINKME: We really want to use RegionalFileHandle but we
  37       -- can't, because safer-file-handles currently provides no ways
  38       -- to wrap ordinary handles into safer handles.
  39       , plHandle ∷ !Handle
  40       , plCloseH ∷ !(FinalizerHandle r)
  41       }
  42
  43 instance Dup (Player fr ch) where
  44     dup pl = do ch' ← dup (plCloseH pl)
  45                 return pl { plCloseH = ch' }
  46
  47 instance Stream (Player fr ch) where
  48     streamSampleRate = plRate
  49
  50 instance Frame fr ⇒ WritableStream (Player fr Mono) (L.Vector fr) where
  51     writeFrames pl v
  52         = liftIO $
  53           sanitizeIOError $
  54           do L.hPut (plHandle pl) v
  55              hFlush (plHandle pl)
  56
  57 instance Frame fr ⇒ WritableStream (Player fr Stereo) (L.Vector fr, L.Vector fr) where
  58     writeFrames pl (l, r)
  59         = liftIO $
  60           sanitizeIOError $
  61           do L.hPut (plHandle pl) (interleave l r)
  62              hFlush (plHandle pl)
  63
  64 -- | Open an ESD handle for playing a stream.
  65 openPlayer ∷ ∀fr ch s pr.
  66               ( Frame fr
  67               , Channels ch
  68               , MonadPeelIO pr
  69               )
  70            ⇒ Int            -- ^ sample rate for the stream.
  71            → Maybe HostName -- ^ host to connect to.
  72            → Maybe String   -- ^ name used to identify this stream to
  73                              --   ESD (if any).
  74            → RegionT s pr (Player fr ch (RegionT s pr))
  75 openPlayer rate host name
  76     = block $
  77       do h  ← liftIO openSocket
  78          ch ← onExit $ sanitizeIOError $ closeSocket h
  79          return Player {
  80                       plRate   = rate
  81                     , plHandle = h
  82                     , plCloseH = ch
  83                     }
  84     where
  85       fmt :: C'esd_format_t
  86       fmt = frameFmt   ((⊥) ∷ fr) .|.
  87             channelFmt ((⊥) ∷ ch) .|.
  88             c'ESD_STREAM            .|.
  89             c'ESD_PLAY
  90
  91       openSocket :: IO Handle
  92       openSocket = withCStrOrNull host $ \hostPtr →
  93                    withCStrOrNull name $ \namePtr →
  94                        c'esd_play_stream
  95                        fmt
  96                        (fromIntegral rate)
  97                        hostPtr
  98                        namePtr
  99                        ≫= wrapSocket
 100                                ( printf "esd_play_stream(%s, %s, %s, %s) returned an error"
 101                                         (show fmt )
 102                                         (show rate)
 103                                         (show host)
 104                                         (show name)
 105                                )