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