diff --git a/Sound/ALSA/Mixer.hs b/Sound/ALSA/Mixer.hs --- a/Sound/ALSA/Mixer.hs +++ b/Sound/ALSA/Mixer.hs @@ -25,7 +25,7 @@ -- * Functions -- ** Mixers , controls - , getMixerByName + , withMixer -- ** Controls , getControlByName , common @@ -152,7 +152,7 @@ hasPlaySwJ <- hasPlaybackSwitchJoined se hasCaptSw <- hasCaptureSwitch se hasCaptSwJ <- hasCaptureSwitchJoined se - return $ if hasComSw + return $ if hasComSw then Left $ if hasPlaySwJ then comJoinedSwitch pChans else comPerChannelSwitch pChans @@ -279,13 +279,11 @@ , volume = v } --- | Get the named 'Control', if it exists, from the named 'Mixer'. Will --- throw an exception if the named 'Mixer' does not exist. -getControlByName :: String -- ^ Mixer name +-- | Get the named 'Control', if it exists, from the named 'Mixer'. +getControlByName :: Mixer -- ^ Mixer -> String -- ^ Control name -> IO (Maybe Control) -getControlByName mixerName controlName = do - mix <- getMixerByName mixerName +getControlByName mix controlName = do cs <- controls mix return $ lookup controlName $ zip (map name cs) cs @@ -294,13 +292,14 @@ The example function reads the volume and increases it by the value supplied. > changeVolumeBy :: Integer -> IO () -> changeVolumeBy i = do -> Just control <- getControlByName "default" "Master" -> let Just playbackVolume = playback $ volume control -> (min, max) <- getRange playbackVolume -> Just vol <- getChannel FrontLeft $ value $ playbackVolume -> when ((i > 0 && vol < max) || (i < 0 && vol > min)) -> $ setChannel FrontLeft (value $ playbackVolume) $ vol + i +> changeVolumeBy i = +> withMixer "default" $ \mixer -> +> do Just control <- getControlByName mixer "Master" +> let Just playbackVolume = playback $ volume control +> (min, max) <- getRange playbackVolume +> Just vol <- getChannel FrontLeft $ value $ playbackVolume +> when ((i > 0 && vol < max) || (i < 0 && vol > min)) +> $ setChannel FrontLeft (value $ playbackVolume) $ vol + i -} @@ -309,10 +308,11 @@ The example function reads the value of the switch and toggles it. > toggleMute :: IO () -> toggleMute = do -> Just control <- getControlByName "default" "Master" -> let Just playbackSwitch = playback $ switch control -> Just sw <- getChannel FrontLeft playbackSwitch -> setChannel FrontLeft playbackSwitch $ not sw +> toggleMute = +> withMixer "default" $ \mixer -> +> do Just control <- getControlByName "default" "Master" +> let Just playbackSwitch = playback $ switch control +> Just sw <- getChannel FrontLeft playbackSwitch +> setChannel FrontLeft playbackSwitch $ not sw -} diff --git a/Sound/ALSA/Mixer/Internal.chs b/Sound/ALSA/Mixer/Internal.chs --- a/Sound/ALSA/Mixer/Internal.chs +++ b/Sound/ALSA/Mixer/Internal.chs @@ -6,7 +6,7 @@ , Channel(..) , allChannels , elements - , getMixerByName + , withMixer , isPlaybackMono , isCaptureMono , hasPlaybackChannel @@ -49,16 +49,19 @@ , getIndex ) where +import Control.Monad (liftM, when) +import Control.Exception (bracket) import Foreign import Foreign.C.Error ( eNOENT ) import Foreign.C.String import Foreign.C.Types import Sound.ALSA.Exception ( checkResult_, throw ) +import System.Posix.Process (getProcessID) #include "alsa/asoundlib.h" {#context lib = "asoundlib" #} -{#pointer *snd_mixer_t as Mixer foreign#} +{#pointer *snd_mixer_t as Mixer newtype#} {#pointer *snd_mixer_elem_t as Element#} {#pointer *snd_mixer_selem_id_t as SimpleElementId foreign#} type SimpleElement = (Mixer, Element) @@ -84,29 +87,26 @@ -- open -- -------------------------------------------------------------------- -{#fun snd_mixer_open as open - { mallocMixer- `Mixer' peekMixer* - , modeZero- `Int' fromIntegral- } -> `Int' checkOpen*- #} +foreign import ccall safe "alsa/asoundlib.h snd_mixer_open" + open_ :: Ptr (Ptr Mixer) -> CInt -> IO CInt -mallocMixer f = do - pm <- malloc - f pm +open :: IO Mixer +open = withPtr $ \ppm -> + do open_ ppm (fromIntegral 0) >>= checkResult_ "snd_mixer_open" + liftM Mixer $ peek ppm -modeZero f = f $ fromIntegral 0 -checkOpen = checkResult_ "snd_mixer_open" -peekMixer pm = peek pm >>= newForeignPtr snd_mixer_close +withPtr :: (Ptr (Ptr a) -> IO a) -> IO a +withPtr = bracket malloc free --- Static address import for finalizer. Suppression of the return type may --- not be a good idea, but the workaround involves lots of C. -foreign import ccall "alsa/asoundlib.h &snd_mixer_close" - snd_mixer_close :: FunPtr (Ptr () -> IO ()) +foreign import ccall "alsa/asoundlib.h snd_mixer_close" + freeMixer :: Ptr Mixer -> IO () ----------------------------------------------------------------------- -- attach -- -------------------------------------------------------------------- {#fun snd_mixer_attach as attach - { withForeignPtr* `Mixer', `String' } -> `Int' checkAttach*- #} + { id `Mixer', `String' } -> `Int' checkAttach*- #} checkAttach = checkResult_ "snd_mixer_attach" @@ -115,12 +115,12 @@ -- -------------------------------------------------------------------- {#fun snd_mixer_load as ^ - { withForeignPtr* `Mixer' } -> `Int' checkSndMixerLoad*- #} + { id `Mixer' } -> `Int' checkSndMixerLoad*- #} checkSndMixerLoad = checkResult_ "snd_mixer_load" {#fun snd_mixer_selem_register as ^ - { withForeignPtr* `Mixer' + { id `Mixer' , id `Ptr ()' , id `Ptr (Ptr ())' } -> `Int' checkSndMixerSelemRegister*- #} @@ -157,10 +157,10 @@ -- -------------------------------------------------------------------- {#fun snd_mixer_first_elem as ^ - { withForeignPtr* `Mixer' } -> `Element' id #} + { id `Mixer' } -> `Element' id #} {#fun snd_mixer_last_elem as ^ - { withForeignPtr* `Mixer' } -> `Element' id #} + { id `Mixer' } -> `Element' id #} {#fun snd_mixer_elem_next as ^ { id `Element' } -> `Element' id #} @@ -181,7 +181,7 @@ -- -------------------------------------------------------------------- {#fun snd_mixer_find_selem as ^ - { withForeignPtr* `Mixer' + { id `Mixer' , withForeignPtr* `SimpleElementId' } -> `Element' id #} simpleElement :: Mixer -> Element -> IO (SimpleElementId, SimpleElement) @@ -210,14 +210,19 @@ -- getMixerByName -- -------------------------------------------------------------------- --- | Returns the named 'Mixer'. Will throw an exception if the named mixer --- cannot be found. A mixer named \"default\" should always exist. -getMixerByName :: String -> IO Mixer -getMixerByName name = do - mix <- open - attach mix name - load mix - return mix +-- | Perform an 'IO' action with the named mixer. An exception will be +-- thrown if the named mixer cannot be found. A mixer named \"default\" +-- should always exist. +withMixer :: String -> (Mixer -> IO a) -> IO a +withMixer name f = bracket (do m <- open + attach m name + load m + pid <- getProcessID + return (pid, m)) + (\(creatorPID, Mixer m) -> + do myPID <- getProcessID + when (myPID == creatorPID) $ freeMixer m) + (f . snd) ----------------------------------------------------------------------- -- utilities @@ -228,14 +233,11 @@ cFromBool = fromBool withSimpleElement :: SimpleElement -> (Element -> IO a) -> IO a -withSimpleElement (m, s) f = do - r <- f s - touchForeignPtr m - return r +withSimpleElement (m, s) f = f s channelToC = toEnum . fromEnum -cToIntegral = (>>= return . fromIntegral) . peek +cToIntegral = (>>= return . fromIntegral) . peek cFromIntegral :: Integer -> (Ptr CLong -> IO a) -> IO a cFromIntegral = with . fromIntegral diff --git a/alsa-mixer.cabal b/alsa-mixer.cabal --- a/alsa-mixer.cabal +++ b/alsa-mixer.cabal @@ -1,5 +1,5 @@ Name: alsa-mixer -Version: 0.1.2 +Version: 0.2.0 Synopsis: Bindings to the ALSA simple mixer API. Description: This package provides bindings to the ALSA simple mixer API. License: BSD3 @@ -12,8 +12,8 @@ Cabal-version: >=1.6 Source-repository head - Type: darcs - Location: http://community.haskell.org/~ttuegel/alsa-mixer + Type: git + Location: https://github.com/ttuegel/alsa-mixer.git Library Exposed-modules: Sound.ALSA.Mixer @@ -21,4 +21,5 @@ Build-tools: c2hs Extra-libraries: asound Build-depends: base == 4.*, - alsa-core == 0.5.* + alsa-core == 0.5.*, + unix == 2.6.*