gkleen@sif: taffybar

1 files changed, 101 insertions, 0 deletions

diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
new file mode 100644
index 00000000..9dc52774
--- /dev/null
+++ b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module System.Taffybar.Widget.TooltipBattery ( batteryIconTooltipNew ) where
+
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Reader
+import           Data.Int (Int64)
+import qualified Data.Text as T
+import           GI.Gtk
+import           Prelude
+import           StatusNotifier.Tray (scalePixbufToSize)
+import           System.Taffybar.Context
+import           System.Taffybar.Information.Battery
+import           System.Taffybar.Util
+import           System.Taffybar.Widget.Generic.AutoSizeImage
+import           System.Taffybar.Widget.Generic.ChannelWidget
+import           Text.Printf
+import           Text.StringTemplate
+import           Data.Function ((&))
+
+-- | Just the battery info that will be used for display (this makes combining
+-- several easier).
+data BatteryWidgetInfo = BWI
+  { seconds :: Maybe Int64
+  , percent :: Double
+  , status :: String
+  , rate :: Maybe Double
+  } deriving (Eq, Show)
+
+-- | Format a duration expressed as seconds to hours and minutes
+formatDuration :: Int64 -> String
+formatDuration secs = let minutes, hours, minutes' :: Int64
+                          minutes = secs `div` 60
+                          (hours, minutes') = minutes `divMod` 60
+                       in printf "%02d:%02d" hours minutes'
+
+getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
+getBatteryWidgetInfo info =
+  let battPctNum :: Double
+      battPctNum = batteryPercentage info
+      battTime :: Maybe Int64
+      battTime =
+        case batteryState info of
+          BatteryStateCharging -> Just $ batteryTimeToFull info
+          BatteryStateDischarging -> Just $ batteryTimeToEmpty info
+          _ -> Nothing
+      battStatus :: String
+      battStatus =
+        case batteryState info of
+          BatteryStateCharging -> "↑"
+          BatteryStateDischarging -> "↓"
+          BatteryStateEmpty -> "⤓"
+          BatteryStateFullyCharged -> "⤒"
+          _ -> "?"
+      battRate :: Maybe Double
+      battRate | rawRate < 0.1 = Nothing
+               | otherwise = Just rawRate
+        where rawRate = batteryEnergyRate info
+  in BWI{ seconds = battTime, percent = battPctNum, status = battStatus, rate = battRate }
+
+-- | Given (maybe summarized) battery info and format: provides the string to display
+formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
+formatBattInfo info fmt =
+  let tpl = newSTMP fmt
+      tpl' = tpl
+        & setManyAttrib [ ("percentage", printf "%.0f" $ percent info)
+                        , ("status", status info)
+                        ]
+        & setManyAttrib [ ("time", formatDuration <$> seconds info)
+                        , ("rate", printf "%.0f" <$> rate info)
+                        ]
+  in render tpl'
+
+themeLoadFlags :: [IconLookupFlags]
+themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]
+
+batteryIconTooltipNew :: String -> TaffyIO Widget
+batteryIconTooltipNew format = do
+  DisplayBatteryChanVar (chan, _) <- setupDisplayBatteryChanVar ["IconName", "State", "Percentage", "TimeToFull", "TimeToEmpty", "EnergyRate"]
+  ctx <- ask
+  liftIO $ do
+    image <- imageNew
+    styleCtx <- widgetGetStyleContext =<< toWidget image
+    defaultTheme <- iconThemeGetDefault
+    let getCurrentBatteryIconNameStringTooltip = do
+          info <- runReaderT getDisplayBatteryInfo ctx
+          let iconNameString = T.pack $ batteryIconName info
+              tooltip = formatBattInfo (getBatteryWidgetInfo info) format
+          return (iconNameString, tooltip)
+        extractPixbuf info =
+          fst <$> iconInfoLoadSymbolicForContext info styleCtx
+        setIconForSize size = do
+          (name, tooltip) <- getCurrentBatteryIconNameStringTooltip
+          widgetSetTooltipMarkup image $ Just tooltip
+          iconThemeLookupIcon defaultTheme name size themeLoadFlags >>=
+            traverse extractPixbuf >>=
+              traverse (scalePixbufToSize size OrientationHorizontal)
+    updateImage <- autoSizeImage image setIconForSize OrientationHorizontal
+    toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage)