WIP add backlight to dbus
This commit is contained in:
parent
778dc38538
commit
673a7f5f07
|
@ -1,3 +1,4 @@
|
||||||
|
-- import Xmobar.Backlight
|
||||||
import Xmobar.Screensaver
|
import Xmobar.Screensaver
|
||||||
|
|
||||||
import qualified Theme as T
|
import qualified Theme as T
|
||||||
|
@ -25,6 +26,7 @@ myTemplate = formatTemplate left right
|
||||||
, "%alsa:default:Master%"
|
, "%alsa:default:Master%"
|
||||||
, "%battery%"
|
, "%battery%"
|
||||||
, "%bright%"
|
, "%bright%"
|
||||||
|
-- , "%betterbacklight%"
|
||||||
, "%screensaver%"
|
, "%screensaver%"
|
||||||
, "%locks%"
|
, "%locks%"
|
||||||
, "%date%"
|
, "%date%"
|
||||||
|
@ -52,8 +54,8 @@ blockFont = T.fmtFontXFT T.font
|
||||||
}
|
}
|
||||||
|
|
||||||
config :: String -> Config
|
config :: String -> Config
|
||||||
config confDir = defaultConfig {
|
config confDir = defaultConfig
|
||||||
font = barFont
|
{ font = barFont
|
||||||
, additionalFonts = [ iconFont, blockFont ]
|
, additionalFonts = [ iconFont, blockFont ]
|
||||||
, textOffset = 16
|
, textOffset = 16
|
||||||
, textOffsets = [ 16, 17 ]
|
, textOffsets = [ 16, 17 ]
|
||||||
|
@ -103,6 +105,8 @@ config confDir = defaultConfig {
|
||||||
, "-D", "intel_backlight"
|
, "-D", "intel_backlight"
|
||||||
] 10
|
] 10
|
||||||
|
|
||||||
|
-- , Run $ Backlight ("", "")
|
||||||
|
|
||||||
, Run $ Wireless "wlp0s20f3"
|
, Run $ Wireless "wlp0s20f3"
|
||||||
[ "-t", "<qualityipat><essid>"
|
[ "-t", "<qualityipat><essid>"
|
||||||
, "--"
|
, "--"
|
||||||
|
|
|
@ -7,6 +7,10 @@ import ACPI
|
||||||
import SendXMsg
|
import SendXMsg
|
||||||
import Notify
|
import Notify
|
||||||
import Shell
|
import Shell
|
||||||
|
import DBus.Client (Client)
|
||||||
|
|
||||||
|
import DBus.Common
|
||||||
|
import DBus.Backlight
|
||||||
|
|
||||||
import qualified Theme as T
|
import qualified Theme as T
|
||||||
|
|
||||||
|
@ -75,11 +79,12 @@ import XMonad.Util.Run
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
|
dbClient <- startXMonadService
|
||||||
(barPID, h) <- spawnPipe' "xmobar"
|
(barPID, h) <- spawnPipe' "xmobar"
|
||||||
pwrPID <- spawnPID "powermon"
|
pwrPID <- spawnPID "powermon"
|
||||||
launch
|
launch
|
||||||
$ ewmh
|
$ ewmh
|
||||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID])
|
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient)
|
||||||
$ def { terminal = myTerm
|
$ def { terminal = myTerm
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts
|
, layoutHook = myLayouts
|
||||||
|
@ -436,8 +441,10 @@ runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace
|
||||||
runGimp :: X ()
|
runGimp :: X ()
|
||||||
runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace
|
runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace
|
||||||
|
|
||||||
runCleanup :: [ProcessID] -> X ()
|
runCleanup :: [ProcessID] -> Client -> X ()
|
||||||
runCleanup ps = io $ mapM_ killPID ps
|
runCleanup ps client = io $ do
|
||||||
|
mapM_ killPID ps
|
||||||
|
stopXMonadService client
|
||||||
|
|
||||||
killPID :: ProcessID -> IO ()
|
killPID :: ProcessID -> IO ()
|
||||||
killPID pID = do
|
killPID pID = do
|
||||||
|
@ -509,10 +516,10 @@ runDecBacklight :: X ()
|
||||||
runDecBacklight = spawnCmd "adj_backlight" ["down"]
|
runDecBacklight = spawnCmd "adj_backlight" ["down"]
|
||||||
|
|
||||||
runMinBacklight :: X ()
|
runMinBacklight :: X ()
|
||||||
runMinBacklight = spawnCmd "adj_backlight" ["min"]
|
runMinBacklight = io callMinBrightness
|
||||||
|
|
||||||
runMaxBacklight :: X ()
|
runMaxBacklight :: X ()
|
||||||
runMaxBacklight = spawnCmd "adj_backlight" ["max"]
|
runMaxBacklight = io callMaxBrightness
|
||||||
|
|
||||||
showWorkspace tag = windows $ W.view tag
|
showWorkspace tag = windows $ W.view tag
|
||||||
|
|
||||||
|
@ -557,8 +564,8 @@ mkNamedSubmap c sectionName bindings =
|
||||||
|
|
||||||
-- NOTE: the following bindings are used by dunst:
|
-- NOTE: the following bindings are used by dunst:
|
||||||
-- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
|
-- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
|
||||||
myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
myKeys :: [ProcessID] -> Client -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
||||||
myKeys hs c =
|
myKeys hs client c =
|
||||||
mkNamedSubmap c "Window Layouts"
|
mkNamedSubmap c "Window Layouts"
|
||||||
[ ("M-j", addName "focus down" $ windows W.focusDown)
|
[ ("M-j", addName "focus down" $ windows W.focusDown)
|
||||||
, ("M-k", addName "focus up" $ windows W.focusUp)
|
, ("M-k", addName "focus up" $ windows W.focusUp)
|
||||||
|
@ -640,7 +647,7 @@ myKeys hs c =
|
||||||
, ("M-M1-.", addName "backlight max" runMaxBacklight)
|
, ("M-M1-.", addName "backlight max" runMaxBacklight)
|
||||||
, ("M-M1-=", addName "enable screensaver" enableDPMS)
|
, ("M-M1-=", addName "enable screensaver" enableDPMS)
|
||||||
, ("M-M1--", addName "disable screensaver" disableDPMS)
|
, ("M-M1--", addName "disable screensaver" disableDPMS)
|
||||||
, ("M-<F2>", addName "restart xmonad" $ runCleanup hs >> runRestart)
|
, ("M-<F2>", addName "restart xmonad" $ runCleanup hs client >> runRestart)
|
||||||
, ("M-S-<F2>", addName "recompile xmonad" runRecompile)
|
, ("M-S-<F2>", addName "recompile xmonad" runRecompile)
|
||||||
, ("M-<End>", addName "power menu" myPowerPrompt)
|
, ("M-<End>", addName "power menu" myPowerPrompt)
|
||||||
, ("M-<Home>", addName "quit xmonad" myQuitPrompt)
|
, ("M-<Home>", addName "quit xmonad" myQuitPrompt)
|
||||||
|
|
|
@ -0,0 +1,111 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module DBus.Backlight where
|
||||||
|
|
||||||
|
-- import Control.Monad
|
||||||
|
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
|
import Data.Int (Int32)
|
||||||
|
|
||||||
|
-- use strict IO here, the data in these files is literally 1-10 bytes
|
||||||
|
import Data.Text (pack, unpack)
|
||||||
|
import Data.Text.IO as T (readFile, writeFile)
|
||||||
|
|
||||||
|
import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
brightnessDir :: FilePath
|
||||||
|
brightnessDir = "/sys/class/backlight/intel_backlight/"
|
||||||
|
|
||||||
|
maxFile :: String
|
||||||
|
maxFile = brightnessDir ++ "max_brightness"
|
||||||
|
|
||||||
|
curFile :: String
|
||||||
|
curFile = brightnessDir ++ "brightness"
|
||||||
|
|
||||||
|
steps :: Int
|
||||||
|
steps = 15
|
||||||
|
|
||||||
|
readFileInt :: FilePath -> IO Int
|
||||||
|
readFileInt file = do
|
||||||
|
contents <- T.readFile file
|
||||||
|
return $ read $ takeWhile isDigit $ unpack contents
|
||||||
|
|
||||||
|
getMaxValue :: IO Int
|
||||||
|
getMaxValue = readFileInt maxFile
|
||||||
|
|
||||||
|
getCurValue :: IO Int
|
||||||
|
getCurValue = readFileInt curFile
|
||||||
|
|
||||||
|
getStepSize :: IO Int
|
||||||
|
getStepSize = getMaxValue >>= (\x -> return $ x `div` steps)
|
||||||
|
|
||||||
|
setCurValue :: Int -> IO ()
|
||||||
|
setCurValue = T.writeFile curFile . pack . show
|
||||||
|
|
||||||
|
truncateValue :: Int -> Int -> Int
|
||||||
|
truncateValue maxval = min maxval . max 1
|
||||||
|
|
||||||
|
changeBrightness :: Int -> Int -> IO ()
|
||||||
|
changeBrightness maxval delta = getCurValue
|
||||||
|
>>= setCurValue . truncateValue maxval . (+ delta)
|
||||||
|
|
||||||
|
setBrightness :: Int -> IO ()
|
||||||
|
setBrightness = setCurValue
|
||||||
|
|
||||||
|
exportBrightness :: Client -> IO ()
|
||||||
|
exportBrightness client = do
|
||||||
|
maxval <- getMaxValue
|
||||||
|
stepsize <- getStepSize
|
||||||
|
export client "/brightness" defaultInterface
|
||||||
|
{ interfaceName = "org.xmonad.Brightness"
|
||||||
|
, interfaceMethods =
|
||||||
|
[ autoMethod "MaxBrightness" (setBrightness maxval)
|
||||||
|
, autoMethod "MinBrightness" (setBrightness 1)
|
||||||
|
, autoMethod "IncBrightness" (changeBrightness maxval stepsize)
|
||||||
|
, autoMethod "DecBrightness" (changeBrightness maxval (-stepsize))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
brPath :: ObjectPath
|
||||||
|
brPath = "/brightness"
|
||||||
|
|
||||||
|
brInterface :: InterfaceName
|
||||||
|
brInterface = "org.xmonad.Brightness"
|
||||||
|
|
||||||
|
brSignal :: Signal
|
||||||
|
brSignal = (signal brPath brInterface "CurrentBrightness")
|
||||||
|
-- { signalDestination = Just "org.xmonad" }
|
||||||
|
|
||||||
|
brMatcher :: MatchRule
|
||||||
|
brMatcher = matchAny
|
||||||
|
{
|
||||||
|
-- matchSender = Just "org.xmonad"
|
||||||
|
-- , matchDestination = Just "org.xmonad"
|
||||||
|
-- matchPath = Just brPath
|
||||||
|
-- , matchInterface = Just brInterface
|
||||||
|
matchMember = Just "CurrentBrightness"
|
||||||
|
}
|
||||||
|
|
||||||
|
callMaxBrightness :: IO ()
|
||||||
|
callMaxBrightness = do
|
||||||
|
client <- connectSession
|
||||||
|
_ <- call client (methodCall "/brightness" "org.xmonad.Brightness" "MaxBrightness")
|
||||||
|
{ methodCallDestination = Just "org.xmonad" }
|
||||||
|
emit client =<< wrapSig <$> getCurValue
|
||||||
|
-- print reply
|
||||||
|
where
|
||||||
|
wrapSig i = brSignal
|
||||||
|
{ signalBody = [toVariant (fromIntegral i :: Int32)] }
|
||||||
|
|
||||||
|
callMinBrightness :: IO ()
|
||||||
|
callMinBrightness = do
|
||||||
|
client <- connectSession
|
||||||
|
_ <- call client (methodCall "/brightness" "org.xmonad.Brightness" "MinBrightness")
|
||||||
|
{ methodCallDestination = Just "org.xmonad" }
|
||||||
|
emit client =<< wrapSig <$> getCurValue
|
||||||
|
-- print reply
|
||||||
|
where
|
||||||
|
wrapSig i = brSignal
|
||||||
|
{ signalBody = [toVariant (fromIntegral i :: Int32)] }
|
|
@ -0,0 +1,39 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module DBus.Common where
|
||||||
|
|
||||||
|
-- import Control.Concurrent
|
||||||
|
-- import Control.Monad
|
||||||
|
|
||||||
|
import DBus.Backlight
|
||||||
|
|
||||||
|
-- import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
onFoo :: IO String
|
||||||
|
onFoo = return "testicle"
|
||||||
|
|
||||||
|
startXMonadService :: IO Client
|
||||||
|
startXMonadService = do
|
||||||
|
client <- connectSession
|
||||||
|
requestResult <- requestName client "org.xmonad" []
|
||||||
|
-- TODO if the client is not released on shutdown the owner will be
|
||||||
|
-- different
|
||||||
|
if requestResult /= NamePrimaryOwner then
|
||||||
|
putStrLn "Another service owns \"org.xmonad\""
|
||||||
|
else do
|
||||||
|
putStrLn "Started xmonad dbus client"
|
||||||
|
exportBrightness client
|
||||||
|
export client "/test" defaultInterface
|
||||||
|
{ interfaceName = "test.iface"
|
||||||
|
, interfaceMethods = [ autoMethod "foo" onFoo ]
|
||||||
|
}
|
||||||
|
return client
|
||||||
|
|
||||||
|
stopXMonadService :: Client -> IO ()
|
||||||
|
stopXMonadService client = do
|
||||||
|
reply <- releaseName client "org.xmonad"
|
||||||
|
disconnect client
|
||||||
|
print reply
|
||||||
|
return ()
|
||||||
|
|
|
@ -0,0 +1,34 @@
|
||||||
|
module Xmobar.Backlight where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Concurrent
|
||||||
|
|
||||||
|
import Data.Int (Int32)
|
||||||
|
|
||||||
|
import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
import DBus.Backlight
|
||||||
|
|
||||||
|
import Xmobar
|
||||||
|
|
||||||
|
data Backlight = Backlight (String, String)
|
||||||
|
deriving (Read, Show)
|
||||||
|
|
||||||
|
instance Exec Backlight where
|
||||||
|
alias (Backlight _) = "betterbacklight"
|
||||||
|
start (Backlight _) cb = do
|
||||||
|
-- print "connecting"
|
||||||
|
client <- connectSession
|
||||||
|
_ <- addMatch client brMatcher $ \sig -> do
|
||||||
|
cb $ formatSignal sig
|
||||||
|
-- print sig
|
||||||
|
forever (threadDelay 5000)
|
||||||
|
|
||||||
|
formatSignal :: Signal -> String
|
||||||
|
formatSignal sig = -- show $ (map fromVariant $ signalBody sig :: [Maybe Int32])
|
||||||
|
case signalBody sig of
|
||||||
|
[] -> "N/A"
|
||||||
|
(x:_) -> case (fromVariant x :: Maybe Int32) of
|
||||||
|
Just i -> show i
|
||||||
|
Nothing -> "n/a"
|
|
@ -10,13 +10,18 @@ library
|
||||||
, Theme
|
, Theme
|
||||||
, Notify
|
, Notify
|
||||||
, Shell
|
, Shell
|
||||||
|
, DBus.Common
|
||||||
|
, DBus.Backlight
|
||||||
, Xmobar.Screensaver
|
, Xmobar.Screensaver
|
||||||
|
, Xmobar.Backlight
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, X11 >= 1.9.1
|
, X11 >= 1.9.1
|
||||||
, colour >= 2.3.5
|
, colour >= 2.3.5
|
||||||
, xmonad >= 0.13
|
, xmonad >= 0.13
|
||||||
, xmonad-contrib >= 0.13
|
, xmonad-contrib >= 0.13
|
||||||
, fdo-notify
|
, fdo-notify
|
||||||
|
, dbus >= 1.2.7
|
||||||
|
, text >= 1.2.3.1
|
||||||
, xmobar
|
, xmobar
|
||||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -32,6 +37,7 @@ executable xmonad
|
||||||
, process >= 1.6.5.0
|
, process >= 1.6.5.0
|
||||||
, directory >= 1.3.3.0
|
, directory >= 1.3.3.0
|
||||||
, containers >= 0.6.0.1
|
, containers >= 0.6.0.1
|
||||||
|
, dbus >= 1.2.7
|
||||||
, my-xmonad
|
, my-xmonad
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
|
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
|
||||||
|
@ -40,6 +46,7 @@ executable xmobar
|
||||||
main-is: bin/xmobar.hs
|
main-is: bin/xmobar.hs
|
||||||
build-depends: base
|
build-depends: base
|
||||||
, xmonad >= 0.13
|
, xmonad >= 0.13
|
||||||
|
, dbus >= 1.2.7
|
||||||
, xmobar
|
, xmobar
|
||||||
, my-xmonad
|
, my-xmonad
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in New Issue