diff --git a/src/QBar/BlockText.hs b/src/QBar/BlockText.hs index 878cc9ce7dde2eb3d1a8d6e9161800b86f393993..2a58914baacb1df28217b80366325c5e8227fc89 100644 --- a/src/QBar/BlockText.hs +++ b/src/QBar/BlockText.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module QBar.BlockText where import qualified Data.Text.Lazy as T @@ -26,14 +28,15 @@ data BlockTextSegment = BlockTextSegment { type Importance = Float + normalImportant :: Importance -normalImportant = 0 +normalImportant = 1 warnImportant :: Importance -warnImportant = 1 +warnImportant = 2 errorImportant :: Importance -errorImportant = 2 +errorImportant = 3 criticalImportant :: Importance -criticalImportant = 3 +criticalImportant = 4 isCritical :: Importance -> Bool isCritical i @@ -57,6 +60,38 @@ isNormal i | isWarning i = False | otherwise = True +toImportance :: Real a => (a, a, a, a, a, a) -> a -> Importance +toImportance (tMax, tCrit, tErr, tWarn, tNorm, tMin) = + toImportance' (Just tMax, tCrit, tErr, tWarn, tNorm, Just tMin) + +toImportance' :: forall a. Real a => (Maybe a, a, a, a, a, Maybe a) -> a -> Importance +toImportance' (tMax, tCrit, tErr, tWarn, tNorm, tMin) val + | tCrit <= val = 4 + valueCrit tMax tCrit val + | tErr <= val = 3 + linearMatch tCrit tErr val + | tWarn <= val = 2 + linearMatch tErr tWarn val + | tNorm <= val = 1 + linearMatch tWarn tNorm val + | otherwise = 0 + valueOtherwise tNorm tMin val + where + e :: Importance + e = exp 1 + linearMatch :: a -> a -> a -> Importance + linearMatch u l v = frac (v - l) (u - l) + logarithmicMatch :: a -> a -> Importance + logarithmicMatch l u = 1 - 1 / log (e + realToFrac (u - l)) + frac :: a -> a -> Importance + frac a b = realToFrac a / realToFrac b + valueCrit :: Maybe a -> a -> a -> Importance + valueCrit (Just tMax') tCrit' v + | tMax' > v = linearMatch tMax' tCrit' v + | otherwise = 1 + valueCrit Nothing tCrit' v = logarithmicMatch tCrit' v + valueOtherwise :: a -> Maybe a -> a -> Importance + valueOtherwise tNorm' (Just tMin') v + | tMin' < v = linearMatch tNorm' tMin' v + | otherwise = 0 + valueOtherwise tNorm' Nothing v = 1 - logarithmicMatch v tNorm' + + removePango :: BlockText -> T.Text removePango (BlockText b) = foldr ((<>) . removePangoFromSegment) "" b where diff --git a/src/QBar/Blocks/Battery.hs b/src/QBar/Blocks/Battery.hs index 7a380bc57ed17610be58e385159b0d488cd4a2ed..470d17f121862d82c552ab6a9ff049e6ab586ea8 100644 --- a/src/QBar/Blocks/Battery.hs +++ b/src/QBar/Blocks/Battery.hs @@ -106,29 +106,22 @@ batteryBlockOutput isPlugged bs = (shortText.~shortText') . createBlock <$> full perSingleBatteryArrow :: BatteryState -> T.Text perSingleBatteryArrow b - | BatteryCharging <- _status b = "⬆" - | BatteryDischarging <- _status b = "⬇" + | BatteryCharging <- _status b = "▲" + | BatteryDischarging <- _status b = "▼" | otherwise = T.empty perSingleBattery :: BatteryState -> BlockText - perSingleBattery b = importantText (batteryImportance bs) $ perSingleBatteryArrow b <> (formatFloatN 0 . batteryPercentage) [b] <> "%" + perSingleBattery b = importantText (batteryImportance [b]) $ perSingleBatteryArrow b <> (formatFloatN 0 . batteryPercentage) [b] <> "%" overallPercentage :: BlockText - overallPercentage = activeImportantText (batteryImportance bs) $ (formatFloatN 0 . batteryPercentage $ bs) <> "%" + overallPercentage = mkText (not isPlugged) (batteryImportance bs) $ (formatFloatN 0 . batteryPercentage $ bs) <> "%" optionalOverallEstimate :: BlockText optionalOverallEstimate = maybe mempty (\s -> surroundWith normalText " (" ")" s) . batteryEstimateFormated $ bs batteryImportance :: [BatteryState] -> Importance -batteryImportance batteryStates - | percentage < 10 = 4 - percentage / 10 - | percentage < 35 = 3 - (percentage - 10) / 25 - | percentage < 75 = 2 - (percentage - 35) / 40 - | otherwise = 1 - (percentage - 75) / 25 - where - percentage :: Float - percentage = batteryPercentage batteryStates +batteryImportance = toImportance (100, 90, 80, 60, 50, 0) . (100-) . batteryPercentage batteryPercentage :: [BatteryState] -> Float