From 37e55957fbf411b928184465acb2b1ecd5ca6852 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 17 Jan 2025 22:20:56 +0100 Subject: mako --- .../taffybar/src/System/Taffybar/Widget/Clock.hs | 111 --------------------- .../src/System/Taffybar/Widget/TooltipBattery.hs | 101 ------------------- 2 files changed, 212 deletions(-) delete mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs delete mode 100644 accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs (limited to 'accounts/gkleen@sif/taffybar/src/System/Taffybar') diff --git a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs b/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs deleted file mode 100644 index e8dc480f..00000000 --- a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/Clock.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# 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 deleted file mode 100644 index 9dc52774..00000000 --- a/accounts/gkleen@sif/taffybar/src/System/Taffybar/Widget/TooltipBattery.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# 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