ADD clevo keyboard brightness controls

This commit is contained in:
Nathan Dwarshuis 2021-11-21 00:42:40 -05:00
parent 81830a8e96
commit 4da3024dc7
9 changed files with 203 additions and 69 deletions

View File

@ -179,14 +179,14 @@ alsaCmd = CmdSpec
blCmd :: CmdSpec blCmd :: CmdSpec
blCmd = CmdSpec blCmd = CmdSpec
{ csAlias = "intelbacklight" { csAlias = blAlias
, csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>" , csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>"
} }
ckCmd :: CmdSpec ckCmd :: CmdSpec
ckCmd = CmdSpec ckCmd = CmdSpec
{ csAlias = ckAlias { csAlias = ckAlias
, csRunnable = Run $ ClevoKeyboard ("<fn=1>\xf40b</fn>", T.fgColor, T.backdropFgColor) 5 , csRunnable = Run $ ClevoKeyboard "<fn=1>\xf40b</fn>"
} }
ssCmd :: CmdSpec ssCmd :: CmdSpec

View File

@ -51,6 +51,7 @@ import XMonad.Internal.Concurrent.ACPIEvent
import XMonad.Internal.Concurrent.ClientMessage import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.Common import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Control
@ -552,6 +553,10 @@ externalBindings ts lock =
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
, KeyBinding "M-S-." "keyboard up" $ ioFeature $ bctlInc clevoKeyboardControls
, KeyBinding "M-S-," "keyboard down" $ ioFeature $ bctlDec clevoKeyboardControls
, KeyBinding "M-S-M1-," "keyboard min" $ ioFeature $ bctlMin clevoKeyboardControls
, KeyBinding "M-S-M1-." "keyboard max" $ ioFeature $ bctlMax clevoKeyboardControls
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock , KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock

View File

@ -0,0 +1,131 @@
--------------------------------------------------------------------------------
-- | DBus module for Clevo Keyboard control
module XMonad.Internal.DBus.Brightness.ClevoKeyboard
( callGetBrightnessCK
, matchSignalCK
, exportClevoKeyboard
, clevoKeyboardControls
, clevoKeyboardSignalDep
, blPath
) where
import Control.Monad (when)
import Data.Int (Int32)
import DBus
import DBus.Client
import System.FilePath.Posix
import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.Dependency
import XMonad.Internal.IO
--------------------------------------------------------------------------------
-- | Low level sysfs functions
--
type Brightness = Float
type RawBrightness = Int32
type RawBounds = (RawBrightness, RawBrightness)
steps :: Int
steps = 16
-- assume this is hardcoded into the driver and will never change
maxRawBrightness :: RawBrightness
maxRawBrightness = 255
minRawBrightness :: RawBrightness
minRawBrightness = 0
backlightDir :: FilePath
backlightDir = "/sys/devices/platform/tuxedo_keyboard"
stateFile :: FilePath
stateFile = backlightDir </> "state"
stateChange :: Bool -> IO ()
stateChange = writeBool stateFile
stateOn :: IO ()
stateOn = stateChange True
stateOff :: IO ()
stateOff = stateChange False
brightnessFile :: FilePath
brightnessFile = backlightDir </> "brightness"
getBrightness :: RawBounds -> IO Brightness
getBrightness bounds = readPercent bounds brightnessFile
minBrightness :: RawBounds -> IO Brightness
minBrightness bounds = do
b <- writePercentMin bounds brightnessFile
stateOff
return b
maxBrightness :: RawBounds -> IO Brightness
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
incBrightness :: RawBounds -> IO Brightness
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
decBrightness :: RawBounds -> IO Brightness
decBrightness bounds = do
b <- decPercent steps brightnessFile bounds
print b
when (b == 0) stateOff
return b
--------------------------------------------------------------------------------
-- | DBus interface
blPath :: ObjectPath
blPath = objectPath_ "/clevo_keyboard"
interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness"
clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
clevoKeyboardConfig = BrightnessConfig
{ bcMin = minBrightness
, bcMax = maxBrightness
, bcInc = incBrightness
, bcDec = decBrightness
, bcGet = getBrightness
, bcGetMax = return maxRawBrightness
, bcMinRaw = minRawBrightness
, bcPath = blPath
, bcInterface = interface
, bcName = "Clevo keyboard"
}
--------------------------------------------------------------------------------
-- | Exported haskell API
stateFileDep :: Dependency
stateFileDep = pathRW stateFile
brightnessFileDep :: Dependency
brightnessFileDep = pathR brightnessFile
clevoKeyboardSignalDep :: Dependency
clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
exportClevoKeyboard :: Client -> FeatureIO
exportClevoKeyboard =
brightnessExporter [stateFileDep, brightnessFileDep] clevoKeyboardConfig
clevoKeyboardControls :: BrightnessControls
clevoKeyboardControls = brightnessControls clevoKeyboardConfig
callGetBrightnessCK :: IO (Maybe Brightness)
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
matchSignalCK :: (Maybe Brightness -> IO ()) -> IO SignalHandler
matchSignalCK = matchSignal clevoKeyboardConfig

View File

@ -31,11 +31,12 @@ import XMonad.Internal.Dependency
-- is one method to get the current brightness. -- is one method to get the current brightness.
data BrightnessConfig a b = BrightnessConfig data BrightnessConfig a b = BrightnessConfig
{ bcMin :: a -> IO b { bcMin :: (a, a) -> IO b
, bcMax :: a -> IO b , bcMax :: (a, a) -> IO b
, bcDec :: a -> IO b , bcDec :: (a, a) -> IO b
, bcInc :: a -> IO b , bcInc :: (a, a) -> IO b
, bcGet :: a -> IO b , bcGet :: (a, a) -> IO b
, bcMinRaw :: a
, bcGetMax :: IO a , bcGetMax :: IO a
, bcPath :: ObjectPath , bcPath :: ObjectPath
, bcInterface :: InterfaceName , bcInterface :: InterfaceName
@ -72,8 +73,9 @@ signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
client <- connectSession client <- connectSession
-- this connections must remain active
-- TODO does this need to be cleaned up during shutdown??
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
-- TODO disconnect here?
where where
brMatcher = matchAny brMatcher = matchAny
{ matchPath = Just p { matchPath = Just p
@ -96,7 +98,8 @@ brightnessExporter deps bc@BrightnessConfig { bcName = n } client = Feature
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO () exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
exportBrightnessControls' bc client = do exportBrightnessControls' bc client = do
maxval <- bcGetMax bc -- assume the max value will never change maxval <- bcGetMax bc -- assume the max value will never change
let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval let bounds = (bcMinRaw bc, maxval)
let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc bounds
let funget = bcGet bc let funget = bcGet bc
export client (bcPath bc) defaultInterface export client (bcPath bc) defaultInterface
{ interfaceName = bcInterface bc { interfaceName = bcInterface bc
@ -105,7 +108,7 @@ exportBrightnessControls' bc client = do
, autoMethod' memMin bcMin , autoMethod' memMin bcMin
, autoMethod' memInc bcInc , autoMethod' memInc bcInc
, autoMethod' memDec bcDec , autoMethod' memDec bcDec
, autoMethod memGet (round <$> funget maxval :: IO Int32) , autoMethod memGet (round <$> funget bounds :: IO Int32)
] ]
, interfaceSignals = [sig] , interfaceSignals = [sig]
} }

View File

@ -28,9 +28,14 @@ type Brightness = Float
type RawBrightness = Int32 type RawBrightness = Int32
type RawBounds = (RawBrightness, RawBrightness)
steps :: Int steps :: Int
steps = 16 steps = 16
minRawBrightness :: RawBrightness
minRawBrightness = 1
backlightDir :: FilePath backlightDir :: FilePath
backlightDir = "/sys/class/backlight/intel_backlight/" backlightDir = "/sys/class/backlight/intel_backlight/"
@ -43,19 +48,19 @@ curFile = backlightDir </> "brightness"
getMaxRawBrightness :: IO RawBrightness getMaxRawBrightness :: IO RawBrightness
getMaxRawBrightness = readInt maxFile getMaxRawBrightness = readInt maxFile
getBrightness :: RawBrightness -> IO Brightness getBrightness :: RawBounds -> IO Brightness
getBrightness upper = readPercent upper curFile getBrightness bounds = readPercent bounds curFile
minBrightness :: RawBrightness -> IO Brightness minBrightness :: RawBounds -> IO Brightness
minBrightness upper = writePercentMin upper curFile minBrightness bounds = writePercentMin bounds curFile
maxBrightness :: RawBrightness -> IO Brightness maxBrightness :: RawBounds -> IO Brightness
maxBrightness upper = writePercentMax upper curFile maxBrightness bounds = writePercentMax bounds curFile
incBrightness :: RawBrightness -> IO Brightness incBrightness :: RawBounds -> IO Brightness
incBrightness = incPercent steps curFile incBrightness = incPercent steps curFile
decBrightness :: RawBrightness -> IO Brightness decBrightness :: RawBounds -> IO Brightness
decBrightness = decPercent steps curFile decBrightness = decPercent steps curFile
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -75,6 +80,7 @@ intelBacklightConfig = BrightnessConfig
, bcDec = decBrightness , bcDec = decBrightness
, bcGet = getBrightness , bcGet = getBrightness
, bcGetMax = getMaxRawBrightness , bcGetMax = getMaxRawBrightness
, bcMinRaw = minRawBrightness
, bcPath = blPath , bcPath = blPath
, bcInterface = interface , bcInterface = interface
, bcName = "Intel backlight" , bcName = "Intel backlight"

View File

@ -19,6 +19,7 @@ import Data.Either
import DBus import DBus
import DBus.Client import DBus.Client
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
@ -36,7 +37,7 @@ startXMonadService = do
forM_ client $ \c -> do forM_ client $ \c -> do
requestXMonadName c requestXMonadName c
mapM_ (\f -> executeFeature_ $ f c) mapM_ (\f -> executeFeature_ $ f c)
[exportScreensaver, exportIntelBacklight] [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
return client return client
stopXMonadService :: Client -> IO () stopXMonadService :: Client -> IO ()
@ -54,8 +55,7 @@ getDBusClient = do
requestXMonadName :: Client -> IO () requestXMonadName :: Client -> IO ()
requestXMonadName client = do requestXMonadName client = do
res <- requestName client xmonadBusName [] res <- requestName client xmonadBusName []
-- TODO if the client is not released on shutdown the owner will be -- TODO if the client is not released on shutdown the owner will be different
-- different
let msg | res == NamePrimaryOwner = Nothing let msg | res == NamePrimaryOwner = Nothing
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
| res == NameInQueue | res == NameInQueue

View File

@ -56,42 +56,45 @@ writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
-- given by a runtime argument, which is scaled linearly to the range 0-100 -- given by a runtime argument, which is scaled linearly to the range 0-100
-- (percent). -- (percent).
rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => a -> b -> c rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
rawToPercent upper raw = 100 * (fromIntegral raw - 1) / (fromIntegral upper - 1) rawToPercent (lower, upper) raw =
100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)
-- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
readPercent :: (Integral a, RealFrac b) => a -> FilePath -> IO b readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
readPercent upper path = do readPercent bounds path = do
i <- readInt path i <- readInt path
return $ rawToPercent upper (i :: Integer) return $ rawToPercent bounds (i :: Integer)
percentToRaw :: (Integral a, RealFrac b, Integral c) => a -> b -> c percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
percentToRaw upper perc = round $ 1 + perc / 100.0 * (fromIntegral upper - 1) percentToRaw (lower, upper) perc = round $
fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
writePercent :: (Integral a, RealFrac b) => a -> FilePath -> b -> IO b writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
writePercent upper path perc = do writePercent bounds path perc = do
let t | perc > 100 = 100 let t | perc > 100 = 100
| perc < 0 = 0 | perc < 0 = 0
| otherwise = perc | otherwise = perc
writeInt path (percentToRaw upper t :: Int) writeInt path (percentToRaw bounds t :: Int)
return t return t
writePercentMin :: (Integral a, RealFrac b) => a -> FilePath -> IO b writePercentMin :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
writePercentMin upper path = writePercent upper path 0 writePercentMin bounds path = writePercent bounds path 0
writePercentMax :: (Integral a, RealFrac b) => a -> FilePath -> IO b writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
writePercentMax upper path = writePercent upper path 100 writePercentMax bounds path = writePercent bounds path 100
shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
-> a -> IO b -> (a, a) -> IO b
shiftPercent f steps path upper = writePercent upper path . f stepsize shiftPercent f steps path bounds = writePercent bounds path . f stepsize
=<< readPercent upper path =<< readPercent bounds path
where where
stepsize = 100 / fromIntegral steps stepsize = 100 / fromIntegral steps
incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
incPercent = shiftPercent (+) incPercent = shiftPercent (+)
decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b
decPercent = shiftPercent subtract -- silly (-) operator thingy error decPercent = shiftPercent subtract -- silly (-) operator thingy error
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------

View File

@ -1,3 +1,5 @@
{-# LANGUAGE LambdaCase #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Clevo Keyboard plugin -- | Clevo Keyboard plugin
-- --
@ -9,43 +11,26 @@ module Xmobar.Plugins.ClevoKeyboard
, ckAlias , ckAlias
) where ) where
import Data.Char import Control.Concurrent
import Data.Text (unpack) import Control.Monad
import Data.Text.IO as T (readFile)
import Xmobar import Xmobar
import XMonad.Hooks.DynamicLog (xmobarColor) import XMonad.Internal.DBus.Brightness.ClevoKeyboard
-- import XMonad.Internal.DBus.IntelBacklight data ClevoKeyboard = ClevoKeyboard String
data ClevoKeyboard = ClevoKeyboard (String, String, String) Int
deriving (Read, Show) deriving (Read, Show)
ckAlias :: String ckAlias :: String
ckAlias = "clevokeyboard" ckAlias = "clevokeyboard"
brightnessFile :: FilePath
brightnessFile = "/sys/devices/platform/tuxedo_keyboard/brightness"
stateFile :: FilePath
stateFile = "/sys/devices/platform/tuxedo_keyboard/state"
readBrightness :: FilePath -> IO Integer
readBrightness file = read . takeWhile isDigit . unpack <$> T.readFile file
readState :: FilePath -> IO Bool
readState file = (==1) <$> readBrightness file
instance Exec ClevoKeyboard where instance Exec ClevoKeyboard where
alias (ClevoKeyboard _ _) = ckAlias alias (ClevoKeyboard _) = ckAlias
rate (ClevoKeyboard _ r) = r start (ClevoKeyboard icon) cb = do
run (ClevoKeyboard (icon, colorOn, colorOff) _) = do _ <- matchSignalCK $ cb . formatBrightness
b <- readBrightness brightnessFile cb . formatBrightness =<< callGetBrightnessCK
s <- readState stateFile forever (threadDelay 5000000)
return $ formatBrightness s (fromIntegral b :: Double)
where where
formatBrightness s b = formatBrightness = \case
let iconColor = if s then colorOn else colorOff Just b -> icon ++ show (round b :: Integer) ++ "%"
n = show (round $ b / 255 * 100 :: Integer) ++ "%" Nothing -> "N/A"
in xmobarColor iconColor "" icon ++ n

View File

@ -19,6 +19,7 @@ library
, XMonad.Internal.Command.Power , XMonad.Internal.Command.Power
, XMonad.Internal.DBus.Common , XMonad.Internal.DBus.Common
, XMonad.Internal.DBus.Brightness.IntelBacklight , XMonad.Internal.DBus.Brightness.IntelBacklight
, XMonad.Internal.DBus.Brightness.ClevoKeyboard
, XMonad.Internal.DBus.Brightness.Common , XMonad.Internal.DBus.Brightness.Common
, XMonad.Internal.DBus.Control , XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver , XMonad.Internal.DBus.Screensaver