taffybar-4.1.2: src/System/Taffybar/Widget/Workspaces/Shared.hs
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : System.Taffybar.Widget.Workspaces.Shared
-- Copyright : (c) Ivan A. Malison
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Ivan A. Malison
-- Stability : unstable
-- Portability : unportable
--
-- Shared UI helpers for workspace widgets (X11/EWMH and Hyprland).
--
-----------------------------------------------------------------------------
module System.Taffybar.Widget.Workspaces.Shared
( WorkspaceState(..)
, getCSSClass
, cssWorkspaceStates
, setWorkspaceWidgetStatusClass
, buildWorkspaceIconLabelOverlay
, mkWorkspaceIconWidget
) where
import qualified Control.Concurrent.MVar as MV
import Control.Monad
import Control.Monad.IO.Class (MonadIO(..))
import Data.Int (Int32)
import qualified Data.Text as T
import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
import qualified GI.Gtk as Gtk
import System.Taffybar.Widget.Generic.AutoSizeImage (ImageScaleStrategy)
import System.Taffybar.Widget.Generic.ScalingImage (scalingImageNew)
import System.Taffybar.Widget.Util
( WindowIconWidget(..)
, buildBottomLeftAlignedBox
, buildContentsBox
, buildOverlayWithPassThrough
, mkWindowIconWidgetBase
, updateWidgetClasses
, widgetSetClassGI
)
data WorkspaceState
= Active
| Visible
| Hidden
| Empty
| Urgent
deriving (Show, Eq)
getCSSClass :: (Show s) => s -> T.Text
getCSSClass = T.toLower . T.pack . show
cssWorkspaceStates :: [T.Text]
cssWorkspaceStates = map getCSSClass [Active, Visible, Hidden, Empty, Urgent]
setWorkspaceWidgetStatusClass ::
(MonadIO m, Gtk.IsWidget a) => WorkspaceState -> a -> m ()
setWorkspaceWidgetStatusClass ws widget =
updateWidgetClasses
widget
[getCSSClass ws]
cssWorkspaceStates
-- | Build the common overlay layout used by workspace widgets:
-- window icons are the base content and the workspace label is overlaid in the
-- bottom-left corner.
buildWorkspaceIconLabelOverlay ::
MonadIO m =>
Gtk.Widget -> -- ^ Widget containing the window icon strip.
Gtk.Widget -> -- ^ Workspace label widget.
m Gtk.Widget
buildWorkspaceIconLabelOverlay iconsWidget labelWidget = do
base <- buildContentsBox iconsWidget
overlayLabel <- buildBottomLeftAlignedBox "overlay-box" labelWidget
buildOverlayWithPassThrough base [overlayLabel]
-- | Build a 'WindowIconWidget' that automatically scales with allocation and
-- displays a transparent placeholder pixbuf when requested.
--
-- This is shared by both X11 and Hyprland workspace widgets so that CSS classes
-- and widget behavior remain consistent across backends.
mkWorkspaceIconWidget ::
ImageScaleStrategy -> -- ^ Which scaling implementation to use.
Maybe Int32 -> -- ^ Optional size request for the icon image.
Bool -> -- ^ Whether to render a transparent placeholder when there is no data.
(Int32 -> a -> IO (Maybe Gdk.Pixbuf)) -> -- ^ Icon pixbuf getter.
(Int32 -> IO Gdk.Pixbuf) -> -- ^ Transparent placeholder pixbuf generator.
IO (WindowIconWidget a)
mkWorkspaceIconWidget strategy mSize transparentOnNone getPixbufFor mkTransparent = do
base <- mkWindowIconWidgetBase mSize
let getPixbuf size = do
mWin <- MV.readMVar (iconWindow base)
case mWin of
Nothing ->
if transparentOnNone
then Just <$> mkTransparent size
else return Nothing
Just w -> do
pb <- getPixbufFor size w
case pb of
Just _ -> return pb
Nothing ->
if transparentOnNone
then Just <$> mkTransparent size
else return Nothing
(imageWidget, refreshImage) <-
scalingImageNew strategy getPixbuf Gtk.OrientationHorizontal
_ <- widgetSetClassGI imageWidget "window-icon"
forM_ mSize $ \s ->
Gtk.widgetSetSizeRequest imageWidget (fromIntegral s) (fromIntegral s)
Gtk.containerAdd (iconContainer base) imageWidget
return base { iconImage = imageWidget, iconForceUpdate = refreshImage }