1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE CPP #-}
module XMonad.Util.ALSA
( toggleMute
, raiseVolume
, lowerVolume
, getVolume
, getMute
, getVolumeMute
, setVolume
, setMute
, setVolumeMute
, modifyVolume
, modifyMute
, modifyVolumeMute
, defaultChannels
, toggleMuteChannels
, raiseVolumeChannels
, lowerVolumeChannels
, getVolumeChannels
, getMuteChannels
, getVolumeMuteChannels
, setVolumeChannels
, setMuteChannels
, setVolumeMuteChannels
, modifyVolumeChannels
, modifyMuteChannels
, modifyVolumeMuteChannels
) where
import Control.Monad
import Control.Monad.Trans
import Data.Maybe
import Sound.ALSA.Mixer
toggleMute :: MonadIO m => m Bool
raiseVolume :: MonadIO m => Double -> m Double
lowerVolume :: MonadIO m => Double -> m Double
getVolume :: MonadIO m => m Double
getMute :: MonadIO m => m Bool
getVolumeMute :: MonadIO m => m (Double, Bool)
setVolume :: MonadIO m => Double -> m ()
setMute :: MonadIO m => Bool -> m ()
setVolumeMute :: MonadIO m => Double -> Bool -> m ()
modifyVolume :: MonadIO m => (Double -> Double) -> m Double
modifyMute :: MonadIO m => (Bool -> Bool) -> m Bool
modifyVolumeMute :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
toggleMute = toggleMuteChannels defaultChannels
raiseVolume = raiseVolumeChannels defaultChannels
lowerVolume = lowerVolumeChannels defaultChannels
getVolume = getVolumeChannels defaultChannels
getMute = getMuteChannels defaultChannels
getVolumeMute = getVolumeMuteChannels defaultChannels
setVolume = setVolumeChannels defaultChannels
setMute = setMuteChannels defaultChannels
setVolumeMute = setVolumeMuteChannels defaultChannels
modifyVolume = modifyVolumeChannels defaultChannels
modifyMute = modifyMuteChannels defaultChannels
modifyVolumeMute = modifyVolumeMuteChannels defaultChannels
defaultChannels :: [String]
defaultChannels = ["Master", "Wave", "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 cs = modifyMuteChannels cs not
raiseVolumeChannels cs = modifyVolumeChannels cs . (+)
lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract)
getVolumeChannels = liftIO . fmap fst . alsaGetAll
getMuteChannels = liftIO . fmap snd . alsaGetAll
getVolumeMuteChannels = liftIO . alsaGetAll
setVolumeChannels cs v = liftIO (alsaSetVolumeAll v cs)
setMuteChannels cs m = liftIO (alsaSetMuteAll m cs)
setVolumeMuteChannels cs v m = liftIO (alsaSetAll v m cs)
modifyVolumeChannels = modify getVolumeChannels setVolumeChannels
modifyMuteChannels = modify getMuteChannels setMuteChannels
modifyVolumeMuteChannels cs = modify getVolumeMuteChannels (\cs' -> uncurry (setVolumeMuteChannels cs')) cs . uncurry
geomMean :: Floating a => [a] -> a
geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
clip :: (Num t, Ord t) => t -> t
clip = min 100 . max 0
toRange :: (Integer, Integer) -> Double -> Integer
toRange (x, y) d = floor (d * (y' - x') / 100 + x')
where x' = fromIntegral x
y' = fromIntegral y
fromRange :: (Integer, Integer) -> Integer -> Double
fromRange (x, y) z = fromIntegral (z - x) / fromIntegral (y - x) * 100
modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
modify get set cs f = do
v <- liftM f $ get cs
set cs v
return v
withControl :: (Control -> IO a) -> [String] -> IO a
withControl f cs = withMixer "default" $ \mixer -> do
(control:_) <- catMaybes <$> mapM (getControlByName mixer) cs
f control
alsaGetAll :: [String] -> IO (Double, Bool)
alsaGetAll = withControl $ \control -> (,)
<$> alsaGetVolume control
<*> alsaGetMute control
alsaGetVolume :: Control -> IO Double
alsaGetVolume control = do
let Just playbackVolume = playback $ volume control
volChans = value playbackVolume
range <- getRange playbackVolume
vals <- mapM (\chan -> getChannel chan volChans) (channels volChans)
return $ geomMean $ map (fromRange range . fromJust) vals
alsaGetMute :: Control -> IO Bool
alsaGetMute control = do
let Just muteChans = playback $ switch control
all id . map fromJust <$> mapM (\chan -> getChannel chan muteChans) (channels muteChans)
alsaSetVolumeAll :: Double -> [String] -> IO ()
alsaSetVolumeAll v = withControl (alsaSetVolume v)
alsaSetVolume :: Double -> Control -> IO ()
alsaSetVolume v control = do
let Just playbackVolume = playback $ volume control
volChans = value playbackVolume
range <- getRange playbackVolume
forM_ (channels volChans) $ \chan -> do
setChannel chan volChans (toRange range (clip v))
alsaSetMuteAll :: Bool -> [String] -> IO ()
alsaSetMuteAll m = withControl (alsaSetMute m)
alsaSetMute :: Bool -> Control -> IO ()
alsaSetMute m control = do
let Just muteChans = playback $ switch control
forM_ (channels muteChans) $ \chan -> setChannel chan muteChans m
alsaSetAll :: Double -> Bool -> [String] -> IO ()
alsaSetAll v m = withControl $ \control -> do
alsaSetVolume v control
alsaSetMute m control
|
