diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,29 @@ + + + + + EsounD + + + PHO + + + + + + + + + + + + diff --git a/EsounD.cabal b/EsounD.cabal new file mode 100644 --- /dev/null +++ b/EsounD.cabal @@ -0,0 +1,68 @@ +Name: EsounD +Synopsis: Type-safe bindings to EsounD (ESD; Enlightened Sound Daemon) +Description: + Type-safe bindings to EsounD: +Version: 0.1 +License: PublicDomain +License-File: COPYING +Author: PHO +Maintainer: PHO +Stability: experimental +Homepage: http://cielonegro.org/EsounD.html +Category: Sound +Tested-With: GHC == 7.0.1 +Cabal-Version: >= 1.6 +Build-Type: Simple +Extra-Source-Files: + COPYING + +Source-Repository head + Type: git + Location: git://git.cielonegro.org/EsounD.git + +Flag build-examples + Description: Build example programs. + Default: False + +Library + Build-Depends: + base == 4.*, + base-unicode-symbols == 0.2.*, + bindings-EsounD == 0.1.*, + monad-peel == 0.1.*, + network == 2.3.*, + regions == 0.8.*, + safer-file-handles == 0.9.*, + storablevector == 0.2.*, + transformers == 0.2.*, + unix == 2.4.* + + Exposed-Modules: + Sound.EsounD + Sound.EsounD.Controller + Sound.EsounD.Filter + Sound.EsounD.Monitor + Sound.EsounD.Player + Sound.EsounD.Recorder + Sound.EsounD.Streams + Sound.EsounD.Types + + Other-Modules: + Sound.EsounD.Internals + + GHC-Options: + -Wall + +Executable hs-esd-player-example + if flag(build-examples) + Buildable: True + else + Buildable: False + + HS-Source-Dirs: + ., examples + + Main-Is: EsdPlayerExample.hs + + GHC-Options: + -Wall diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runghc + +import Distribution.Simple +main = defaultMain diff --git a/Sound/EsounD.hs b/Sound/EsounD.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD.hs @@ -0,0 +1,17 @@ +-- | Type-safe bindings to EsounD with monadic regions. +module Sound.EsounD + ( module Sound.EsounD.Types + , module Sound.EsounD.Streams + , module Sound.EsounD.Player + , module Sound.EsounD.Recorder + , module Sound.EsounD.Monitor + , module Sound.EsounD.Filter + ) + where + +import Sound.EsounD.Filter +import Sound.EsounD.Monitor +import Sound.EsounD.Player +import Sound.EsounD.Recorder +import Sound.EsounD.Streams +import Sound.EsounD.Types diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Controller.hs @@ -0,0 +1,625 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , UnicodeSyntax + , ScopedTypeVariables + #-} +-- | EsounD controlling handles. +module Sound.EsounD.Controller + ( Controller + , openController + + , lock + , unlock + + , standby + , resume + + , Sample + , SampleSource(..) + , playSample + , loopSample + , stopSample + , killSample + + , ServerInfo(..) + , FrameType(..) + , NumChannels(..) + , getServerInfo + + , PlayerInfo(..) + , SampleInfo(..) + , AllInfo(..) + , getAllInfo + + , setStreamPan + , setDefaultSamplePan + + , ServerState(..) + , getServerState + ) + 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.Char +import qualified Data.StorableVector.Lazy as L +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable +import Network +import Prelude hiding (pi) +import Prelude.Unicode +import Sound.EsounD.Internals +import System.IO.SaferFileHandles.Unsafe +import System.Posix.IO hiding (dup) +import System.Posix.Types +import Text.Printf + +-- ^ An opaque ESD handle for controlling ESD. +data Controller (r ∷ ★ → ★) + = Controller { + coSocket ∷ !Fd + , coCloseH ∷ !(FinalizerHandle r) + } + +instance Dup Controller where + dup co = do ch' ← dup (coCloseH co) + return co { coCloseH = ch' } + +-- | Open an ESD handle for controlling ESD. +openController ∷ MonadPeelIO pr + ⇒ Maybe HostName -- ^ host to connect to. + → RegionT s pr (Controller (RegionT s pr)) +openController host + = block $ + do s ← liftIO openSocket + ch ← onExit $ sanitizeIOError $ closeSocket' s + return Controller { + coSocket = s + , coCloseH = ch + } + where + openSocket ∷ IO Fd + openSocket = withCStrOrNull host $ \hostPtr → + c'esd_open_sound hostPtr + ≫= wrapSocket' + + wrapSocket' ∷ Monad m ⇒ CInt → m Fd + wrapSocket' (-1) = fail ( printf "esd_open_sound(%s) returned an error" + (show host) + ) + wrapSocket' fd = return $ Fd fd + + closeSocket' ∷ Fd → IO () + closeSocket' fd + = do _ ← c'esd_close $ fdToCInt fd + return () + +fdToCInt ∷ Fd → CInt +fdToCInt (Fd fd) = fromIntegral fd + +-- | Lock the ESD so that it won't accept connections from remote +-- hosts. +lock ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +lock co + = liftIO $ + sanitizeIOError $ + c'esd_lock (fdToCInt $ coSocket co) + ≫= failOnError "esd_lock(fd) returned an error" (≤ 0) + ≫ return () + +-- | Unlock the ESD so that it will accept connections from remote +-- hosts. +unlock ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +unlock co + = liftIO $ + sanitizeIOError $ + c'esd_unlock (fdToCInt $ coSocket co) + ≫= failOnError "esd_unlock(fd) returned an error" (≤ 0) + ≫ return () + +-- | Let ESD stop playing sounds and release its connection to the +-- audio device so that other processes may use it. +standby ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +standby co + = liftIO $ + sanitizeIOError $ + c'esd_standby (fdToCInt $ coSocket co) + ≫= failOnError "esd_standby(fd) returned an error" (≤ 0) + ≫ return () + +-- | Let ESD attempt to reconnect to the audio device and start +-- playing sounds again. +resume ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr () +resume co + = liftIO $ + sanitizeIOError $ + c'esd_resume (fdToCInt $ coSocket co) + ≫= failOnError "esd_resume(fd) returned an error" (≤ 0) + ≫ return () + +-- | An opaque ESD sample handle. +data Sample (r ∷ ★ → ★) + = Sample { + saID ∷ !CInt + , saCtrl ∷ !(Controller r) + , saCloseH ∷ !(FinalizerHandle r) + } + +instance Dup Sample where + dup sa = do ctrl' ← dup (saCtrl sa) + ch' ← dup (saCloseH sa) + return sa { + saCtrl = ctrl' + , saCloseH = ch' + } + +class (Frame fr, Channels ch) ⇒ SampleSource fr ch dvec where + -- | Cache a sample in the server. + cacheSample ∷ (MonadPeelIO pr) + ⇒ Controller (RegionT s pr) + → Maybe String -- ^ name used to identify this sample to + → Int -- ^ sample rate + → dvec -- ^ frames in deinterleaved vectors + → RegionT s pr (Sample (RegionT s pr)) + +instance Frame fr ⇒ SampleSource fr Mono (L.Vector fr) where + cacheSample co name rate v + = block $ + do sa ← createSample + co + name + rate + ((⊥) ∷ fr ) + ((⊥) ∷ Mono) + (L.length v) + _ ← liftIO $ + sanitizeIOError $ + do h ← fdToHandle $ coSocket co + _ ← L.hPut h v + (Fd fd) ← handleToFd h + c'esd_confirm_sample_cache fd + ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0) + return sa + +instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where + cacheSample co name rate (l, r) + = block $ + do sa ← createSample + co + name + rate + ((⊥) ∷ fr ) + ((⊥) ∷ Stereo) + (L.length l) + _ ← liftIO $ + sanitizeIOError $ + do h ← fdToHandle $ coSocket co + _ ← L.hPut h (interleave l r) + (Fd fd) ← handleToFd h + c'esd_confirm_sample_cache fd + ≫= failOnError "esd_confirm_sample_cache(fd) returned an error" (< 0) + return sa + +createSample ∷ ∀fr ch s pr. + ( Frame fr + , Channels ch + , MonadPeelIO pr + ) + ⇒ Controller (RegionT s pr) + → Maybe String + → Int + → fr + → ch + → Int + → RegionT s pr (Sample (RegionT s pr)) +createSample co name rate _ _ len + = block $ + do sid ← liftIO newCache + ch ← onExit $ sanitizeIOError $ deleteCache sid + return Sample { + saID = sid + , saCtrl = co + , saCloseH = ch + } + where + fmt ∷ C'esd_format_t + fmt = frameFmt ((⊥) ∷ fr) .|. + channelFmt ((⊥) ∷ ch) .|. + c'ESD_SAMPLE + + sampleSize ∷ Int + sampleSize = len + ⋅ frameSize ((⊥) ∷ fr) + ⋅ numChannels ((⊥) ∷ ch) + + newCache ∷ IO CInt + newCache = withCStrOrNull name $ \namePtr → + c'esd_sample_cache + (fdToCInt $ coSocket co) + fmt + (fromIntegral rate) + (fromIntegral sampleSize) + namePtr + ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error" + (show $ coSocket co) + (show fmt) + (show rate) + (show sampleSize) + (show name) + ) (< 0) + + deleteCache ∷ CInt → IO () + deleteCache sid + = c'esd_sample_free (fdToCInt $ coSocket co) sid + ≫= failOnError ( printf "esd_sample_free(%s) returned an error" + (show $ coSocket co) + (show sid) + ) (< 0) + ≫ return () + +-- | Play a cached sample once. +playSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +playSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_play (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_play(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Play a cached sample repeatedly. +loopSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +loopSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_loop (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_loop(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Stop a looping sample at end. +stopSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +stopSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_stop (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_stop(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +-- | Stop a playing sample immediately. +killSample ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Sample pr + → cr () +killSample sa + = liftIO $ + sanitizeIOError $ + c'esd_sample_kill (fdToCInt $ coSocket $ saCtrl sa) (saID sa) + ≫= failOnError ( printf "esd_sample_kill(%s, %s) returned an error" + (show $ coSocket $ saCtrl sa) + (show $ saID sa) + ) (≤ 0) + ≫ return () + +data FrameType + = Int8 | Int16 + deriving (Show, Eq) + +data NumChannels + = Mono | Stereo + deriving (Show, Eq) + +-- | A data type to represent the server info. +data ServerInfo + = ServerInfo { + serverVersion ∷ !Int + , serverFrameType ∷ !FrameType + , serverChannels ∷ !NumChannels + , serverSampleRate ∷ !Int + } + deriving (Show, Eq) + +extractServerInfo ∷ Ptr C'esd_server_info → IO ServerInfo +extractServerInfo siPtr + = do si ← peek siPtr + return ServerInfo { + serverVersion + = fromIntegral $ c'esd_server_info'version si + , serverFrameType + = extractFrameType $ c'esd_server_info'format si + , serverChannels + = extractNumChannels $ c'esd_server_info'format si + , serverSampleRate + = fromIntegral $ c'esd_server_info'rate si + } + +extractFrameType ∷ C'esd_format_t → FrameType +extractFrameType fmt + | fmt .&. c'ESD_BITS8 ≢ 0 = Int8 + | fmt .&. c'ESD_BITS16 ≢ 0 = Int16 + | otherwise = error ("Unknown format: " ⧺ show fmt) + +extractNumChannels ∷ C'esd_format_t → NumChannels +extractNumChannels fmt + | fmt .&. c'ESD_MONO ≢ 0 = Mono + | fmt .&. c'ESD_STEREO ≢ 0 = Stereo + | otherwise = error ("Unknown format: " ⧺ show fmt) + +-- | Retrieve server properties. +getServerInfo ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr ServerInfo +getServerInfo co + = liftIO $ + sanitizeIOError $ + bracket retrieve dispose extractServerInfo + where + retrieve ∷ IO (Ptr C'esd_server_info) + retrieve = c'esd_get_server_info (fdToCInt $ coSocket co) + ≫= failOnError "esd_get_server_info(fd) returned an error" (≡ nullPtr) + + dispose ∷ Ptr C'esd_server_info → IO () + dispose = c'esd_free_server_info + +-- | A data type to represent a player stream info. +data PlayerInfo + = PlayerInfo { + playerID ∷ !Int + , playerName ∷ !String + , playerSampleRate ∷ !Int + , playerFrameType ∷ !FrameType + , playerChannels ∷ !NumChannels + , playerLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1 + , playerRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1 + } + deriving (Show, Eq) + +extractPlayerInfo ∷ Ptr C'esd_player_info → IO [PlayerInfo] +extractPlayerInfo piPtr + | piPtr ≡ nullPtr = return [] + | otherwise + = do pi ← peek piPtr + let next = c'esd_player_info'next pi + pi' = PlayerInfo { + playerID + = fromIntegral $ c'esd_player_info'source_id pi + , playerName + = map (chr ∘ fromIntegral) $ c'esd_player_info'name pi + , playerSampleRate + = fromIntegral $ c'esd_player_info'rate pi + , playerFrameType + = extractFrameType $ c'esd_player_info'format pi + , playerChannels + = extractNumChannels $ c'esd_player_info'format pi + , playerLeftVolumeScale + = (fromIntegral $ c'esd_player_info'left_vol_scale pi) + ÷ + c'ESD_VOLUME_BASE + , playerRightVolumeScale + = (fromIntegral $ c'esd_player_info'right_vol_scale pi) + ÷ + c'ESD_VOLUME_BASE + } + pi'' ← extractPlayerInfo next + return (pi' : pi'') + +-- | A data type to represent a cached sample info. +data SampleInfo + = SampleInfo { + sampleID ∷ !Int + , sampleName ∷ !String + , sampleSampleRate ∷ !Int + , sampleFrameType ∷ !FrameType + , sampleChannels ∷ !NumChannels + , sampleLength ∷ !Int + , sampleLeftVolumeScale ∷ !Double -- ^ 0 <= scale <= 1 + , sampleRightVolumeScale ∷ !Double -- ^ 0 <= scale <= 1 + } + deriving (Show, Eq) + +extractSampleLength ∷ FrameType → NumChannels → Int → Int +extractSampleLength fr ch bufLen + = bufLen + `div` + case fr of + Int8 → 1 + Int16 → 2 + `div` + case ch of + Mono → 1 + Stereo → 2 + +extractSampleInfo ∷ Ptr C'esd_sample_info → IO [SampleInfo] +extractSampleInfo piPtr + | piPtr ≡ nullPtr = return [] + | otherwise + = do pi ← peek piPtr + let next = c'esd_sample_info'next pi + fr = extractFrameType $ c'esd_sample_info'format pi + ch = extractNumChannels $ c'esd_sample_info'format pi + pi' = SampleInfo { + sampleID + = fromIntegral $ c'esd_sample_info'sample_id pi + , sampleName + = map (chr ∘ fromIntegral) $ c'esd_sample_info'name pi + , sampleSampleRate + = fromIntegral $ c'esd_sample_info'rate pi + , sampleFrameType + = fr + , sampleChannels + = ch + , sampleLength + = extractSampleLength fr ch $ + fromIntegral $ c'esd_sample_info'length pi + , sampleLeftVolumeScale + = (fromIntegral $ c'esd_sample_info'left_vol_scale pi) + ÷ + c'ESD_VOLUME_BASE + , sampleRightVolumeScale + = (fromIntegral $ c'esd_sample_info'right_vol_scale pi) + ÷ + c'ESD_VOLUME_BASE + } + pi'' ← extractSampleInfo next + return (pi' : pi'') + +-- | A data type to represent all info in the ESD server. +data AllInfo + = AllInfo { + serverInfo ∷ !ServerInfo + , playersInfo ∷ ![PlayerInfo] + , samplesInfo ∷ ![SampleInfo] + } + deriving (Show, Eq) + +extractAllInfo ∷ Ptr C'esd_info → IO AllInfo +extractAllInfo eiPtr + = do ei ← peek eiPtr + srv ← extractServerInfo $ c'esd_info'server ei + pis ← extractPlayerInfo $ c'esd_info'player_list ei + sis ← extractSampleInfo $ c'esd_info'sample_list ei + return AllInfo { + serverInfo = srv + , playersInfo = pis + , samplesInfo = sis + } + +-- | Retrieve all info in the ESD server. +getAllInfo ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr AllInfo +getAllInfo co + = liftIO $ + sanitizeIOError $ + bracket retrieve dispose extractAllInfo + where + retrieve ∷ IO (Ptr C'esd_info) + retrieve = c'esd_get_all_info (fdToCInt $ coSocket co) + ≫= failOnError "esd_get_all_info(fd) returned an error" (≡ nullPtr) + + dispose ∷ Ptr C'esd_info → IO () + dispose = c'esd_free_all_info + +-- | Reset the volume panning for a stream. +setStreamPan ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → Int -- ^ Stream ID + → Double -- ^ left volume: 0 <= scale <= 1 + → Double -- ^ right volume: 0 <= scale <= 1 + → cr () +setStreamPan co sid l r + = liftIO $ + sanitizeIOError $ + c'esd_set_stream_pan (fdToCInt $ coSocket co) + (fromIntegral sid) + (floor $ l ⋅ c'ESD_VOLUME_BASE) + (floor $ r ⋅ c'ESD_VOLUME_BASE) + ≫= failOnError ( printf "esd_set_stream_pan(%s, %s, %s, %s) returned an error" + (show $ coSocket co) + (show sid) + (show l ) + (show r ) + ) (≤ 0) + ≫ return () + +-- | Reset the default volume panning for a sample. +setDefaultSamplePan ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → Int -- ^ Sample ID + → Double -- ^ left volume: 0 <= scale <= 1 + → Double -- ^ right volume: 0 <= scale <= 1 + → cr () +setDefaultSamplePan co sid l r + = liftIO $ + sanitizeIOError $ + c'esd_set_default_sample_pan (fdToCInt $ coSocket co) + (fromIntegral sid) + (floor $ l ⋅ c'ESD_VOLUME_BASE) + (floor $ r ⋅ c'ESD_VOLUME_BASE) + ≫= failOnError ( printf "esd_set_default_sample_pan(%s, %s, %s, %s) returned an error" + (show $ coSocket co) + (show sid) + (show l ) + (show r ) + ) (≤ 0) + ≫ return () + +-- | A data type to represent server's state. +data ServerState + = Standby + | AutoStandby + | Running + deriving (Eq, Show) + +extractServerState ∷ C'esd_standby_mode_t → ServerState +extractServerState st + | st ≡ c'ESM_ON_STANDBY = Standby + | st ≡ c'ESM_ON_AUTOSTANDBY = AutoStandby + | st ≡ c'ESM_RUNNING = Running + | otherwise = error ("unknown state: " ⧺ show st) + +-- | Retrieve the server's state. +getServerState ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Controller pr + → cr ServerState +getServerState co + = liftIO $ + sanitizeIOError $ + fmap extractServerState $ + c'esd_get_standby_mode (fdToCInt $ coSocket co) + ≫= failOnError "esd_get_standby_mode(fd) returned an error" (≡ c'ESM_ERROR) diff --git a/Sound/EsounD/Filter.hs b/Sound/EsounD/Filter.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Filter.hs @@ -0,0 +1,126 @@ +{-# 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 $ + do L.hPut (fiHandle fi) v + hFlush (fiHandle fi) + +instance Frame fr ⇒ WritableStream (Filter fr Stereo) (L.Vector fr, L.Vector fr) where + writeFrames fi (l, r) + = liftIO $ + sanitizeIOError $ + do L.hPut (fiHandle fi) (interleave l r) + hFlush (fiHandle fi) + +-- | 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) + ) diff --git a/Sound/EsounD/Internals.hs b/Sound/EsounD/Internals.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Internals.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE + EmptyDataDecls + , FlexibleInstances + , MultiParamTypeClasses + , UnicodeSyntax + #-} +module Sound.EsounD.Internals + ( Frame(..) + + , Channels(..) + , Mono + , Stereo + , interleave + , deinterleave + + , toLSV + , wrapSocket + , closeSocket + , withCStrOrNull + , failOnError + ) + where +import Bindings.EsounD +import Data.Int +import Data.StorableVector as S +import Data.StorableVector.Lazy as L +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable +import System.IO +import System.Posix.IO +import System.Posix.Types + +class Storable fr ⇒ Frame fr where + frameFmt ∷ fr → C'esd_format_t + frameSize ∷ fr → Int + +instance Frame Int8 where + frameFmt _ = c'ESD_BITS8 + frameSize _ = 1 + +instance Frame Int16 where + frameFmt _ = c'ESD_BITS16 + frameSize _ = 2 + +class Channels ch where + channelFmt ∷ ch → C'esd_format_t + numChannels ∷ ch → Int + +-- Mono +data Mono + +instance Channels Mono where + channelFmt _ = c'ESD_MONO + numChannels _ = 1 + +-- Stereo +data Stereo + +instance Channels Stereo where + channelFmt _ = c'ESD_STEREO + numChannels _ = 2 + +{-# INLINE interleave #-} +interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α +interleave l r + -- THINKME: consider using storablevector-streamfusion + = let Just (lFr, l') = L.viewL l + Just (rFr, r') = L.viewL r + lr' = interleave l' r' + in + L.cons lFr (L.cons rFr lr') + +{-# INLINE deinterleave #-} +deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α) +deinterleave v + -- THINKME: consider using storablevector-streamfusion + = let (lr, v') = L.splitAt 2 v + in + if L.null lr then + (L.empty, L.empty) + else + let Just (lFr, r) = L.viewL lr + Just (rFr, _) = L.viewL r + (l', r') = deinterleave v' + in + (L.cons lFr l', L.cons rFr r') + +-- Utility functions +toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α +toLSV v = L.fromChunks [v] + +wrapSocket ∷ String → CInt → IO Handle +wrapSocket e (-1) = fail e +wrapSocket _ fd = fdToHandle (Fd fd) + +closeSocket ∷ Handle → IO () +closeSocket h = do (Fd fd) ← handleToFd h + _ ← c'esd_close (fromIntegral fd) + return () + +withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a +withCStrOrNull Nothing f = f nullPtr +withCStrOrNull (Just s) f = withCString s f + +failOnError ∷ Monad m ⇒ String → (α → Bool) → α → m α +failOnError msg isErr rv + | isErr rv = fail msg + | otherwise = return rv diff --git a/Sound/EsounD/Monitor.hs b/Sound/EsounD/Monitor.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Monitor.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , UnicodeSyntax + , ScopedTypeVariables + #-} +-- | EsounD monitoring streams. +module Sound.EsounD.Monitor + ( Monitor + , openMonitor + ) + 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 monitoring the output from the ESD. +data Monitor fr ch (r ∷ ★ → ★) + = Monitor { + moRate ∷ !Int + , moHandle ∷ !Handle + , moCloseH ∷ !(FinalizerHandle r) + } + +instance Dup (Monitor fr ch) where + dup mo = do ch' ← dup (moCloseH mo) + return mo { moCloseH = ch' } + +instance Stream (Monitor fr ch) where + streamSampleRate = moRate + +instance Frame fr ⇒ ReadableStream (Monitor fr Mono) (L.Vector fr) where + readFrames mo nFrames + = liftIO $ + sanitizeIOError $ + fmap toLSV $ + S.hGet (moHandle mo) nFrames + +instance Frame fr ⇒ ReadableStream (Monitor fr Stereo) (L.Vector fr, L.Vector fr) where + readFrames mo nFrames + = liftIO $ + sanitizeIOError $ + fmap (deinterleave ∘ toLSV) $ + S.hGet (moHandle mo) nFrames + +-- | Open an ESD handle for monitoring the output from the ESD. +openMonitor ∷ ∀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 (Monitor fr ch (RegionT s pr)) +openMonitor rate host name + = block $ + do h ← liftIO openSocket + ch ← onExit $ sanitizeIOError $ closeSocket h + return Monitor { + moRate = rate + , moHandle = h + , moCloseH = ch + } + where + fmt ∷ C'esd_format_t + fmt = frameFmt ((⊥) ∷ fr) .|. + channelFmt ((⊥) ∷ ch) .|. + c'ESD_STREAM .|. + c'ESD_MONITOR + + openSocket ∷ IO Handle + openSocket = withCStrOrNull host $ \hostPtr → + withCStrOrNull name $ \namePtr → + c'esd_monitor_stream + fmt + (fromIntegral rate) + hostPtr + namePtr + ≫= wrapSocket + ( printf "esd_monitor_stream(%s, %s, %s, %s) returned an error" + (show fmt ) + (show rate) + (show host) + (show name) + ) diff --git a/Sound/EsounD/Player.hs b/Sound/EsounD/Player.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Player.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , UnicodeSyntax + , ScopedTypeVariables + #-} +-- | EsounD player streams. +module Sound.EsounD.Player + ( Player + , openPlayer + ) + 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.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 playing a stream. +data Player fr ch (r ∷ ★ → ★) + = Player { + plRate ∷ !Int + -- THINKME: We really want to use RegionalFileHandle but we + -- can't, because safer-file-handles currently provides no ways + -- to wrap ordinary handles into safer handles. + , plHandle ∷ !Handle + , plCloseH ∷ !(FinalizerHandle r) + } + +instance Dup (Player fr ch) where + dup pl = do ch' ← dup (plCloseH pl) + return pl { plCloseH = ch' } + +instance Stream (Player fr ch) where + streamSampleRate = plRate + +instance Frame fr ⇒ WritableStream (Player fr Mono) (L.Vector fr) where + writeFrames pl v + = liftIO $ + sanitizeIOError $ + do L.hPut (plHandle pl) v + hFlush (plHandle pl) + +instance Frame fr ⇒ WritableStream (Player fr Stereo) (L.Vector fr, L.Vector fr) where + writeFrames pl (l, r) + = liftIO $ + sanitizeIOError $ + do L.hPut (plHandle pl) (interleave l r) + hFlush (plHandle pl) + +-- | Open an ESD handle for playing a stream. +openPlayer ∷ ∀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 (Player fr ch (RegionT s pr)) +openPlayer rate host name + = block $ + do h ← liftIO openSocket + ch ← onExit $ sanitizeIOError $ closeSocket h + return Player { + plRate = rate + , plHandle = h + , plCloseH = ch + } + where + fmt :: C'esd_format_t + fmt = frameFmt ((⊥) ∷ fr) .|. + channelFmt ((⊥) ∷ ch) .|. + c'ESD_STREAM .|. + c'ESD_PLAY + + openSocket :: IO Handle + openSocket = withCStrOrNull host $ \hostPtr → + withCStrOrNull name $ \namePtr → + c'esd_play_stream + fmt + (fromIntegral rate) + hostPtr + namePtr + ≫= wrapSocket + ( printf "esd_play_stream(%s, %s, %s, %s) returned an error" + (show fmt ) + (show rate) + (show host) + (show name) + ) diff --git a/Sound/EsounD/Recorder.hs b/Sound/EsounD/Recorder.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Recorder.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE + FlexibleContexts + , FlexibleInstances + , KindSignatures + , MultiParamTypeClasses + , UnicodeSyntax + , ScopedTypeVariables + #-} +-- | EsounD recording streams. +module Sound.EsounD.Recorder + ( Recorder + , openRecorder + ) + 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 recording data from the soundcard via ESD. +data Recorder fr ch (r ∷ ★ → ★) + = Recorder { + reRate ∷ !Int + , reHandle ∷ !Handle + , reCloseH ∷ !(FinalizerHandle r) + } + +instance Dup (Recorder fr ch) where + dup re = do ch' ← dup (reCloseH re) + return re { reCloseH = ch' } + +instance Stream (Recorder fr ch) where + streamSampleRate = reRate + +instance Frame fr ⇒ ReadableStream (Recorder fr Mono) (L.Vector fr) where + readFrames re nFrames + = liftIO $ + sanitizeIOError $ + fmap toLSV $ + S.hGet (reHandle re) nFrames + +instance Frame fr ⇒ ReadableStream (Recorder fr Stereo) (L.Vector fr, L.Vector fr) where + readFrames re nFrames + = liftIO $ + sanitizeIOError $ + fmap (deinterleave ∘ toLSV) $ + S.hGet (reHandle re) nFrames + +-- | Open an ESD handle for recording data from the soundcard via ESD. +openRecorder ∷ ∀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 (Recorder fr ch (RegionT s pr)) +openRecorder rate host name + = block $ + do h ← liftIO openSocket + ch ← onExit $ sanitizeIOError $ closeSocket h + return Recorder { + reRate = rate + , reHandle = h + , reCloseH = ch + } + where + fmt ∷ C'esd_format_t + fmt = frameFmt ((⊥) ∷ fr) .|. + channelFmt ((⊥) ∷ ch) .|. + c'ESD_STREAM .|. + c'ESD_RECORD + + openSocket ∷ IO Handle + openSocket = withCStrOrNull host $ \hostPtr → + withCStrOrNull name $ \namePtr → + c'esd_record_stream + fmt + (fromIntegral rate) + hostPtr + namePtr + ≫= wrapSocket + ( printf "esd_record_stream(%s, %s, %s, %s) returned an error" + (show fmt ) + (show rate) + (show host) + (show name) + ) diff --git a/Sound/EsounD/Streams.hs b/Sound/EsounD/Streams.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Streams.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE + UnicodeSyntax + , MultiParamTypeClasses + #-} +-- | EsounD stream I/O +module Sound.EsounD.Streams + ( Stream(..) + , ReadableStream(..) + , WritableStream(..) + ) + where +import Control.Monad.IO.Class +import Control.Monad.Trans.Region + +-- | ESD streams. +class Stream s where + streamSampleRate ∷ s pr → Int + +-- | ESD streams which behave as sources. +class Stream rs ⇒ ReadableStream rs dvec where + readFrames ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ rs pr + → Int -- ^ number of frames to read + → cr dvec -- ^ frames in deinterleaved vectors + +-- | ESD streams which behave as sinks. +class Stream ws ⇒ WritableStream ws dvec where + writeFrames ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ ws pr + → dvec -- ^ frames in deinterleaved vectors + → cr () diff --git a/Sound/EsounD/Types.hs b/Sound/EsounD/Types.hs new file mode 100644 --- /dev/null +++ b/Sound/EsounD/Types.hs @@ -0,0 +1,10 @@ +module Sound.EsounD.Types + ( Frame + + , Channels + , Mono + , Stereo + ) + where + +import Sound.EsounD.Internals diff --git a/examples/EsdPlayerExample.hs b/examples/EsdPlayerExample.hs new file mode 100644 --- /dev/null +++ b/examples/EsdPlayerExample.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE + UnicodeSyntax + #-} +module Main where +import Control.Monad.IO.Class +import Control.Monad.Trans.Region +import Data.Int +import qualified Data.StorableVector.Lazy as L +import Prelude.Unicode +import Sound.EsounD + +main ∷ IO () +main = runRegionT $ + do pl ← openPlayer 44100 Nothing Nothing + -- Let's play an 'A' note for 1 sec. + playMono16Sine pl 44100 1 440 + +playMono16Sine ∷ ( AncestorRegion pr cr + , MonadIO cr + ) + ⇒ Player Int16 Mono pr + → Int + → Double + → Double + → cr () +playMono16Sine pl sampleFreq sec noteFreq + = writeFrames pl buffer + where + buffer ∷ L.Vector Int16 + buffer = L.pack L.defaultChunkSize frames + + frames ∷ [Int16] + frames = let nFrames = round $ sec ⋅ realToFrac sampleFreq + in + map calcFrame [0 .. nFrames - 1] + + calcFrame ∷ Int → Int16 + calcFrame n = let frame = calcFrame' n + in + -- -1.0 ≤ frame ≤ 1.0 + floor $ fromIntegral ((maxBound ∷ Int16) - 1) ⋅ frame + + calcFrame' ∷ Int → Double + calcFrame' n + = sin $ + 2 + ⋅ π + ⋅ noteFreq + ⋅ (realToFrac n ÷ realToFrac sampleFreq)