summaryrefslogtreecommitdiff
path: root/accounts/gkleen@sif/taffybar/src/System
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2021-12-05 16:56:41 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2021-12-05 16:58:32 +0100
commite019e80eac1b03a5c177ef5d358b720bdbc774ac (patch)
treef2d86a62a62af8f2233c80c115b4943a379996dc /accounts/gkleen@sif/taffybar/src/System
parent73875ac457ec19f1cabb3d343e0c44c1b1171f3d (diff)
downloadnixos-e019e80eac1b03a5c177ef5d358b720bdbc774ac.tar
nixos-e019e80eac1b03a5c177ef5d358b720bdbc774ac.tar.gz
nixos-e019e80eac1b03a5c177ef5d358b720bdbc774ac.tar.bz2
nixos-e019e80eac1b03a5c177ef5d358b720bdbc774ac.tar.xz
nixos-e019e80eac1b03a5c177ef5d358b720bdbc774ac.zip
gkleen@sif: taffybar
Diffstat (limited to 'accounts/gkleen@sif/taffybar/src/System')
-rw-r--r--accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs111
-rw-r--r--accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs101
2 files changed, 212 insertions, 0 deletions
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 @@
1{-# LANGUAGE OverloadedStrings #-}
2module System.Taffybar.Widget.Clock
3 ( textClockNew
4 , textClockNewWith
5 , defaultClockConfig
6 , ClockConfig(..)
7 , ClockUpdateStrategy(..)
8 ) where
9
10import Control.Monad.IO.Class
11import Data.Maybe
12import qualified Data.Text as T
13import qualified Data.Time.Clock as Clock
14import Data.Time.Format
15import Data.Time.LocalTime
16import qualified Data.Time.Locale.Compat as L
17import GI.Gtk
18import System.Taffybar.Widget.Generic.PollingLabel
19
20type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text
21
22-- | Create the widget. I recommend passing @Nothing@ for the TimeLocale
23-- parameter. The format string can include Pango markup
24-- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>).
25textClockNew ::
26 MonadIO m => Maybe L.TimeLocale -> ClockFormat -> Double -> m GI.Gtk.Widget
27textClockNew userLocale format interval =
28 textClockNewWith cfg
29 where
30 cfg = defaultClockConfig { clockTimeLocale = userLocale
31 , clockFormat = format
32 , clockUpdateStrategy = ConstantInterval interval
33 }
34
35data ClockUpdateStrategy
36 = ConstantInterval Double
37 | RoundedTargetInterval Int Double
38 deriving (Eq, Ord, Show)
39
40data ClockConfig = ClockConfig
41 { clockTimeZone :: Maybe TimeZone
42 , clockTimeLocale :: Maybe L.TimeLocale
43 , clockFormat :: ClockFormat
44 , clockUpdateStrategy :: ClockUpdateStrategy
45 }
46
47-- | A clock configuration that defaults to the current locale
48defaultClockConfig :: ClockConfig
49defaultClockConfig = ClockConfig
50 { clockTimeZone = Nothing
51 , clockTimeLocale = Nothing
52 , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime
53 , clockUpdateStrategy = RoundedTargetInterval 5 0.0
54 }
55
56systemGetTZ :: IO TimeZone
57systemGetTZ = getCurrentTimeZone
58
59-- | A configurable text-based clock widget. It currently allows for
60-- a configurable time zone through the 'ClockConfig'.
61--
62-- See also 'textClockNew'.
63textClockNewWith :: MonadIO m => ClockConfig -> m Widget
64textClockNewWith ClockConfig
65 { clockTimeZone = userZone
66 , clockTimeLocale = userLocale
67 , clockFormat = format
68 , clockUpdateStrategy = updateStrategy
69 } = liftIO $ do
70 let getTZ = maybe systemGetTZ return userZone
71 locale = fromMaybe L.defaultTimeLocale userLocale
72
73 let getUserZonedTime =
74 utcToZonedTime <$> getTZ <*> Clock.getCurrentTime
75
76 doTimeFormat = format locale
77
78 getRoundedTimeAndNextTarget = do
79 zonedTime <- getUserZonedTime
80 return $ case updateStrategy of
81 ConstantInterval interval ->
82 (doTimeFormat zonedTime, Nothing, interval)
83 RoundedTargetInterval roundSeconds offset ->
84 let roundSecondsDiffTime = fromIntegral roundSeconds
85 addTheRound = addLocalTime roundSecondsDiffTime
86 localTime = zonedTimeToLocalTime zonedTime
87 ourLocalTimeOfDay = localTimeOfDay localTime
88 seconds = round $ todSec ourLocalTimeOfDay
89 secondsFactor = seconds `div` roundSeconds
90 displaySeconds = secondsFactor * roundSeconds
91 baseLocalTimeOfDay =
92 ourLocalTimeOfDay { todSec = fromIntegral displaySeconds }
93 ourLocalTime =
94 localTime { localTimeOfDay = baseLocalTimeOfDay }
95 roundedLocalTime =
96 if seconds `mod` roundSeconds > roundSeconds `div` 2
97 then addTheRound ourLocalTime
98 else ourLocalTime
99 roundedZonedTime =
100 zonedTime { zonedTimeToLocalTime = roundedLocalTime }
101 nextTarget = addTheRound ourLocalTime
102 amountToWait = realToFrac $ diffLocalTime nextTarget localTime
103 in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset)
104
105 label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget
106 ebox <- eventBoxNew
107 containerAdd ebox label
108 eventBoxSetVisibleWindow ebox False
109 widgetShowAll ebox
110 toWidget ebox
111
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 @@
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module System.Taffybar.Widget.TooltipBattery ( batteryIconTooltipNew ) where
4
5import Control.Applicative
6import Control.Monad
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Reader
9import Data.Int (Int64)
10import qualified Data.Text as T
11import GI.Gtk
12import Prelude
13import StatusNotifier.Tray (scalePixbufToSize)
14import System.Taffybar.Context
15import System.Taffybar.Information.Battery
16import System.Taffybar.Util
17import System.Taffybar.Widget.Generic.AutoSizeImage
18import System.Taffybar.Widget.Generic.ChannelWidget
19import Text.Printf
20import Text.StringTemplate
21import Data.Function ((&))
22
23-- | Just the battery info that will be used for display (this makes combining
24-- several easier).
25data BatteryWidgetInfo = BWI
26 { seconds :: Maybe Int64
27 , percent :: Double
28 , status :: String
29 , rate :: Maybe Double
30 } deriving (Eq, Show)
31
32-- | Format a duration expressed as seconds to hours and minutes
33formatDuration :: Int64 -> String
34formatDuration secs = let minutes, hours, minutes' :: Int64
35 minutes = secs `div` 60
36 (hours, minutes') = minutes `divMod` 60
37 in printf "%02d:%02d" hours minutes'
38
39getBatteryWidgetInfo :: BatteryInfo -> BatteryWidgetInfo
40getBatteryWidgetInfo info =
41 let battPctNum :: Double
42 battPctNum = batteryPercentage info
43 battTime :: Maybe Int64
44 battTime =
45 case batteryState info of
46 BatteryStateCharging -> Just $ batteryTimeToFull info
47 BatteryStateDischarging -> Just $ batteryTimeToEmpty info
48 _ -> Nothing
49 battStatus :: String
50 battStatus =
51 case batteryState info of
52 BatteryStateCharging -> "↑"
53 BatteryStateDischarging -> "↓"
54 BatteryStateEmpty -> "⤓"
55 BatteryStateFullyCharged -> "⤒"
56 _ -> "?"
57 battRate :: Maybe Double
58 battRate | rawRate < 0.1 = Nothing
59 | otherwise = Just rawRate
60 where rawRate = batteryEnergyRate info
61 in BWI{ seconds = battTime, percent = battPctNum, status = battStatus, rate = battRate }
62
63-- | Given (maybe summarized) battery info and format: provides the string to display
64formatBattInfo :: BatteryWidgetInfo -> String -> T.Text
65formatBattInfo info fmt =
66 let tpl = newSTMP fmt
67 tpl' = tpl
68 & setManyAttrib [ ("percentage", printf "%.0f" $ percent info)
69 , ("status", status info)
70 ]
71 & setManyAttrib [ ("time", formatDuration <$> seconds info)
72 , ("rate", printf "%.0f" <$> rate info)
73 ]
74 in render tpl'
75
76themeLoadFlags :: [IconLookupFlags]
77themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]
78
79batteryIconTooltipNew :: String -> TaffyIO Widget
80batteryIconTooltipNew format = do
81 DisplayBatteryChanVar (chan, _) <- setupDisplayBatteryChanVar ["IconName", "State", "Percentage", "TimeToFull", "TimeToEmpty", "EnergyRate"]
82 ctx <- ask
83 liftIO $ do
84 image <- imageNew
85 styleCtx <- widgetGetStyleContext =<< toWidget image
86 defaultTheme <- iconThemeGetDefault
87 let getCurrentBatteryIconNameStringTooltip = do
88 info <- runReaderT getDisplayBatteryInfo ctx
89 let iconNameString = T.pack $ batteryIconName info
90 tooltip = formatBattInfo (getBatteryWidgetInfo info) format
91 return (iconNameString, tooltip)
92 extractPixbuf info =
93 fst <$> iconInfoLoadSymbolicForContext info styleCtx
94 setIconForSize size = do
95 (name, tooltip) <- getCurrentBatteryIconNameStringTooltip
96 widgetSetTooltipMarkup image $ Just tooltip
97 iconThemeLookupIcon defaultTheme name size themeLoadFlags >>=
98 traverse extractPixbuf >>=
99 traverse (scalePixbufToSize size OrientationHorizontal)
100 updateImage <- autoSizeImage image setIconForSize OrientationHorizontal
101 toWidget =<< channelWidgetNew image chan (const $ postGUIASync updateImage)