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
|
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Volume
-- Copyright : (c) 2011 Thomas Tuegel
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- A monitor for ALSA soundcards
--
-----------------------------------------------------------------------------
module Plugins.Monitors.Volume (runVolume, volumeConfig) where
import Control.Monad ( liftM )
import Data.Maybe
import Plugins.Monitors.Common
import Sound.ALSA.Mixer
import System.Console.GetOpt
data VolumeOpts = VolumeOpts
{ onString :: String
, offString :: String
, onColor :: Maybe String
, offColor :: Maybe String
, highDbThresh :: Float
, lowDbThresh :: Float
}
defaultOpts :: VolumeOpts
defaultOpts = VolumeOpts
{ onString = "[on] "
, offString = "[off]"
, onColor = Just "green"
, offColor = Just "red"
, highDbThresh = -5.0
, lowDbThresh = -30.0
}
options :: [OptDescr (VolumeOpts -> VolumeOpts)]
options =
[ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") ""
, Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") ""
, Option "" ["lowd"] (ReqArg (\x o -> o { lowDbThresh = read x }) "") ""
, Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") ""
, Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") ""
, Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") ""
]
parseOpts :: [String] -> IO VolumeOpts
parseOpts argv =
case getOpt Permute options argv of
(o, _, []) -> return $ foldr id defaultOpts o
(_, _, errs) -> ioError . userError $ concat errs
percent :: Integer -> Integer -> Integer -> Float
percent v' lo' hi' = (v - lo) / (hi - lo)
where v = fromIntegral v'
lo = fromIntegral lo'
hi = fromIntegral hi'
volumeConfig :: IO MConfig
volumeConfig = mkMConfig "Vol: <volume>% <status>"
["volume","dB","status"]
formatVol :: Integer -> Integer -> Integer -> Monitor String
formatVol v lo hi =
showPercentWithColors $ percent v lo hi
switchHelper :: VolumeOpts
-> (VolumeOpts -> Maybe String)
-> (VolumeOpts -> String)
-> Monitor String
switchHelper opts cHelp strHelp = return $
colorHelper (cHelp opts)
++ strHelp opts
++ maybe "" (const "</fc>") (cHelp opts)
formatSwitch :: VolumeOpts -> Bool -> Monitor String
formatSwitch opts True = switchHelper opts onColor onString
formatSwitch opts False = switchHelper opts offColor offString
colorHelper :: Maybe String -> String
colorHelper = maybe "" (\c -> "<fc=" ++ c ++ ">")
formatDb :: VolumeOpts -> Float -> Monitor String
formatDb opts db = do
h <- getConfigValue highColor
m <- getConfigValue normalColor
l <- getConfigValue lowColor
let digits = showDigits 0 db
startColor | db >= highDbThresh opts = colorHelper h
| db < lowDbThresh opts = colorHelper l
| otherwise = colorHelper m
stopColor | null startColor = ""
| otherwise = "</fc>"
return $ startColor ++ digits ++ stopColor
runVolume :: String -> String -> [String] -> Monitor String
runVolume mixerName controlName argv = do
opts <- io $ parseOpts argv
control <- liftM fromJust $ io $ getControlByName mixerName controlName
let volumeControl = fromJust $ maybe (playback $ volume control) Just
(common $ volume control)
switchControl = fromJust $ maybe (playback $ switch control) Just
(common $ switch control)
(lo, hi) <- io $ getRange volumeControl
val <- io $ getChannel FrontLeft $ value volumeControl
db <- io $ getChannel FrontLeft $ dB volumeControl
sw <- io $ getChannel FrontLeft switchControl
p <- case val of
Just x -> formatVol x lo hi
Nothing -> formatVol hi lo hi
d <- case db of
Just x -> formatDb opts $ fromIntegral x / 100.0
Nothing -> formatDb opts 0.0
s <- case sw of
Just x -> formatSwitch opts x
Nothing -> formatSwitch opts True
parseTemplate [ p, d, s ]
|