254 lines
8.2 KiB
Haskell
254 lines
8.2 KiB
Haskell
--------------------------------------------------------------------------------
|
|
-- | DBus module for Intel Backlight control
|
|
|
|
module XMonad.Internal.DBus.IntelBacklight
|
|
( callDecBrightness
|
|
, callGetBrightness
|
|
, callIncBrightness
|
|
, callMaxBrightness
|
|
, callMinBrightness
|
|
, exportIntelBacklight
|
|
, matchSignal
|
|
, hasBacklight
|
|
, blPath
|
|
, BacklightControls(..)
|
|
) where
|
|
|
|
import Control.Monad (void)
|
|
|
|
import Data.Char
|
|
import Data.Either
|
|
import Data.Int (Int16, Int32)
|
|
import Data.Text (pack, unpack)
|
|
import Data.Text.IO as T (readFile, writeFile)
|
|
|
|
import DBus
|
|
import DBus.Client
|
|
|
|
import System.Directory
|
|
import System.FilePath.Posix
|
|
import System.IO.Error
|
|
|
|
import XMonad.Internal.DBus.Common
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Low level sysfs functions
|
|
--
|
|
-- Distinguish between "raw" brightness "normalized" brightness with two type
|
|
-- synonyms. The former is the value read directly in sysfs and generally goes
|
|
-- from 1 (min brightness) to some multiple 1000's number (note that raw values
|
|
-- of 0 turn the monitor off). The latter is the raw brightness scaled from 0 to
|
|
-- 10000 (which can easily be converted to a percent).
|
|
|
|
-- use strict IO here, the data in these files is literally 1-10 bytes
|
|
|
|
-- TODO this is hacky but not sure if there is a cleaner way to enforce type
|
|
-- checking between these without making two new types and adding Integral
|
|
-- instances to both of them
|
|
type Brightness = Int16
|
|
|
|
type RawBrightness = Int32
|
|
|
|
maxBrightness :: Brightness
|
|
maxBrightness = 10000
|
|
|
|
steps :: Brightness
|
|
steps = 16
|
|
|
|
backlightDir :: FilePath
|
|
backlightDir = "/sys/class/backlight/intel_backlight/"
|
|
|
|
maxFile :: FilePath
|
|
maxFile = backlightDir </> "max_brightness"
|
|
|
|
curFile :: FilePath
|
|
curFile = backlightDir </> "brightness"
|
|
|
|
readFileInt :: FilePath -> IO RawBrightness
|
|
readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
|
|
|
|
getMaxRawBrightness :: IO RawBrightness
|
|
getMaxRawBrightness = readFileInt maxFile
|
|
|
|
getRawBrightness :: IO RawBrightness
|
|
getRawBrightness = readFileInt curFile
|
|
|
|
setRawBrightness :: RawBrightness -> IO ()
|
|
setRawBrightness = T.writeFile curFile . pack . show
|
|
|
|
-- TODO this has rounding errors that make the steps uneven
|
|
rawToNorm :: RawBrightness -> RawBrightness -> Brightness
|
|
rawToNorm maxRaw curRaw = fromIntegral
|
|
$ (curRaw - 1) * maxNorm `div` (maxRaw - 1)
|
|
where
|
|
maxNorm = fromIntegral maxBrightness :: Int32
|
|
|
|
normToRaw :: RawBrightness -> Brightness -> RawBrightness
|
|
normToRaw maxRaw curNorm = curNorm' * (maxRaw - 1) `div` maxNorm + 1
|
|
where
|
|
curNorm' = fromIntegral curNorm :: Int32
|
|
maxNorm = fromIntegral maxBrightness :: Int32
|
|
|
|
truncateNorm :: Brightness -> Brightness
|
|
truncateNorm = min maxBrightness . max 0
|
|
|
|
getBrightness :: RawBrightness -> IO Brightness
|
|
getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
|
|
|
|
changeBrightness :: RawBrightness -> Brightness -> IO Brightness
|
|
changeBrightness maxRaw delta = setBrightness maxRaw
|
|
. (+ delta) =<< getBrightness maxRaw
|
|
|
|
setBrightness :: RawBrightness -> Brightness -> IO Brightness
|
|
setBrightness maxRaw newNorm = do
|
|
let newNorm' = truncateNorm newNorm
|
|
setRawBrightness $ normToRaw maxRaw newNorm'
|
|
return newNorm'
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Access checks
|
|
|
|
-- | determine if backlight is accessible/present
|
|
-- Right True -> backlight accessible and present
|
|
-- Right False -> backlight not present
|
|
-- Left x -> backlight present but could not access (x explaining why)
|
|
hasBacklight' :: IO (Either String Bool)
|
|
hasBacklight' = do
|
|
mx <- doesFileExist maxFile
|
|
cx <- doesFileExist curFile
|
|
if not $ mx || cx
|
|
then return $ Right False
|
|
else do
|
|
mp <- tryIOError $ readable <$> getPermissions maxFile
|
|
cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
|
|
return $ case (mp, cp) of
|
|
(Right True, Right True) -> Right True
|
|
(Right _, Right _) -> Left "Insufficient permissions for backlight files"
|
|
_ -> Left "Could not determine backlight file permissions"
|
|
|
|
msg :: Either String Bool -> IO ()
|
|
msg (Right True) = return ()
|
|
msg (Right False) = print ("No backlight detected. Controls disabled" :: String)
|
|
msg (Left m) = print ("WARNING: " ++ m)
|
|
|
|
hasBacklightMsg :: IO Bool
|
|
hasBacklightMsg = do
|
|
b <- hasBacklight'
|
|
msg b
|
|
return $ fromRight False b
|
|
|
|
hasBacklight :: IO Bool
|
|
hasBacklight = fromRight False <$> hasBacklight'
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | DBus interface
|
|
--
|
|
-- Define four methods to increase, decrease, maximize, or minimize the
|
|
-- brightness. These methods will all return the current brightness as a 32-bit
|
|
-- integer and emit a signal with the same brightness value. Additionally, there
|
|
-- is one method to get the current brightness.
|
|
|
|
blPath :: ObjectPath
|
|
blPath = objectPath_ "/intelbacklight"
|
|
|
|
interface :: InterfaceName
|
|
interface = interfaceName_ "org.xmonad.Brightness"
|
|
|
|
memCurrentBrightness :: MemberName
|
|
memCurrentBrightness = memberName_ "CurrentBrightness"
|
|
|
|
memGetBrightness :: MemberName
|
|
memGetBrightness = memberName_ "GetBrightness"
|
|
|
|
memMaxBrightness :: MemberName
|
|
memMaxBrightness = memberName_ "MaxBrightness"
|
|
|
|
memMinBrightness :: MemberName
|
|
memMinBrightness = memberName_ "MinBrightness"
|
|
|
|
memIncBrightness :: MemberName
|
|
memIncBrightness = memberName_ "IncBrightness"
|
|
|
|
memDecBrightness :: MemberName
|
|
memDecBrightness = memberName_ "DecBrightness"
|
|
|
|
brSignal :: Signal
|
|
brSignal = signal blPath interface memCurrentBrightness
|
|
-- { signalDestination = Just "org.xmonad" }
|
|
|
|
brMatcher :: MatchRule
|
|
brMatcher = matchAny
|
|
{ matchPath = Just blPath
|
|
, matchInterface = Just interface
|
|
, matchMember = Just memCurrentBrightness
|
|
}
|
|
|
|
callBacklight :: MemberName -> IO ()
|
|
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
|
|
|
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
|
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
|
|
bodyGetBrightness _ = Nothing
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Exported haskell API
|
|
|
|
data BacklightControls = BacklightControls
|
|
{ backlightMax :: IO ()
|
|
, backlightMin :: IO ()
|
|
, backlightUp :: IO ()
|
|
, backlightDown :: IO ()
|
|
}
|
|
|
|
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
|
|
exportIntelBacklight client = do
|
|
b <- hasBacklightMsg
|
|
if b then Just <$> exportIntelBacklight' client else return Nothing
|
|
|
|
exportIntelBacklight' :: Client -> IO BacklightControls
|
|
exportIntelBacklight' client = do
|
|
maxval <- getMaxRawBrightness -- assume the max value will never change
|
|
let stepsize = maxBrightness `div` steps
|
|
let emit' = emitBrightness client
|
|
export client blPath defaultInterface
|
|
{ interfaceName = interface
|
|
, interfaceMethods =
|
|
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
|
|
, autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
|
|
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
|
|
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
|
|
, autoMethod memGetBrightness $ getBrightness maxval
|
|
]
|
|
}
|
|
return $ BacklightControls
|
|
{ backlightMax = callMaxBrightness
|
|
, backlightMin = callMinBrightness
|
|
, backlightUp = callIncBrightness
|
|
, backlightDown = callDecBrightness
|
|
}
|
|
|
|
emitBrightness :: Client -> Brightness -> IO ()
|
|
emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] }
|
|
|
|
callMaxBrightness :: IO ()
|
|
callMaxBrightness = callBacklight memMaxBrightness
|
|
|
|
callMinBrightness :: IO ()
|
|
callMinBrightness = callBacklight memMinBrightness
|
|
|
|
callIncBrightness :: IO ()
|
|
callIncBrightness = callBacklight memIncBrightness
|
|
|
|
callDecBrightness :: IO ()
|
|
callDecBrightness = callBacklight memDecBrightness
|
|
|
|
callGetBrightness :: IO (Maybe Brightness)
|
|
callGetBrightness = do
|
|
reply <- callMethod $ methodCall blPath interface memGetBrightness
|
|
return $ reply >>= bodyGetBrightness
|
|
|
|
matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
|
matchSignal cb = do
|
|
client <- connectSession
|
|
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
|