X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Sound%2FEsounD%2FController.hs;h=c9b064982bb6712861c572c0a9d98927b1c171d0;hb=171fe51f202bdec2006d43a242659ea0e3a8c99f;hp=aa9dabae40c9db883635d3049e37937cb20187b9;hpb=080d77f8aece1d14f71f6fd337f0cda9cdf7d740;p=EsounD.git diff --git a/Sound/EsounD/Controller.hs b/Sound/EsounD/Controller.hs index aa9daba..c9b0649 100644 --- a/Sound/EsounD/Controller.hs +++ b/Sound/EsounD/Controller.hs @@ -23,6 +23,22 @@ module Sound.EsounD.Controller , loopSample , stopSample , killSample + + , ServerInfo(..) + , FrameType(..) + , NumChannels(..) + , getServerInfo + + , PlayerInfo(..) + , SampleInfo(..) + , AllInfo(..) + , getAllInfo + + , setStreamPan + , setDefaultSamplePan + + , ServerState(..) + , getServerState ) where import Bindings.EsounD @@ -33,9 +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 @@ -193,8 +213,8 @@ instance Frame fr ⇒ SampleSource fr Stereo (L.Vector fr, L.Vector fr) where co name rate - ((⊥) ∷ fr ) - ((⊥) ∷ Mono) + ((⊥) ∷ fr ) + ((⊥) ∷ Stereo) (L.length l) _ ← liftIO $ sanitizeIOError $ @@ -217,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 @@ -232,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) @@ -320,3 +345,281 @@ killSample 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)