, FrameType(..)
, NumChannels(..)
, getServerInfo
+
+ , PlayerInfo(..)
+ , SampleInfo(..)
+ , AllInfo(..)
+ , getAllInfo
+
+ , setStreamPan
+ , setDefaultSamplePan
+
+ , ServerState
+ , getServerState
)
where
import Bindings.EsounD
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
→ 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
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)
) (≤ 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
}
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
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)
projects / EsounD.git / commitdiff