From 673a7f5f07d7a56276d0ed13a8902812b85a5e2e Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Fri, 20 Mar 2020 00:51:36 -0400 Subject: [PATCH] WIP add backlight to dbus --- bin/xmobar.hs | 8 ++- bin/xmonad.hs | 23 ++++++--- lib/DBus/Backlight.hs | 111 ++++++++++++++++++++++++++++++++++++++++ lib/DBus/Common.hs | 39 ++++++++++++++ lib/Xmobar/Backlight.hs | 34 ++++++++++++ my-xmonad.cabal | 7 +++ 6 files changed, 212 insertions(+), 10 deletions(-) create mode 100644 lib/DBus/Backlight.hs create mode 100644 lib/DBus/Common.hs create mode 100644 lib/Xmobar/Backlight.hs diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 6c0aa3b..cbafa53 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -1,3 +1,4 @@ +-- import Xmobar.Backlight import Xmobar.Screensaver import qualified Theme as T @@ -25,6 +26,7 @@ myTemplate = formatTemplate left right , "%alsa:default:Master%" , "%battery%" , "%bright%" + -- , "%betterbacklight%" , "%screensaver%" , "%locks%" , "%date%" @@ -52,8 +54,8 @@ blockFont = T.fmtFontXFT T.font } config :: String -> Config -config confDir = defaultConfig { - font = barFont +config confDir = defaultConfig + { font = barFont , additionalFonts = [ iconFont, blockFont ] , textOffset = 16 , textOffsets = [ 16, 17 ] @@ -103,6 +105,8 @@ config confDir = defaultConfig { , "-D", "intel_backlight" ] 10 + -- , Run $ Backlight ("", "") + , Run $ Wireless "wlp0s20f3" [ "-t", "" , "--" diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 466beb2..35836d2 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -7,6 +7,10 @@ import ACPI import SendXMsg import Notify import Shell +import DBus.Client (Client) + +import DBus.Common +import DBus.Backlight import qualified Theme as T @@ -75,11 +79,12 @@ import XMonad.Util.Run import qualified XMonad.StackSet as W main = do + dbClient <- startXMonadService (barPID, h) <- spawnPipe' "xmobar" pwrPID <- spawnPID "powermon" launch $ ewmh - $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID]) + $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient) $ def { terminal = myTerm , modMask = myModMask , layoutHook = myLayouts @@ -436,8 +441,10 @@ runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace runGimp :: X () runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace -runCleanup :: [ProcessID] -> X () -runCleanup ps = io $ mapM_ killPID ps +runCleanup :: [ProcessID] -> Client -> X () +runCleanup ps client = io $ do + mapM_ killPID ps + stopXMonadService client killPID :: ProcessID -> IO () killPID pID = do @@ -509,10 +516,10 @@ runDecBacklight :: X () runDecBacklight = spawnCmd "adj_backlight" ["down"] runMinBacklight :: X () -runMinBacklight = spawnCmd "adj_backlight" ["min"] +runMinBacklight = io callMinBrightness runMaxBacklight :: X () -runMaxBacklight = spawnCmd "adj_backlight" ["max"] +runMaxBacklight = io callMaxBrightness showWorkspace tag = windows $ W.view tag @@ -557,8 +564,8 @@ mkNamedSubmap c sectionName bindings = -- NOTE: the following bindings are used by dunst: -- "M-~", "M-", "M-S-", "M-S-." -myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)] -myKeys hs c = +myKeys :: [ProcessID] -> Client -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)] +myKeys hs client c = mkNamedSubmap c "Window Layouts" [ ("M-j", addName "focus down" $ windows W.focusDown) , ("M-k", addName "focus up" $ windows W.focusUp) @@ -640,7 +647,7 @@ myKeys hs c = , ("M-M1-.", addName "backlight max" runMaxBacklight) , ("M-M1-=", addName "enable screensaver" enableDPMS) , ("M-M1--", addName "disable screensaver" disableDPMS) - , ("M-", addName "restart xmonad" $ runCleanup hs >> runRestart) + , ("M-", addName "restart xmonad" $ runCleanup hs client >> runRestart) , ("M-S-", addName "recompile xmonad" runRecompile) , ("M-", addName "power menu" myPowerPrompt) , ("M-", addName "quit xmonad" myQuitPrompt) diff --git a/lib/DBus/Backlight.hs b/lib/DBus/Backlight.hs new file mode 100644 index 0000000..2804b74 --- /dev/null +++ b/lib/DBus/Backlight.hs @@ -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)] } diff --git a/lib/DBus/Common.hs b/lib/DBus/Common.hs new file mode 100644 index 0000000..7616efb --- /dev/null +++ b/lib/DBus/Common.hs @@ -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 () + diff --git a/lib/Xmobar/Backlight.hs b/lib/Xmobar/Backlight.hs new file mode 100644 index 0000000..13e05f5 --- /dev/null +++ b/lib/Xmobar/Backlight.hs @@ -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" diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 8d78f6b..3ea6309 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -10,13 +10,18 @@ library , Theme , Notify , Shell + , DBus.Common + , DBus.Backlight , Xmobar.Screensaver + , Xmobar.Backlight build-depends: base , X11 >= 1.9.1 , colour >= 2.3.5 , xmonad >= 0.13 , xmonad-contrib >= 0.13 , fdo-notify + , dbus >= 1.2.7 + , text >= 1.2.3.1 , xmobar ghc-options: -Wall -Werror -fno-warn-missing-signatures default-language: Haskell2010 @@ -32,6 +37,7 @@ executable xmonad , process >= 1.6.5.0 , directory >= 1.3.3.0 , containers >= 0.6.0.1 + , dbus >= 1.2.7 , my-xmonad default-language: Haskell2010 ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded @@ -40,6 +46,7 @@ executable xmobar main-is: bin/xmobar.hs build-depends: base , xmonad >= 0.13 + , dbus >= 1.2.7 , xmobar , my-xmonad default-language: Haskell2010