packages feed

taffybar-5.2.0: 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) =>
  -- | Widget containing the window icon strip.
  Gtk.Widget ->
  -- | Workspace label widget.
  Gtk.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 ::
  -- | Which scaling implementation to use.
  ImageScaleStrategy ->
  -- | Optional size request for the icon image.
  Maybe Int32 ->
  -- | Whether to render a transparent placeholder when there is no data.
  Bool ->
  -- | Icon pixbuf getter.
  (Int32 -> a -> IO (Maybe Gdk.Pixbuf)) ->
  -- | Transparent placeholder pixbuf generator.
  (Int32 -> IO Gdk.Pixbuf) ->
  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}