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 +++++++++++++++++++ accounts/gkleen@sif/taffybar/src/taffybar.hs | 83 +++++++++++++++ 3 files changed, 295 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 create mode 100644 accounts/gkleen@sif/taffybar/src/taffybar.hs (limited to 'accounts/gkleen@sif/taffybar/src') 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) diff --git a/accounts/gkleen@sif/taffybar/src/taffybar.hs b/accounts/gkleen@sif/taffybar/src/taffybar.hs new file mode 100644 index 00000000..dd713ea7 --- /dev/null +++ b/accounts/gkleen@sif/taffybar/src/taffybar.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import System.Taffybar (startTaffybar) +import System.Taffybar.Context (TaffybarConfig(..)) +import System.Taffybar.Hooks +import System.Taffybar.SimpleConfig hiding (SimpleTaffyConfig(cssPath)) +import System.Taffybar.Widget +import qualified System.Taffybar.Widget.Clock as MyClock +import System.Taffybar.Widget.TooltipBattery + +import Data.Time.Format +import Data.Time.LocalTime +import Data.Time.Calendar.WeekDate + +import qualified Data.Text as T + +import Control.Exception (SomeException, try) +import Control.Monad.Trans.Reader (mapReaderT) + +import Paths_gkleen_sif_taffybar + + +main :: IO () +main = do + myCssPath <- getDataFileName "taffybar.css" + startTaffybar exampleTaffybarConfig{ cssPath = Just myCssPath } + + +exampleTaffybarConfig :: TaffybarConfig +exampleTaffybarConfig = + let myWorkspacesConfig = + defaultWorkspacesConfig + { maxIcons = Just 0 + , widgetGap = 7 + , showWorkspaceFn = \case + -- Workspace{ workspaceState = Empty } -> False + Workspace{ workspaceName } | workspaceName == "NSP" -> False + _other -> True + , getWindowIconPixbuf = \i d -> either (\(_ :: SomeException) -> Nothing) id <$> mapReaderT try (defaultGetWindowIconPixbuf i d) + } + workspaces = workspacesNew myWorkspacesConfig + clock = MyClock.textClockNewWith MyClock.defaultClockConfig + { MyClock.clockUpdateStrategy = MyClock.RoundedTargetInterval 1 0.0 + , MyClock.clockFormat = \tl zt@ZonedTime{ zonedTimeToLocalTime = LocalTime{ localDay } } + -> let date = formatTime tl "%Y-%m-%d" localDay + weekdate = "W" <> show2 woy <> "-" <> show dow + where (_, woy, dow) = toWeekDate localDay + show2 :: Int -> String + show2 x = replicate (2 - length s) '0' ++ s + where s = show x + time = formatTime tl "%H:%M:%S%Ez" zt + in T.intercalate " " $ map T.pack [date, weekdate, time] + } + layout = layoutNew defaultLayoutConfig + windowsW = windowsNew defaultWindowsConfig + { getMenuLabel = truncatedGetMenuLabel 80 + , getActiveLabel = truncatedGetActiveLabel 80 + } + worktime = commandRunnerNew 150 "worktime" [] "worktime" + worktimeToday = commandRunnerNew 150 "worktime" ["today"] "worktime today" + -- See https://github.com/taffybar/gtk-sni-tray#statusnotifierwatcher + -- for a better way to set up the sni tray + -- tray = sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt + tray = sniTrayNew + myConfig = defaultSimpleTaffyConfig + { startWidgets = + workspaces : map (>>= buildContentsBox) [ layout, windowsW ] + , endWidgets = map (>>= buildContentsBox) $ reverse + -- , mpris2New + [ worktime, worktimeToday + , clock + , tray + , batteryIconTooltipNew "$status$ $percentage$%$if(time)$$if(rate)$ ($rate$W $time$)$else$ ($time$)$endif$$elseif(rate)$ ($rate$W)$endif$" + ] + , barPosition = Top + , barPadding = 2 + , barHeight = 28 + , widgetSpacing = 10 + } + in withBatteryRefresh $ withLogServer $ + withToggleServer $ toTaffyConfig myConfig -- cgit v1.2.3