From e019e80eac1b03a5c177ef5d358b720bdbc774ac Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
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 <nixpkgs> {}).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
+-- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>).
+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