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 --- accounts/gkleen@sif/taffybar/default.nix | 2 + .../gkleen@sif/taffybar/gkleen-sif-taffybar.cabal | 31 +++++ .../taffybar/src/System/Taffybar/Widget/Clock.hs | 111 ++++++++++++++++ .../src/System/Taffybar/Widget/TooltipBattery.hs | 101 ++++++++++++++ accounts/gkleen@sif/taffybar/src/taffybar.hs | 83 ++++++++++++ accounts/gkleen@sif/taffybar/taffybar.css | 146 +++++++++++++++++++++ 6 files changed, 474 insertions(+) create mode 100644 accounts/gkleen@sif/taffybar/default.nix create mode 100644 accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal 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 create mode 100644 accounts/gkleen@sif/taffybar/taffybar.css (limited to 'accounts/gkleen@sif/taffybar') diff --git a/accounts/gkleen@sif/taffybar/default.nix b/accounts/gkleen@sif/taffybar/default.nix new file mode 100644 index 00000000..98366d8f --- /dev/null +++ b/accounts/gkleen@sif/taffybar/default.nix @@ -0,0 +1,2 @@ +{ haskellPackages ? (import {}).haskellPackages }: +haskellPackages.callCabal2nix "gkleen-sif-taffybar" ./. {} diff --git a/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal b/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal new file mode 100644 index 00000000..7f56dece --- /dev/null +++ b/accounts/gkleen@sif/taffybar/gkleen-sif-taffybar.cabal @@ -0,0 +1,31 @@ +name: gkleen-sif-taffybar +version: 0.0.0 +build-type: Simple +cabal-version: >=1.10 + +data-files: taffybar.css + +executable taffybar + hs-source-dirs: src + main-is: taffybar.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall + build-depends: base + , containers + , directory + , filepath + , gtk3 + , taffybar + , X11>=1.8 + , transformers + , gi-gtk + , time, time-locale-compat + , text + , HStringTemplate + , gtk-sni-tray + other-modules: Paths_gkleen_sif_taffybar + , System.Taffybar.Widget.Clock + , System.Taffybar.Widget.TooltipBattery + default-language: Haskell2010 + default-extensions: ScopedTypeVariables + , LambdaCase + , NamedFieldPuns \ No newline at end of file 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 diff --git a/accounts/gkleen@sif/taffybar/taffybar.css b/accounts/gkleen@sif/taffybar/taffybar.css new file mode 100644 index 00000000..7a297465 --- /dev/null +++ b/accounts/gkleen@sif/taffybar/taffybar.css @@ -0,0 +1,146 @@ +@define-color transparent rgba(0.0, 0.0, 0.0, 0.0); +@define-color white #808080; +@define-color gray #202020; +@define-color green #008000; +@define-color yellow #808000; +@define-color blue #000080; +@define-color red #800000; +@define-color black #000000; +/* @define-color taffy-blue #0c7cd5; */ +@define-color taffy-blue @blue; + +@define-color active-window-color @white; +@define-color urgent-window-color @taffy-blue; +@define-color font-color @white; +@define-color menu-background-color @black; +@define-color menu-font-color @white; + +/* Top level styling */ + +.taffy-window * { + /* + This removes any existing styling from UI elements. Taffybar will not + cohere with your gtk theme. + */ + all: unset; + + font-family: "Fira Sans", sans-serif; + font-size: 21px; + color: @font-color; +} + +.taffy-box { + /* border-radius: 10px; */ + background-color: @black; +} + +.inner-pad { + /* padding-bottom: 5px; */ + /* padding-top: 5px; */ + padding-left: 2px; + padding-right: 2px; +} + +.contents { + /* padding-bottom: 4px; */ + /* padding-top: 4px; */ + padding-right: 2px; + padding-left: 2px; + transition: background-color .5s; + border-radius: 5px; +} + +/* Workspaces styling */ + +.workspace-label { + padding-right: 3px; + padding-left: 2px; + font-size: 21px; +} + +.workspace-label.active { + color: @green; +} +.workspace-label.visible { + color: @yellow; +} +.workspace-label.empty { + color: @gray; +} +.workspace-label.urgent { + color: @red; +} + +.active .contents { + background-color: rgba(0.0, 0.0, 0.0, 0.5); +} + +.visible .contents { + background-color: rgba(0.0, 0.0, 0.0, 0.2); +} + +.window-icon-container { + transition: opacity .5s, box-shadow .5s; + opacity: 1; +} + +/* This gives space for the box-shadow (they look like underlines) that follow. + This will actually affect all widgets, (not just the workspace icons), but + that is what we want since we want the icons to look the same. */ +.auto-size-image, .sni-tray { + padding-top: 3px; + padding-bottom: 3px; +} + +.window-icon-container.active { + box-shadow: inset 0 -3px @white; +} + +.window-icon-container.urgent { + box-shadow: inset 0 -3px @urgent-window-color; +} + +.window-icon-container.inactive .window-icon { + padding: 0px; +} + +.window-icon-container.minimized .window-icon { + opacity: .3; +} + +.window-icon { + opacity: 1; + transition: opacity .5s; +} + +/* Button styling */ + +button { + background-color: @transparent; + border-width: 0px; + border-radius: 0px; +} + +button:checked, button:hover .Contents:hover { + box-shadow: inset 0 -3px @taffy-blue; +} + +/* Menu styling */ + +/* The ".taffy-window" prefixed selectors are needed because if they aren't present, + the top level .Taffybar selector takes precedence */ +.taffy-window menuitem *, menuitem * { + color: @menu-font-color; +} + +.taffy-window menuitem, menuitem { + background-color: @menu-background-color; +} + +.taffy-window menuitem:hover, menuitem:hover { + background-color: @taffy-blue; +} + +.taffy-window menuitem:hover > label, menuitem:hover > label { + color: @white; +} -- cgit v1.2.3