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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.ALSA
-- Copyright : (c) daniel@wagner-home.com
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : daniel@wagner-home.com
-- Stability : unstable
-- Portability : unportable
--
----------------------------------------------------------------------------
module XMonad.Util.ALSA
( defaultChannels
, toggleMute
, raiseVolume
, lowerVolume
, getVolume
, getMute
, getVolumeMute
, setVolume
, setMute
, setVolumeMute
, modifyVolume
, modifyMute
, modifyVolumeMute
, 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
defaultChannels :: [String]
defaultChannels = ["Master", "Headphone", "Speaker", "PCM"]
toggleMute :: MonadIO m => m Bool
raiseVolume :: MonadIO m => Double -> m Double
lowerVolume :: MonadIO m => Double -> m Double
toggleMute = toggleMuteChannels defaultChannels
raiseVolume = raiseVolumeChannels defaultChannels
lowerVolume = lowerVolumeChannels defaultChannels
getVolume :: MonadIO m => m Double
getMute :: MonadIO m => m Bool
getVolumeMute :: MonadIO m => m (Double, Bool)
getVolume = getVolumeChannels defaultChannels
getMute = getMuteChannels defaultChannels
getVolumeMute = getVolumeMuteChannels defaultChannels
setVolume :: MonadIO m => Double -> m ()
setMute :: MonadIO m => Bool -> m ()
setVolumeMute :: MonadIO m => Double -> Bool -> m ()
setVolume = setVolumeChannels defaultChannels
setMute = setMuteChannels defaultChannels
setVolumeMute = setVolumeMuteChannels defaultChannels
modifyVolume :: MonadIO m => (Double -> Double) -> m Double
modifyMute :: MonadIO m => (Bool -> Bool) -> m Bool
modifyVolumeMute :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
modifyVolume = modifyVolumeChannels defaultChannels
modifyMute = modifyMuteChannels defaultChannels
modifyVolumeMute = modifyVolumeMuteChannels defaultChannels
toggleMuteChannels :: MonadIO m => [String] -> m Bool
raiseVolumeChannels :: MonadIO m => [String] -> Double -> m Double
lowerVolumeChannels :: MonadIO m => [String] -> Double -> m Double
toggleMuteChannels cs = modifyMuteChannels cs not
raiseVolumeChannels cs = modifyVolumeChannels cs . (+)
lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract)
getVolumeChannels :: MonadIO m => [String] -> m Double
getMuteChannels :: MonadIO m => [String] -> m Bool
getVolumeMuteChannels :: MonadIO m => [String] -> m (Double, Bool)
getVolumeChannels = liftIO . fmap fst . alsaGetAll
getMuteChannels = liftIO . fmap snd . alsaGetAll
getVolumeMuteChannels = liftIO . alsaGetAll
setVolumeChannels :: MonadIO m => [String] -> Double -> m ()
setMuteChannels :: MonadIO m => [String] -> Bool -> m ()
setVolumeMuteChannels :: MonadIO m => [String] -> Double -> Bool -> m ()
setVolumeChannels cs v = liftIO (alsaSetVolumeAll v cs)
setMuteChannels cs m = liftIO (alsaSetMuteAll m cs)
setVolumeMuteChannels cs v m = liftIO (alsaSetAll v m cs)
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)
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
|
