From e019e80eac1b03a5c177ef5d358b720bdbc774ac Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 5 Dec 2021 16:56:41 +0100 Subject: gkleen@sif: taffybar --- .../taffybar/src/System/Taffybar/Widget/Clock.hs | 111 +++++++++++++++++++++ .../src/System/Taffybar/Widget/TooltipBattery.hs | 101 +++++++++++++++++++ 2 files changed, 212 insertions(+) create mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs create mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs (limited to 'accounts/gkleen@sif/taffybar/src/System') diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs new file mode 100644 index 00000000..e8dc480f --- /dev/null +++ b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} +module System.Taffybar.Widget.Clock + ( textClockNew + , textClockNewWith + , defaultClockConfig + , ClockConfig(..) + , ClockUpdateStrategy(..) + ) where + +import Control.Monad.IO.Class +import Data.Maybe +import qualified Data.Text as T +import qualified Data.Time.Clock as Clock +import Data.Time.Format +import Data.Time.LocalTime +import qualified Data.Time.Locale.Compat as L +import GI.Gtk +import System.Taffybar.Widget.Generic.PollingLabel + +type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text + +-- | Create the widget. I recommend passing @Nothing@ for the TimeLocale +-- parameter. The format string can include Pango markup +-- (). +textClockNew :: + MonadIO m => Maybe L.TimeLocale -> ClockFormat -> Double -> m GI.Gtk.Widget +textClockNew userLocale format interval = + textClockNewWith cfg + where + cfg = defaultClockConfig { clockTimeLocale = userLocale + , clockFormat = format + , clockUpdateStrategy = ConstantInterval interval + } + +data ClockUpdateStrategy + = ConstantInterval Double + | RoundedTargetInterval Int Double + deriving (Eq, Ord, Show) + +data ClockConfig = ClockConfig + { clockTimeZone :: Maybe TimeZone + , clockTimeLocale :: Maybe L.TimeLocale + , clockFormat :: ClockFormat + , clockUpdateStrategy :: ClockUpdateStrategy + } + +-- | A clock configuration that defaults to the current locale +defaultClockConfig :: ClockConfig +defaultClockConfig = ClockConfig + { clockTimeZone = Nothing + , clockTimeLocale = Nothing + , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime + , clockUpdateStrategy = RoundedTargetInterval 5 0.0 + } + +systemGetTZ :: IO TimeZone +systemGetTZ = getCurrentTimeZone + +-- | A configurable text-based clock widget. It currently allows for +-- a configurable time zone through the 'ClockConfig'. +-- +-- See also 'textClockNew'. +textClockNewWith :: MonadIO m => ClockConfig -> m Widget +textClockNewWith ClockConfig + { clockTimeZone = userZone + , clockTimeLocale = userLocale + , clockFormat = format + , clockUpdateStrategy = updateStrategy + } = liftIO $ do + let getTZ = maybe systemGetTZ return userZone + locale = fromMaybe L.defaultTimeLocale userLocale + + let getUserZonedTime = + utcToZonedTime <$> getTZ <*> Clock.getCurrentTime + + doTimeFormat = format locale + + getRoundedTimeAndNextTarget = do + zonedTime <- getUserZonedTime + return $ case updateStrategy of + ConstantInterval interval -> + (doTimeFormat zonedTime, Nothing, interval) + RoundedTargetInterval roundSeconds offset -> + let roundSecondsDiffTime = fromIntegral roundSeconds + addTheRound = addLocalTime roundSecondsDiffTime + localTime = zonedTimeToLocalTime zonedTime + ourLocalTimeOfDay = localTimeOfDay localTime + seconds = round $ todSec ourLocalTimeOfDay + secondsFactor = seconds `div` roundSeconds + displaySeconds = secondsFactor * roundSeconds + baseLocalTimeOfDay = + ourLocalTimeOfDay { todSec = fromIntegral displaySeconds } + ourLocalTime = + localTime { localTimeOfDay = baseLocalTimeOfDay } + roundedLocalTime = + if seconds `mod` roundSeconds > roundSeconds `div` 2 + then addTheRound ourLocalTime + else ourLocalTime + roundedZonedTime = + zonedTime { zonedTimeToLocalTime = roundedLocalTime } + nextTarget = addTheRound ourLocalTime + amountToWait = realToFrac $ diffLocalTime nextTarget localTime + in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset) + + label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget + ebox <- eventBoxNew + containerAdd ebox label + eventBoxSetVisibleWindow ebox False + widgetShowAll ebox + toWidget ebox + 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) -- cgit v1.2.3