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
{ csAlias = "intelbacklight"
{ csAlias = blAlias
, csRunnable = Run $ IntelBacklight "<fn=1>\xf185</fn>"
}
ckCmd :: CmdSpec
ckCmd = CmdSpec
{ csAlias = ckAlias
, csRunnable = Run $ ClevoKeyboard ("<fn=1>\xf40b</fn>", T.fgColor, T.backdropFgColor) 5
, csRunnable = Run $ ClevoKeyboard "<fn=1>\xf40b</fn>"
}
ssCmd :: CmdSpec

View File

@ -51,6 +51,7 @@ import XMonad.Internal.Concurrent.ACPIEvent
import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Control
@ -552,6 +553,10 @@ externalBindings ts lock =
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin 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-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
, 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.
data BrightnessConfig a b = BrightnessConfig
{ bcMin :: a -> IO b
, bcMax :: a -> IO b
, bcDec :: a -> IO b
, bcInc :: a -> IO b
, bcGet :: a -> IO b
{ bcMin :: (a, a) -> IO b
, bcMax :: (a, a) -> IO b
, bcDec :: (a, a) -> IO b
, bcInc :: (a, a) -> IO b
, bcGet :: (a, a) -> IO b
, bcMinRaw :: a
, bcGetMax :: IO a
, bcPath :: ObjectPath
, bcInterface :: InterfaceName
@ -72,8 +73,9 @@ signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
client <- connectSession
-- this connections must remain active
-- TODO does this need to be cleaned up during shutdown??
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
-- TODO disconnect here?
where
brMatcher = matchAny
{ matchPath = Just p
@ -96,7 +98,8 @@ brightnessExporter deps bc@BrightnessConfig { bcName = n } client = Feature
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
exportBrightnessControls' bc client = do
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
export client (bcPath bc) defaultInterface
{ interfaceName = bcInterface bc
@ -105,7 +108,7 @@ exportBrightnessControls' bc client = do
, autoMethod' memMin bcMin
, autoMethod' memInc bcInc
, autoMethod' memDec bcDec
, autoMethod memGet (round <$> funget maxval :: IO Int32)
, autoMethod memGet (round <$> funget bounds :: IO Int32)
]
, interfaceSignals = [sig]
}

View File

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

View File

@ -19,6 +19,7 @@ import Data.Either
import DBus
import DBus.Client
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common
import XMonad.Internal.DBus.Screensaver
@ -36,7 +37,7 @@ startXMonadService = do
forM_ client $ \c -> do
requestXMonadName c
mapM_ (\f -> executeFeature_ $ f c)
[exportScreensaver, exportIntelBacklight]
[exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
return client
stopXMonadService :: Client -> IO ()
@ -54,8 +55,7 @@ getDBusClient = do
requestXMonadName :: Client -> IO ()
requestXMonadName client = do
res <- requestName client xmonadBusName []
-- TODO if the client is not released on shutdown the owner will be
-- different
-- TODO if the client is not released on shutdown the owner will be different
let msg | res == NamePrimaryOwner = Nothing
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
| 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
-- (percent).
rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => a -> b -> c
rawToPercent upper raw = 100 * (fromIntegral raw - 1) / (fromIntegral upper - 1)
rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
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 upper path = do
readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
readPercent bounds path = do
i <- readInt path
return $ rawToPercent upper (i :: Integer)
return $ rawToPercent bounds (i :: Integer)
percentToRaw :: (Integral a, RealFrac b, Integral c) => a -> b -> c
percentToRaw upper perc = round $ 1 + perc / 100.0 * (fromIntegral upper - 1)
percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
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 upper path perc = do
writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b
writePercent bounds path perc = do
let t | perc > 100 = 100
| perc < 0 = 0
| otherwise = perc
writeInt path (percentToRaw upper t :: Int)
writeInt path (percentToRaw bounds t :: Int)
return t
writePercentMin :: (Integral a, RealFrac b) => a -> FilePath -> IO b
writePercentMin upper path = writePercent upper path 0
writePercentMin :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
writePercentMin bounds path = writePercent bounds path 0
writePercentMax :: (Integral a, RealFrac b) => a -> FilePath -> IO b
writePercentMax upper path = writePercent upper path 100
writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b
writePercentMax bounds path = writePercent bounds path 100
shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
-> a -> IO b
shiftPercent f steps path upper = writePercent upper path . f stepsize
=<< readPercent upper path
-> (a, a) -> IO b
shiftPercent f steps path bounds = writePercent bounds path . f stepsize
=<< readPercent bounds path
where
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 (+)
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
--------------------------------------------------------------------------------

View File

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

View File

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