ScalingImage.hs

-- | Unified interface for auto-scaling image widgets.
--
-- This module dispatches between the two image scaling implementations
-- ('autoSizeImage' and 'autoFillImage') based on an 'ImageScaleStrategy'.
-- All call sites should use 'scalingImage' (TaffyIO) or 'scalingImageNew'
-- (plain IO with an explicit strategy) instead of calling the underlying
-- implementations directly.
module System.Taffybar.Widget.Generic.ScalingImage
  ( scalingImageNew,
    scalingImage,
    getScalingImageStrategy,
    setScalingImageStrategy,
  )
where

import Control.Monad
import Control.Monad.IO.Class
import Data.Int
import Data.Typeable
import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
import qualified GI.Gtk as Gtk
import Graphics.UI.GIGtkScalingImage (scalePixbufToSize)
import System.Taffybar.Context
import System.Taffybar.Widget.Generic.AutoFillImage (autoFillImage)
import System.Taffybar.Widget.Generic.AutoSizeImage
  ( ImageScaleStrategy (..),
    autoSizeImage,
  )

newtype ScalingImageStrategySetting
  = ScalingImageStrategySetting ImageScaleStrategy
  deriving (Typeable)

-- | Create a scaling image widget using the given strategy.
--
-- Returns a @(widget, refreshAction)@ pair. The widget is a generic
-- 'Gtk.Widget' regardless of which strategy is used.
scalingImageNew ::
  ImageScaleStrategy ->
  (Int32 -> IO (Maybe Gdk.Pixbuf)) ->
  Gtk.Orientation ->
  IO (Gtk.Widget, IO ())
scalingImageNew ImageResize getPixbuf orientation = do
  image <- Gtk.imageNew
  let scaledGetter size =
        getPixbuf size >>= traverse (scalePixbufToSize size orientation)
  refresh <- autoSizeImage image scaledGetter orientation
  widget <- Gtk.toWidget image
  return (widget, refresh)
scalingImageNew ImageDraw getPixbuf orientation = do
  drawArea <- Gtk.drawingAreaNew
  refresh <- autoFillImage drawArea getPixbuf orientation
  widget <- Gtk.toWidget drawArea
  return (widget, refresh)

-- | TaffyIO variant that reads the strategy from context state.
scalingImage ::
  (Int32 -> IO (Maybe Gdk.Pixbuf)) ->
  Gtk.Orientation ->
  TaffyIO (Gtk.Widget, IO ())
scalingImage getPixbuf orientation = do
  strategy <- getScalingImageStrategy
  liftIO $ scalingImageNew strategy getPixbuf orientation

-- | Read the current global image scale strategy (defaults to 'ImageDraw').
getScalingImageStrategy :: TaffyIO ImageScaleStrategy
getScalingImageStrategy = do
  ScalingImageStrategySetting s <-
    getStateDefault $ return $ ScalingImageStrategySetting ImageDraw
  return s

-- | Set the global image scale strategy in context state.
setScalingImageStrategy :: ImageScaleStrategy -> TaffyIO ()
setScalingImageStrategy strategy =
  void $ setState $ ScalingImageStrategySetting strategy