EsounD (empty) → 0.1
raw patch · 13 files changed
+1384/−0 lines, 13 filesdep +basedep +base-unicode-symbolsdep +bindings-EsounDsetup-changed
Dependencies added: base, base-unicode-symbols, bindings-EsounD, monad-peel, network, regions, safer-file-handles, storablevector, transformers, unix
Files
- COPYING +29/−0
- EsounD.cabal +68/−0
- Setup.hs +4/−0
- Sound/EsounD.hs +17/−0
- Sound/EsounD/Controller.hs +625/−0
- Sound/EsounD/Filter.hs +126/−0
- Sound/EsounD/Internals.hs +110/−0
- Sound/EsounD/Monitor.hs +103/−0
- Sound/EsounD/Player.hs +105/−0
- Sound/EsounD/Recorder.hs +103/−0
- Sound/EsounD/Streams.hs +35/−0
- Sound/EsounD/Types.hs +10/−0
- examples/EsdPlayerExample.hs +49/−0
+ COPYING view
@@ -0,0 +1,29 @@+<!-- -*- xml -*-++Haskell のパッケージ "EsounD" はパブリックドメインに在ります。+The Haskell package "EsounD" is in the public domain.++See http://creativecommons.org/licenses/publicdomain/++-->++<rdf:RDF xmlns="http://web.resource.org/cc/"+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">+ <Work rdf:about="http://cielonegro.org/EsounD.html">+ <dc:title>EsounD</dc:title>+ <dc:rights>+ <Agent>+ <dc:title>PHO</dc:title>+ </Agent>+ </dc:rights>+ <license rdf:resource="http://web.resource.org/cc/PublicDomain" />+ </Work>+ + <License rdf:about="http://web.resource.org/cc/PublicDomain">+ <permits rdf:resource="http://web.resource.org/cc/Reproduction" />+ <permits rdf:resource="http://web.resource.org/cc/Distribution" />+ <permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />+ </License>++</rdf:RDF>
+ EsounD.cabal view
@@ -0,0 +1,68 @@+Name: EsounD+Synopsis: Type-safe bindings to EsounD (ESD; Enlightened Sound Daemon)+Description:+ Type-safe bindings to EsounD: <http://www.tux.org/~ricdude/EsounD.html>+Version: 0.1+License: PublicDomain+License-File: COPYING+Author: PHO <pho at cielonegro dot org>+Maintainer: PHO <pho at cielonegro dot org>+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
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ Sound/EsounD.hs view
@@ -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
+ Sound/EsounD/Controller.hs view
@@ -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)
+ Sound/EsounD/Filter.hs view
@@ -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)+ )
+ Sound/EsounD/Internals.hs view
@@ -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
+ Sound/EsounD/Monitor.hs view
@@ -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)+ )
+ Sound/EsounD/Player.hs view
@@ -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)+ )
+ Sound/EsounD/Recorder.hs view
@@ -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)+ )
+ Sound/EsounD/Streams.hs view
@@ -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 ()
+ Sound/EsounD/Types.hs view
@@ -0,0 +1,10 @@+module Sound.EsounD.Types+ ( Frame++ , Channels+ , Mono+ , Stereo+ )+ where++import Sound.EsounD.Internals
+ examples/EsdPlayerExample.hs view
@@ -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)