{-# LANGUAGE CPP #-}
-- boilerplate {{{
----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.Volume
-- Copyright    : (c) daniel@wagner-home.com
-- License      : BSD3-style (see LICENSE)
--
-- Maintainer   : daniel@wagner-home.com
-- Stability    : unstable
-- Portability  : unportable
--
-- A minimal interface to the \"amixer\" command-line utility.
--
----------------------------------------------------------------------------
module XMonad.Actions.Volume (
    -- * Usage
    -- $usage

    -- * Common functions
    toggleMute,
    raiseVolume,
    lowerVolume,

    -- * Low-level interface
    getVolume,
    getMute,
    getVolumeMute,
    setVolume,
    setMute,
    setVolumeMute,
    modifyVolume,
    modifyMute,
    modifyVolumeMute,

    -- * Variants that take a list of channels
    defaultChannels,

    toggleMuteChannels,
    raiseVolumeChannels,
    lowerVolumeChannels,
    getVolumeChannels,
    getMuteChannels,
    getVolumeMuteChannels,
    setVolumeChannels,
    setMuteChannels,
    setVolumeMuteChannels,
    modifyVolumeChannels,
    modifyMuteChannels,
    modifyVolumeMuteChannels,

    defaultOSDOpts,
    osdCat
) where

import Control.Monad
import Control.Monad.Trans
import Data.Maybe
import XMonad.Core
import Sound.ALSA.Mixer
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif

{- $usage
You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:

> import XMonad.Actions.Volume

then add appropriate keybinds to adjust the volume; for example:

> , ((modMask x, xK_F8 ), lowerVolume 3 >> return ())
> , ((modMask x, xK_F9 ), raiseVolume 3 >> return ())
> , ((modMask x, xK_F10), toggleMute    >> return ())

For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".
-}
-- }}}
-- API {{{
-- | Toggle mutedness on the default channels.  Returns 'True' when this attempts to mute the speakers and 'False' when this attempts to unmute the speakers.
toggleMute          :: MonadIO m => m Bool
-- | Raise the volume on the default channels the given number of percentage points.  Returns the volume it attempts to set.
raiseVolume         :: MonadIO m => Double -> m Double
-- | Lower the volume on the default channels the given number of percentage points.  Returns the volume it attempts to set.
lowerVolume         :: MonadIO m => Double -> m Double
-- | Get the geometric mean of the volumes on the default channels.
getVolume           :: MonadIO m => m Double
-- | Get the mutedness of the default channels.  Returns 'True' if any of the channels are muted, and 'False' otherwise.
getMute             :: MonadIO m => m Bool
-- | Get both the volume and the mutedness of the default channels.
getVolumeMute       :: MonadIO m => m (Double, Bool)
-- | Attempt to set the default channels to a volume given in percentage of maximum.
setVolume           :: MonadIO m => Double         -> m ()
-- | Attempt to set the muting on the default channels.
setMute             :: MonadIO m => Bool           -> m ()
-- | Attempt to set both the volume in percent and the muting on the default channels.
setVolumeMute       :: MonadIO m => Double -> Bool -> m ()
-- | Apply a function to the volume of the default channels, and return the modified value.
modifyVolume        :: MonadIO m => (Double         -> Double        ) -> m Double
-- | Apply a function to the muting on the default channels, and return the modified value.
modifyMute          :: MonadIO m => (Bool           -> Bool          ) -> m Bool
-- | Apply a function to both the volume and the muting of the default channels, and return the modified values.
modifyVolumeMute    :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)

toggleMute :: forall (m :: * -> *). MonadIO m => m Bool
toggleMute          = [String] -> m Bool
forall (m :: * -> *). MonadIO m => [String] -> m Bool
toggleMuteChannels       [String]
defaultChannels
raiseVolume :: forall (m :: * -> *). MonadIO m => Double -> m Double
raiseVolume         = [String] -> Double -> m Double
forall (m :: * -> *). MonadIO m => [String] -> Double -> m Double
raiseVolumeChannels      [String]
defaultChannels
lowerVolume :: forall (m :: * -> *). MonadIO m => Double -> m Double
lowerVolume         = [String] -> Double -> m Double
forall (m :: * -> *). MonadIO m => [String] -> Double -> m Double
lowerVolumeChannels      [String]
defaultChannels
getVolume :: forall (m :: * -> *). MonadIO m => m Double
getVolume           = [String] -> m Double
forall (m :: * -> *). MonadIO m => [String] -> m Double
getVolumeChannels        [String]
defaultChannels
getMute :: forall (m :: * -> *). MonadIO m => m Bool
getMute             = [String] -> m Bool
forall (m :: * -> *). MonadIO m => [String] -> m Bool
getMuteChannels          [String]
defaultChannels
getVolumeMute :: forall (m :: * -> *). MonadIO m => m (Double, Bool)
getVolumeMute       = [String] -> m (Double, Bool)
forall (m :: * -> *). MonadIO m => [String] -> m (Double, Bool)
getVolumeMuteChannels    [String]
defaultChannels
setVolume :: forall (m :: * -> *). MonadIO m => Double -> m ()
setVolume           = [String] -> Double -> m ()
forall (m :: * -> *). MonadIO m => [String] -> Double -> m ()
setVolumeChannels        [String]
defaultChannels
setMute :: forall (m :: * -> *). MonadIO m => Bool -> m ()
setMute             = [String] -> Bool -> m ()
forall (m :: * -> *). MonadIO m => [String] -> Bool -> m ()
setMuteChannels          [String]
defaultChannels
setVolumeMute :: forall (m :: * -> *). MonadIO m => Double -> Bool -> m ()
setVolumeMute       = [String] -> Double -> Bool -> m ()
forall (m :: * -> *).
MonadIO m =>
[String] -> Double -> Bool -> m ()
setVolumeMuteChannels    [String]
defaultChannels
modifyVolume :: forall (m :: * -> *). MonadIO m => (Double -> Double) -> m Double
modifyVolume        = [String] -> (Double -> Double) -> m Double
forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Double) -> m Double
modifyVolumeChannels     [String]
defaultChannels
modifyMute :: forall (m :: * -> *). MonadIO m => (Bool -> Bool) -> m Bool
modifyMute          = [String] -> (Bool -> Bool) -> m Bool
forall (m :: * -> *).
MonadIO m =>
[String] -> (Bool -> Bool) -> m Bool
modifyMuteChannels       [String]
defaultChannels
modifyVolumeMute :: forall (m :: * -> *).
MonadIO m =>
(Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
modifyVolumeMute    = [String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
modifyVolumeMuteChannels [String]
defaultChannels

-- | Channels are what amixer calls \"simple controls\".  The most common ones are \"Master\", \"Wave\", and \"PCM\", so these are included in 'defaultChannels'.  It is guaranteed to be safe to pass channel names that don't exist on the default sound device to the *Channels family of functions.
defaultChannels :: [String]
defaultChannels :: [String]
defaultChannels = [String
"Master", String
"Wave", String
"PCM"]

toggleMuteChannels          :: MonadIO m => [String] -> m Bool
raiseVolumeChannels         :: MonadIO m => [String] -> Double -> m Double
lowerVolumeChannels         :: MonadIO m => [String] -> Double -> m Double
getVolumeChannels           :: MonadIO m => [String] -> m Double
getMuteChannels             :: MonadIO m => [String] -> m Bool
getVolumeMuteChannels       :: MonadIO m => [String] -> m (Double, Bool)
setVolumeChannels           :: MonadIO m => [String] -> Double         -> m ()
setMuteChannels             :: MonadIO m => [String] -> Bool           -> m ()
setVolumeMuteChannels       :: MonadIO m => [String] -> Double -> Bool -> m ()
modifyVolumeChannels        :: MonadIO m => [String] -> (Double         -> Double        ) -> m Double
modifyMuteChannels          :: MonadIO m => [String] -> (Bool           -> Bool          ) -> m Bool
modifyVolumeMuteChannels    :: MonadIO m => [String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)

toggleMuteChannels :: forall (m :: * -> *). MonadIO m => [String] -> m Bool
toggleMuteChannels  [String]
cs = [String] -> (Bool -> Bool) -> m Bool
forall (m :: * -> *).
MonadIO m =>
[String] -> (Bool -> Bool) -> m Bool
modifyMuteChannels   [String]
cs Bool -> Bool
not
raiseVolumeChannels :: forall (m :: * -> *). MonadIO m => [String] -> Double -> m Double
raiseVolumeChannels [String]
cs = [String] -> (Double -> Double) -> m Double
forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Double) -> m Double
modifyVolumeChannels [String]
cs ((Double -> Double) -> m Double)
-> (Double -> Double -> Double) -> Double -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
lowerVolumeChannels :: forall (m :: * -> *). MonadIO m => [String] -> Double -> m Double
lowerVolumeChannels [String]
cs = [String] -> (Double -> Double) -> m Double
forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Double) -> m Double
modifyVolumeChannels [String]
cs ((Double -> Double) -> m Double)
-> (Double -> Double -> Double) -> Double -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract)

getVolumeChannels :: forall (m :: * -> *). MonadIO m => [String] -> m Double
getVolumeChannels     = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double)
-> ([String] -> IO Double) -> [String] -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Bool) -> Double) -> IO (Double, Bool) -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Bool) -> Double
forall a b. (a, b) -> a
fst (IO (Double, Bool) -> IO Double)
-> ([String] -> IO (Double, Bool)) -> [String] -> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO (Double, Bool)
alsaGetAll
getMuteChannels :: forall (m :: * -> *). MonadIO m => [String] -> m Bool
getMuteChannels       = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> ([String] -> IO Bool) -> [String] -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Bool) -> Bool) -> IO (Double, Bool) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Bool) -> Bool
forall a b. (a, b) -> b
snd (IO (Double, Bool) -> IO Bool)
-> ([String] -> IO (Double, Bool)) -> [String] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO (Double, Bool)
alsaGetAll
getVolumeMuteChannels :: forall (m :: * -> *). MonadIO m => [String] -> m (Double, Bool)
getVolumeMuteChannels = IO (Double, Bool) -> m (Double, Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO            (IO (Double, Bool) -> m (Double, Bool))
-> ([String] -> IO (Double, Bool)) -> [String] -> m (Double, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO (Double, Bool)
alsaGetAll

setVolumeChannels :: forall (m :: * -> *). MonadIO m => [String] -> Double -> m ()
setVolumeChannels     [String]
cs Double
v   = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Double -> [String] -> IO ()
alsaSetVolumeAll Double
v   [String]
cs)
setMuteChannels :: forall (m :: * -> *). MonadIO m => [String] -> Bool -> m ()
setMuteChannels       [String]
cs   Bool
m = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> [String] -> IO ()
alsaSetMuteAll     Bool
m [String]
cs)
setVolumeMuteChannels :: forall (m :: * -> *).
MonadIO m =>
[String] -> Double -> Bool -> m ()
setVolumeMuteChannels [String]
cs Double
v Bool
m = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Double -> Bool -> [String] -> IO ()
alsaSetAll       Double
v Bool
m [String]
cs)

modifyVolumeChannels :: forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Double) -> m Double
modifyVolumeChannels = ([String] -> m Double)
-> ([String] -> Double -> m ())
-> [String]
-> (Double -> Double)
-> m Double
forall (m :: * -> *) arg value.
Monad m =>
(arg -> m value)
-> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify [String] -> m Double
forall (m :: * -> *). MonadIO m => [String] -> m Double
getVolumeChannels [String] -> Double -> m ()
forall (m :: * -> *). MonadIO m => [String] -> Double -> m ()
setVolumeChannels
modifyMuteChannels :: forall (m :: * -> *).
MonadIO m =>
[String] -> (Bool -> Bool) -> m Bool
modifyMuteChannels   = ([String] -> m Bool)
-> ([String] -> Bool -> m ())
-> [String]
-> (Bool -> Bool)
-> m Bool
forall (m :: * -> *) arg value.
Monad m =>
(arg -> m value)
-> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify [String] -> m Bool
forall (m :: * -> *). MonadIO m => [String] -> m Bool
getMuteChannels   [String] -> Bool -> m ()
forall (m :: * -> *). MonadIO m => [String] -> Bool -> m ()
setMuteChannels
modifyVolumeMuteChannels :: forall (m :: * -> *).
MonadIO m =>
[String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
modifyVolumeMuteChannels [String]
cs = ([String] -> m (Double, Bool))
-> ([String] -> (Double, Bool) -> m ())
-> [String]
-> ((Double, Bool) -> (Double, Bool))
-> m (Double, Bool)
forall (m :: * -> *) arg value.
Monad m =>
(arg -> m value)
-> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify [String] -> m (Double, Bool)
forall (m :: * -> *). MonadIO m => [String] -> m (Double, Bool)
getVolumeMuteChannels (\[String]
cs' -> (Double -> Bool -> m ()) -> (Double, Bool) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([String] -> Double -> Bool -> m ()
forall (m :: * -> *).
MonadIO m =>
[String] -> Double -> Bool -> m ()
setVolumeMuteChannels [String]
cs')) [String]
cs (((Double, Bool) -> (Double, Bool)) -> m (Double, Bool))
-> ((Double -> Bool -> (Double, Bool))
    -> (Double, Bool) -> (Double, Bool))
-> (Double -> Bool -> (Double, Bool))
-> m (Double, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Bool -> (Double, Bool))
-> (Double, Bool) -> (Double, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
-- }}}
-- internals {{{
geomMean :: Floating a => [a] -> a
geomMean :: forall a. Floating a => [a] -> a
geomMean [a]
xs = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a]
xs a -> a -> a
forall a. Floating a => a -> a -> a
** (a -> a
forall a. Fractional a => a -> a
recip (a -> a) -> ([a] -> a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> ([a] -> Int) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a]
xs)

clip :: (Num t, Ord t) => t -> t
clip :: forall t. (Num t, Ord t) => t -> t
clip = t -> t -> t
forall a. Ord a => a -> a -> a
min t
100 (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> t
forall a. Ord a => a -> a -> a
max t
0

toRange :: (CLong, CLong) -> Double -> CLong
toRange :: (CLong, CLong) -> Double -> CLong
toRange (CLong
x, CLong
y) Double
d = Double -> CLong
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x')
  where x' :: Double
x' = CLong -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x
        y' :: Double
y' = CLong -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
y
        
fromRange :: (CLong, CLong) -> CLong -> Double
fromRange :: (CLong, CLong) -> CLong -> Double
fromRange (CLong
x, CLong
y) CLong
z = CLong -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong
z CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
- CLong
x) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ CLong -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong
y CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
- CLong
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100

modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify :: forall (m :: * -> *) arg value.
Monad m =>
(arg -> m value)
-> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify arg -> m value
get arg -> value -> m ()
set arg
cs value -> value
f = do
    value
v <- (value -> value) -> m value -> m value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM value -> value
f (m value -> m value) -> m value -> m value
forall a b. (a -> b) -> a -> b
$ arg -> m value
get arg
cs
    arg -> value -> m ()
set arg
cs value
v
    value -> m value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return value
v

withControl :: (Control -> IO a) -> [String] -> IO a
withControl :: forall a. (Control -> IO a) -> [String] -> IO a
withControl Control -> IO a
f [String]
cs = String -> (Mixer -> IO a) -> IO a
forall a. String -> (Mixer -> IO a) -> IO a
withMixer String
"default" ((Mixer -> IO a) -> IO a) -> (Mixer -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Mixer
mixer -> do 
  (Control
control:[Control]
_) <- [Maybe Control] -> [Control]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Control] -> [Control])
-> IO [Maybe Control] -> IO [Control]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe Control)) -> [String] -> IO [Maybe Control]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Mixer -> String -> IO (Maybe Control)
getControlByName Mixer
mixer) [String]
cs
  Control -> IO a
f Control
control

alsaGetAll :: [String] -> IO (Double, Bool)
alsaGetAll :: [String] -> IO (Double, Bool)
alsaGetAll = (Control -> IO (Double, Bool)) -> [String] -> IO (Double, Bool)
forall a. (Control -> IO a) -> [String] -> IO a
withControl ((Control -> IO (Double, Bool)) -> [String] -> IO (Double, Bool))
-> (Control -> IO (Double, Bool)) -> [String] -> IO (Double, Bool)
forall a b. (a -> b) -> a -> b
$ \Control
control -> (,) (Double -> Bool -> (Double, Bool))
-> IO Double -> IO (Bool -> (Double, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Control -> IO Double
alsaGetVolume Control
control 
                                           IO (Bool -> (Double, Bool)) -> IO Bool -> IO (Double, Bool)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Control -> IO Bool
alsaGetMute Control
control

alsaGetVolume :: Control -> IO Double
alsaGetVolume :: Control -> IO Double
alsaGetVolume Control
control = do
  let Just Volume
playbackVolume = Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume
forall a. Either a (Maybe a, Maybe a) -> Maybe a
playback (Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume)
-> Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume
forall a b. (a -> b) -> a -> b
$ Control -> Either Volume (Maybe Volume, Maybe Volume)
volume Control
control
      volChans :: PerChannel CLong
volChans = Volume -> PerChannel CLong
value Volume
playbackVolume
  (CLong, CLong)
range <- Volume -> IO (CLong, CLong)
getRange Volume
playbackVolume
  [Maybe CLong]
vals <- (Channel -> IO (Maybe CLong)) -> [Channel] -> IO [Maybe CLong]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Channel
chan -> Channel -> PerChannel CLong -> IO (Maybe CLong)
forall x. Channel -> PerChannel x -> IO (Maybe x)
getChannel Channel
chan PerChannel CLong
volChans) (PerChannel CLong -> [Channel]
forall e. PerChannel e -> [Channel]
channels PerChannel CLong
volChans)
  Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
forall a. Floating a => [a] -> a
geomMean ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (Maybe CLong -> Double) -> [Maybe CLong] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((CLong, CLong) -> CLong -> Double
fromRange (CLong, CLong)
range (CLong -> Double)
-> (Maybe CLong -> CLong) -> Maybe CLong -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CLong -> CLong
forall a. HasCallStack => Maybe a -> a
fromJust) [Maybe CLong]
vals

alsaGetMute :: Control -> IO Bool
alsaGetMute :: Control -> IO Bool
alsaGetMute Control
control = do
  let Just Switch
muteChans = Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch
forall a. Either a (Maybe a, Maybe a) -> Maybe a
playback (Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch)
-> Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch
forall a b. (a -> b) -> a -> b
$ Control -> Either Switch (Maybe Switch, Maybe Switch)
switch Control
control
  (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id ([Bool] -> Bool)
-> ([Maybe Bool] -> [Bool]) -> [Maybe Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Bool) -> [Maybe Bool] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Bool -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe Bool] -> Bool) -> IO [Maybe Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Channel -> IO (Maybe Bool)) -> [Channel] -> IO [Maybe Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Channel
chan -> Channel -> Switch -> IO (Maybe Bool)
forall x. Channel -> PerChannel x -> IO (Maybe x)
getChannel Channel
chan Switch
muteChans) (Switch -> [Channel]
forall e. PerChannel e -> [Channel]
channels Switch
muteChans)

alsaSetVolumeAll :: Double -> [String] -> IO ()
alsaSetVolumeAll :: Double -> [String] -> IO ()
alsaSetVolumeAll Double
v = (Control -> IO ()) -> [String] -> IO ()
forall a. (Control -> IO a) -> [String] -> IO a
withControl (Double -> Control -> IO ()
alsaSetVolume Double
v)

alsaSetVolume :: Double -> Control -> IO () 
alsaSetVolume :: Double -> Control -> IO ()
alsaSetVolume Double
v Control
control = do
  let Just Volume
playbackVolume = Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume
forall a. Either a (Maybe a, Maybe a) -> Maybe a
playback (Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume)
-> Either Volume (Maybe Volume, Maybe Volume) -> Maybe Volume
forall a b. (a -> b) -> a -> b
$ Control -> Either Volume (Maybe Volume, Maybe Volume)
volume Control
control
      volChans :: PerChannel CLong
volChans = Volume -> PerChannel CLong
value Volume
playbackVolume
  (CLong, CLong)
range <- Volume -> IO (CLong, CLong)
getRange Volume
playbackVolume
  [Channel] -> (Channel -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (PerChannel CLong -> [Channel]
forall e. PerChannel e -> [Channel]
channels PerChannel CLong
volChans) ((Channel -> IO ()) -> IO ()) -> (Channel -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Channel
chan -> do 
    Channel -> PerChannel CLong -> CLong -> IO ()
forall x. Channel -> PerChannel x -> x -> IO ()
setChannel Channel
chan PerChannel CLong
volChans ((CLong, CLong) -> Double -> CLong
toRange (CLong, CLong)
range (Double -> Double
forall t. (Num t, Ord t) => t -> t
clip Double
v))

alsaSetMuteAll :: Bool -> [String] -> IO ()
alsaSetMuteAll :: Bool -> [String] -> IO ()
alsaSetMuteAll Bool
m = (Control -> IO ()) -> [String] -> IO ()
forall a. (Control -> IO a) -> [String] -> IO a
withControl (Bool -> Control -> IO ()
alsaSetMute Bool
m)

alsaSetMute :: Bool -> Control -> IO ()
alsaSetMute :: Bool -> Control -> IO ()
alsaSetMute Bool
m Control
control = do
  let Just Switch
muteChans = Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch
forall a. Either a (Maybe a, Maybe a) -> Maybe a
playback (Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch)
-> Either Switch (Maybe Switch, Maybe Switch) -> Maybe Switch
forall a b. (a -> b) -> a -> b
$ Control -> Either Switch (Maybe Switch, Maybe Switch)
switch Control
control
  [Channel] -> (Channel -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Switch -> [Channel]
forall e. PerChannel e -> [Channel]
channels Switch
muteChans) ((Channel -> IO ()) -> IO ()) -> (Channel -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Channel
chan -> Channel -> Switch -> Bool -> IO ()
forall x. Channel -> PerChannel x -> x -> IO ()
setChannel Channel
chan Switch
muteChans Bool
m

alsaSetAll :: Double -> Bool -> [String] -> IO ()
alsaSetAll :: Double -> Bool -> [String] -> IO ()
alsaSetAll Double
v Bool
m = (Control -> IO ()) -> [String] -> IO ()
forall a. (Control -> IO a) -> [String] -> IO a
withControl ((Control -> IO ()) -> [String] -> IO ())
-> (Control -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ \Control
control -> do
  Double -> Control -> IO ()
alsaSetVolume Double
v Control
control
  Bool -> Control -> IO ()
alsaSetMute Bool
m Control
control

-- | Helper function to output current volume via osd_cat.  (Needs the osd_cat executable).
-- The second parameter is passed True when the speakers are muted and should
-- return the options to pass to osd_cat.
osdCat :: MonadIO m => Double -> (Bool -> String) -> m ()
osdCat :: forall (m :: * -> *).
MonadIO m =>
Double -> (Bool -> String) -> m ()
osdCat Double
vol Bool -> String
opts = do
  Bool
m <- m Bool
forall (m :: * -> *). MonadIO m => m Bool
getMute
  String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
spawn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"osd_cat -b percentage -P " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
vol :: Integer) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
opts Bool
m

-- | Default options for displaying the volume.
defaultOSDOpts :: Bool -> String
defaultOSDOpts :: Bool -> String
defaultOSDOpts Bool
mute = String
"--align=center --pos=top --delay=1 --text=\"Volume" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      (if Bool
mute then String
"[muted]\" " else String
"\" ") String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      String
"--font='-bitstream-bitstream vera sans-bold-r-*-*-10-*-*-*-*-*-*-*' " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      String
"--outline=1"

-- }}}