+-- | 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)