From dddadcc3746636546f4010e37aafef211d75cb0d Mon Sep 17 00:00:00 2001 From: PHO Date: Sun, 2 Jan 2011 17:26:18 +0900 Subject: [PATCH] more controls --- Sound/EsounD/Controller.hs | 307 ++++++++++++++++++++++++++++++++----- Sound/EsounD/Internals.hs | 20 ++- 2 files changed, 283 insertions(+), 44 deletions(-) diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs index 433c032..c2d206c 100644 --- a/Sound/EsounD/Controller.hs +++ b/Sound/EsounD/Controller.hs @@ -28,6 +28,17 @@ module Sound.EsounD.Controller , FrameType(..) , NumChannels(..) , getServerInfo + + , PlayerInfo(..) + , SampleInfo(..) + , AllInfo(..) + , getAllInfo + + , setStreamPan + , setDefaultSamplePan + + , ServerState + , getServerState ) where import Bindings.EsounD @@ -38,11 +49,13 @@ 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 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 @@ -224,7 +237,7 @@ createSample ∷ ∀fr ch s pr. → ch → Int → RegionT s pr (Sample (RegionT s pr)) -createSample co name rate _ _ size +createSample co name rate _ _ len = block $ do sid ← liftIO newCache ch ← onExit $ sanitizeIOError $ deleteCache sid @@ -239,19 +252,24 @@ createSample co name rate _ _ size 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 size) + (fromIntegral sampleSize) namePtr ≫= failOnError ( printf "esd_sample_cache(%s, %s, %s, %s, %s) returned an error" (show $ coSocket co) (show fmt) (show rate) - (show size) + (show sampleSize) (show name) ) (< 0) @@ -328,7 +346,13 @@ killSample 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 @@ -340,13 +364,31 @@ data ServerInfo } deriving (Show, Eq) -data FrameType - = Int8 | Int16 - 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 + } -data NumChannels - = Mono | Stereo - deriving (Show, Eq) +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 @@ -357,36 +399,227 @@ getServerInfo ∷ ( AncestorRegion pr cr getServerInfo co = liftIO $ sanitizeIOError $ - bracket retrieve dispose extract + bracket retrieve dispose extractServerInfo where retrieve ∷ IO (Ptr C'esd_server_info) - retrieve = do siPtr ← c'esd_get_server_info (fdToCInt $ coSocket co) - if siPtr ≡ nullPtr then - fail "esd_resume(fd) returned an error" - else - return siPtr + 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 - extract ∷ Ptr C'esd_server_info → IO ServerInfo - extract siPtr - = do si ← peek siPtr - return ServerInfo { - serverVersion - = fromIntegral $ - c'esd_server_info'version si - , serverFrameType - = case c'esd_server_info'format si of - fmt | fmt .&. c'ESD_BITS8 ≡ 1 → Int8 - | fmt .&. c'ESD_BITS16 ≡ 1 → Int16 - | otherwise → error ("Unknown format: " ⧺ show fmt) - , serverChannels - = case c'esd_server_info'format si of - fmt | fmt .&. c'ESD_MONO ≡ 1 → Mono - | fmt .&. c'ESD_STEREO ≡ 1 → Stereo - | otherwise → error ("Unknown format: " ⧺ show fmt) - , serverSampleRate - = fromIntegral $ - c'esd_server_info'rate si - } +-- | 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/Internals.hs b/Sound/EsounD/Internals.hs index 735ce63..997899a 100644 --- a/Sound/EsounD/Internals.hs +++ b/Sound/EsounD/Internals.hs @@ -33,28 +33,34 @@ import System.Posix.IO import System.Posix.Types class Storable fr ⇒ Frame fr where - frameFmt ∷ fr → C'esd_format_t + frameFmt ∷ fr → C'esd_format_t + frameSize ∷ fr → Int instance Frame Int8 where - frameFmt _ = c'ESD_BITS8 + frameFmt _ = c'ESD_BITS8 + frameSize _ = 1 instance Frame Int16 where - frameFmt _ = c'ESD_BITS16 + frameFmt _ = c'ESD_BITS16 + frameSize _ = 2 class Channels ch where - channelFmt ∷ ch → C'esd_format_t + channelFmt ∷ ch → C'esd_format_t + numChannels ∷ ch → Int -- Mono data Mono instance Channels Mono where - channelFmt _ = c'ESD_MONO + channelFmt _ = c'ESD_MONO + numChannels _ = 1 -- Stereo data Stereo instance Channels Stereo where - channelFmt _ = c'ESD_STEREO + channelFmt _ = c'ESD_STEREO + numChannels _ = 2 {-# INLINE interleave #-} interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α @@ -98,7 +104,7 @@ withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a withCStrOrNull Nothing f = f nullPtr withCStrOrNull (Just s) f = withCString s f -failOnError ∷ Monad m ⇒ String → (CInt → Bool) → CInt → m CInt +failOnError ∷ Monad m ⇒ String → (α → Bool) → α → m α failOnError msg isErr rv | isErr rv = fail msg | otherwise = return rv -- 2.40.0