ADD clevo keyboard brightness controls
This commit is contained in:
parent
81830a8e96
commit
4da3024dc7
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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]
|
||||
}
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue