diff --git a/bin/xmobar.hs b/bin/xmobar.hs
index f008188..f82b121 100644
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@@ -179,14 +179,14 @@ alsaCmd = CmdSpec
blCmd :: CmdSpec
blCmd = CmdSpec
- { csAlias = "intelbacklight"
+ { csAlias = blAlias
, csRunnable = Run $ IntelBacklight "\xf185"
}
ckCmd :: CmdSpec
ckCmd = CmdSpec
{ csAlias = ckAlias
- , csRunnable = Run $ ClevoKeyboard ("\xf40b", T.fgColor, T.backdropFgColor) 5
+ , csRunnable = Run $ ClevoKeyboard "\xf40b"
}
ssCmd :: CmdSpec
diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 4352b34..bb6df9e 100644
--- a/bin/xmonad.hs
+++ b/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-" "power menu" $ ConstFeature $ runPowerPrompt lock
, KeyBinding "M-" "quit xmonad" $ ConstFeature runQuitPrompt
, KeyBinding "M-" "lock screen" runScreenLock
diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
new file mode 100644
index 0000000..fd3de7f
--- /dev/null
+++ b/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
diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 341f2a5..ae8484c 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/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
- , 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]
}
diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
index cc3984f..29f5a32 100644
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/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 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"
diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs
index 159157f..46f59be 100644
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/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
- -- 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
diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs
index dd25951..7fe81c8 100644
--- a/lib/XMonad/Internal/IO.hs
+++ b/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 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
--------------------------------------------------------------------------------
diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs
index b09bcfd..7b59f2b 100644
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/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 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"
diff --git a/my-xmonad.cabal b/my-xmonad.cabal
index 1f07edc..d0bbaf5 100644
--- a/my-xmonad.cabal
+++ b/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