ADD clevo keyboard brightness controls

bin/xmobar.hs

@@ -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

bin/xmonad.hs

@@ -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

lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs

@@ -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

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -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
+  { 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
   , 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]
     }

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -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 :: 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
 
-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"

lib/XMonad/Internal/DBus/Control.hs

@@ -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
+  -- TODO if the client is not released on shutdown the owner will be different
-  -- different
   let msg | res == NamePrimaryOwner = Nothing
           | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
           | res == NameInQueue

lib/XMonad/Internal/IO.hs

@@ -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 :: (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
-  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
         | 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 :: (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
-  -> 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
     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
 
 --------------------------------------------------------------------------------

lib/Xmobar/Plugins/ClevoKeyboard.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 --------------------------------------------------------------------------------
 -- | Clevo Keyboard plugin
 --
@@ -9,43 +11,26 @@ module Xmobar.Plugins.ClevoKeyboard
   , ckAlias
   ) where
 
-import           Data.Char
+import           Control.Concurrent
-import           Data.Text               (unpack)
+import           Control.Monad
-import           Data.Text.IO            as T (readFile)
 
 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)
 
 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
+  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
-      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

my-xmonad.cabal

@@ -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