FIX rounding errors in brightness control
This commit is contained in:
parent
aee786eb51
commit
b831ace369
|
@ -18,7 +18,7 @@ import Control.Monad (void)
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Int (Int16, Int32)
|
import Data.Int (Int32)
|
||||||
import Data.Text (pack, unpack)
|
import Data.Text (pack, unpack)
|
||||||
import Data.Text.IO as T (readFile, writeFile)
|
import Data.Text.IO as T (readFile, writeFile)
|
||||||
|
|
||||||
|
@ -42,10 +42,7 @@ import XMonad.Internal.DBus.Common
|
||||||
|
|
||||||
-- use strict IO here, the data in these files is literally 1-10 bytes
|
-- 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
|
type Brightness = Float
|
||||||
-- checking between these without making two new types and adding Integral
|
|
||||||
-- instances to both of them
|
|
||||||
type Brightness = Int16
|
|
||||||
|
|
||||||
type RawBrightness = Int32
|
type RawBrightness = Int32
|
||||||
|
|
||||||
|
@ -64,6 +61,9 @@ maxFile = backlightDir </> "max_brightness"
|
||||||
curFile :: FilePath
|
curFile :: FilePath
|
||||||
curFile = backlightDir </> "brightness"
|
curFile = backlightDir </> "brightness"
|
||||||
|
|
||||||
|
toFloat :: Integral a => a -> Float
|
||||||
|
toFloat = fromIntegral
|
||||||
|
|
||||||
readFileInt :: FilePath -> IO RawBrightness
|
readFileInt :: FilePath -> IO RawBrightness
|
||||||
readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
|
readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
|
||||||
|
|
||||||
|
@ -76,18 +76,11 @@ getRawBrightness = readFileInt curFile
|
||||||
setRawBrightness :: RawBrightness -> IO ()
|
setRawBrightness :: RawBrightness -> IO ()
|
||||||
setRawBrightness = T.writeFile curFile . pack . show
|
setRawBrightness = T.writeFile curFile . pack . show
|
||||||
|
|
||||||
-- TODO this has rounding errors that make the steps uneven
|
|
||||||
rawToNorm :: RawBrightness -> RawBrightness -> Brightness
|
rawToNorm :: RawBrightness -> RawBrightness -> Brightness
|
||||||
rawToNorm maxRaw curRaw = fromIntegral
|
rawToNorm maxb cur = maxBrightness * (toFloat cur - 1) / (toFloat maxb - 1)
|
||||||
$ (curRaw - 1) * maxNorm `div` (maxRaw - 1)
|
|
||||||
where
|
|
||||||
maxNorm = fromIntegral maxBrightness :: Int32
|
|
||||||
|
|
||||||
normToRaw :: RawBrightness -> Brightness -> RawBrightness
|
normToRaw :: RawBrightness -> Brightness -> RawBrightness
|
||||||
normToRaw maxRaw curNorm = curNorm' * (maxRaw - 1) `div` maxNorm + 1
|
normToRaw maxb cur = round $ 1 + cur / maxBrightness * (toFloat maxb - 1)
|
||||||
where
|
|
||||||
curNorm' = fromIntegral curNorm :: Int32
|
|
||||||
maxNorm = fromIntegral maxBrightness :: Int32
|
|
||||||
|
|
||||||
truncateNorm :: Brightness -> Brightness
|
truncateNorm :: Brightness -> Brightness
|
||||||
truncateNorm = min maxBrightness . max 0
|
truncateNorm = min maxBrightness . max 0
|
||||||
|
@ -187,7 +180,7 @@ callBacklight :: MemberName -> IO ()
|
||||||
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
||||||
|
|
||||||
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
||||||
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
|
bodyGetBrightness [b] = toFloat <$> (fromVariant b :: Maybe Int32)
|
||||||
bodyGetBrightness _ = Nothing
|
bodyGetBrightness _ = Nothing
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -208,7 +201,7 @@ exportIntelBacklight client = do
|
||||||
exportIntelBacklight' :: Client -> IO BacklightControls
|
exportIntelBacklight' :: Client -> IO BacklightControls
|
||||||
exportIntelBacklight' client = do
|
exportIntelBacklight' client = do
|
||||||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
maxval <- getMaxRawBrightness -- assume the max value will never change
|
||||||
let stepsize = maxBrightness `div` steps
|
let stepsize = maxBrightness / steps
|
||||||
let emit' = emitBrightness client
|
let emit' = emitBrightness client
|
||||||
export client blPath defaultInterface
|
export client blPath defaultInterface
|
||||||
{ interfaceName = interface
|
{ interfaceName = interface
|
||||||
|
@ -217,7 +210,7 @@ exportIntelBacklight' client = do
|
||||||
, autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
|
, autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
|
||||||
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
|
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
|
||||||
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
|
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
|
||||||
, autoMethod memGetBrightness $ getBrightness maxval
|
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
return $ BacklightControls
|
return $ BacklightControls
|
||||||
|
@ -228,7 +221,8 @@ exportIntelBacklight' client = do
|
||||||
}
|
}
|
||||||
|
|
||||||
emitBrightness :: Client -> Brightness -> IO ()
|
emitBrightness :: Client -> Brightness -> IO ()
|
||||||
emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] }
|
emitBrightness client cur = emit client
|
||||||
|
$ brSignal { signalBody = [toVariant (round cur :: Int32)] }
|
||||||
|
|
||||||
callMaxBrightness :: IO ()
|
callMaxBrightness :: IO ()
|
||||||
callMaxBrightness = callBacklight memMaxBrightness
|
callMaxBrightness = callBacklight memMaxBrightness
|
||||||
|
|
|
@ -31,5 +31,5 @@ instance Exec IntelBacklight where
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
formatBrightness = \case
|
formatBrightness = \case
|
||||||
Just b -> icon ++ show (b `div` 100) ++ "%"
|
Just b -> icon ++ show (round $ b / 100 :: Integer) ++ "%"
|
||||||
Nothing -> "N/A"
|
Nothing -> "N/A"
|
||||||
|
|
Loading…
Reference in New Issue