From e2e0e1b5de04531e0e85387499fe78f4ee2fdecf Mon Sep 17 00:00:00 2001 From: trupill Date: Wed, 31 Mar 2010 11:38:08 +0200 Subject: image_buttons Ignore-this: 418dbf488435c7c803695407557eecfb * Added a XMonad.Util.Image module to manipulate simple images and show them into an X drawable * Added the possibility of using image buttons instead of plain text buttons into the title bar * Added a XMonad.Layout.ImageButtonDecoration as an example of how to use the image buttons darcs-hash:20100331093808-a84fe-e6d3ce505f7656eef13f0c0609a8d236d9cd8d25.gz --- XMonad/Layout/Decoration.hs | 33 +++--- XMonad/Layout/ImageButtonDecoration.hs | 182 ++++++++++++++++++++++++++++++ XMonad/Layout/WindowSwitcherDecoration.hs | 36 +++++- XMonad/Util/Image.hs | 93 +++++++++++++++ XMonad/Util/XUtils.hs | 51 ++++++++- xmonad-contrib.cabal | 2 + 6 files changed, 376 insertions(+), 21 deletions(-) create mode 100644 XMonad/Layout/ImageButtonDecoration.hs create mode 100644 XMonad/Util/Image.hs diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 07b15dc..27a4008 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -43,6 +43,7 @@ import XMonad.Util.NamedWindows (getName) import XMonad.Util.Invisible import XMonad.Util.XUtils import XMonad.Util.Font +import XMonad.Util.Image -- $usage -- This module is intended for layout developers, who want to decorate @@ -66,19 +67,20 @@ decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme = - Theme { activeColor :: String -- ^ Color of the active window - , inactiveColor :: String -- ^ Color of the inactive window - , urgentColor :: String -- ^ Color of the urgent window - , activeBorderColor :: String -- ^ Color of the border of the active window - , inactiveBorderColor :: String -- ^ Color of the border of the inactive window - , urgentBorderColor :: String -- ^ Color of the border of the urgent window - , activeTextColor :: String -- ^ Color of the text of the active window - , inactiveTextColor :: String -- ^ Color of the text of the inactive window - , urgentTextColor :: String -- ^ Color of the text of the urgent window - , fontName :: String -- ^ Font name - , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') - , decoHeight :: Dimension -- ^ Height of the decorations - , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar + Theme { activeColor :: String -- ^ Color of the active window + , inactiveColor :: String -- ^ Color of the inactive window + , urgentColor :: String -- ^ Color of the urgent window + , activeBorderColor :: String -- ^ Color of the border of the active window + , inactiveBorderColor :: String -- ^ Color of the border of the inactive window + , urgentBorderColor :: String -- ^ Color of the border of the urgent window + , activeTextColor :: String -- ^ Color of the text of the active window + , inactiveTextColor :: String -- ^ Color of the text of the inactive window + , urgentTextColor :: String -- ^ Color of the text of the urgent window + , fontName :: String -- ^ Font name + , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') + , decoHeight :: Dimension -- ^ Height of the decorations + , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar + , windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar } deriving (Show, Read) -- | The default xmonad 'Theme'. @@ -97,6 +99,7 @@ defaultTheme = , decoWidth = 200 , decoHeight = 20 , windowTitleAddons = [] + , windowTitleIcons = [] } -- | A 'Decoration' layout modifier will handle 'SetTheme', a message @@ -393,7 +396,9 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) let als = AlignCenter : map snd (windowTitleAddons t) strs = name : map fst (windowTitleAddons t) - paintAndWrite dw fs wh ht 1 bc borderc tc bc als strs + i_als = map snd (windowTitleIcons t) + icons = map fst (windowTitleIcons t) + paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return () diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs new file mode 100644 index 0000000..5e30044 --- /dev/null +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ImageButtonDecoration +-- Copyright : (c) Jan Vornberger 2009 +-- Alejandro Serrano 2010 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : trupill@gmail.com +-- Stability : unstable +-- Portability : not portable +-- +-- A decoration that includes small image buttons on both ends which invoke +-- various actions when clicked on: Show a window menu (see +-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. +-- +-- Note: For maximizing and minimizing to actually work, you will need +-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your +-- setup. See the documentation of those modules for more information. +-- +----------------------------------------------------------------------------- + +-- This module is mostly derived from "XMonad.Layout.DecorationAddons" +-- and "XMonad.Layout.ButtonDecoration" + +module XMonad.Layout.ImageButtonDecoration + ( -- * Usage: + -- $usage + imageButtonDeco + , defaultThemeWithImageButtons + , imageTitleBarButtonHandler + ) where + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.DecorationAddons +import XMonad.Util.Image + +import XMonad.Actions.WindowMenu +import XMonad.Layout.Minimize +import XMonad.Layout.Maximize + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ImageButtonDecoration +-- +-- Then edit your @layoutHook@ by adding the ImageButtonDecoration to +-- your layout: +-- +-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- + +-- The buttons' dimension and placements + +buttonSize :: Int +buttonSize = 10 + +menuButtonOffset :: Int +menuButtonOffset = 4 + +minimizeButtonOffset :: Int +minimizeButtonOffset = 32 + +maximizeButtonOffset :: Int +maximizeButtonOffset = 18 + +closeButtonOffset :: Int +closeButtonOffset = 4 + + +-- The images in a 0-1 scale to make +-- it easier to visualize + +convertToBool' :: [Int] -> [Bool] +convertToBool' = map (\x -> x == 1) + +convertToBool :: [[Int]] -> [[Bool]] +convertToBool = map convertToBool' + +menuButton' :: [[Int]] +menuButton' = [[0,0,0,0,1,1,0,0,0,0], + [0,0,0,1,1,1,1,0,0,0], + [0,0,1,1,0,0,1,1,0,0], + [0,1,1,0,0,0,0,1,1,0], + [1,1,0,0,1,1,0,0,1,1], + [1,1,0,0,1,1,0,0,1,1], + [0,1,1,0,0,0,0,1,1,0], + [0,0,1,1,0,0,1,1,0,0], + [0,0,0,1,1,1,1,0,0,0], + [0,0,0,0,1,1,0,0,0,0]] + +menuButton :: [[Bool]] +menuButton = convertToBool menuButton' + +miniButton' :: [[Int]] +miniButton' = [[0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [0,0,0,0,0,0,0,0,0,0], + [1,1,1,1,1,1,1,1,1,1], + [1,1,1,1,1,1,1,1,1,1]] + +miniButton :: [[Bool]] +miniButton = convertToBool miniButton' + +maxiButton' :: [[Int]] +maxiButton' = [[1,1,1,1,1,1,1,1,1,1], + [1,1,1,1,1,1,1,1,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,0,0,0,0,0,0,1,1], + [1,1,1,1,1,1,1,1,1,1], + [1,1,1,1,1,1,1,1,1,1]] + +maxiButton :: [[Bool]] +maxiButton = convertToBool maxiButton' + +closeButton' :: [[Int]] +closeButton' = [[1,1,0,0,0,0,0,0,1,1], + [1,1,1,0,0,0,0,1,1,1], + [0,1,1,1,0,0,1,1,1,0], + [0,0,1,1,1,1,1,1,0,0], + [0,0,0,1,1,1,1,0,0,0], + [0,0,0,1,1,1,1,0,0,0], + [0,0,1,1,1,1,1,1,0,0], + [0,1,1,1,0,0,1,1,1,0], + [1,1,1,0,0,0,0,1,1,1], + [1,1,0,0,0,0,0,0,1,1]] + + +closeButton :: [[Bool]] +closeButton = convertToBool closeButton' + +-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. +-- It will intercept clicks on the buttons of the decoration and invoke the associated action. +-- To actually see the buttons, you will need to use a theme that includes them. +-- See 'defaultThemeWithImageButtons' below. +imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool +imageTitleBarButtonHandler mainw distFromLeft distFromRight = do + let action = if (fi distFromLeft >= menuButtonOffset && + fi distFromLeft <= menuButtonOffset + buttonSize) + then focus mainw >> windowMenu >> return True + else if (fi distFromRight >= closeButtonOffset && + fi distFromRight <= closeButtonOffset + buttonSize) + then focus mainw >> kill >> return True + else if (fi distFromRight >= maximizeButtonOffset && + fi distFromRight <= maximizeButtonOffset + buttonSize) + then focus mainw >> sendMessage (maximizeRestore mainw) >> return True + else if (fi distFromRight >= minimizeButtonOffset && + fi distFromRight <= minimizeButtonOffset + buttonSize) + then focus mainw >> sendMessage (MinimizeWin mainw) >> return True + else return False + action + +defaultThemeWithImageButtons :: Theme +defaultThemeWithImageButtons = defaultTheme { + windowTitleIcons = [ (menuButton, CenterLeft 3), + (closeButton, CenterRight 3), + (maxiButton, CenterRight 18), + (miniButton, CenterRight 33) ] + } + +imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a +imageButtonDeco s c = decoration s c $ NFD True + +data ImageButtonDecoration a = NFD Bool deriving (Show, Read) + +instance Eq a => DecorationStyle ImageButtonDecoration a where + describeDeco _ = "ImageButtonDeco" + decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR + decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs index e38abd4..34f1ab4 100644 --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -3,6 +3,7 @@ -- | -- Module : XMonad.Layout.WindowSwitcherDecoration -- Copyright : (c) Jan Vornberger 2009 +-- Alejandro Serrano 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de @@ -18,12 +19,14 @@ module XMonad.Layout.WindowSwitcherDecoration ( -- * Usage: -- $usage windowSwitcherDecoration, - windowSwitcherDecorationWithButtons + windowSwitcherDecorationWithButtons, + windowSwitcherDecorationWithImageButtons ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons +import XMonad.Layout.ImageButtonDecoration import XMonad.Layout.DraggingVisualizer import qualified XMonad.StackSet as S import Control.Monad @@ -52,6 +55,16 @@ import Foreign.C.Types(CInt) -- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig) -- > main = xmonad defaultConfig { layoutHook = myL } -- +-- Additionaly, there is a version of the decoration that contains image buttons like +-- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to +-- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@ +-- in the following way: +-- +-- > import XMonad.Layout.ImageButtonDecoration +-- > +-- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a @@ -75,6 +88,27 @@ instance Eq a => DecorationStyle WindowSwitcherDecoration a where unless hasCrossed $ do sendMessage $ DraggingStopped performWindowSwitching mainw +-- Note: the image button code is duplicated from the above +-- because the title bar handle is different + +windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a +windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True + +data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) + +instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where + describeDeco _ = "ImageWindowSwitcherDeco" + + decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons + then imageTitleBarButtonHandler mainw dFL dFR + else return False + decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y + decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw + hasCrossed <- handleScreenCrossing mainw decoWin + unless hasCrossed $ do sendMessage $ DraggingStopped + performWindowSwitching mainw + handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleTiledDraggingInProgress ex ey (mainw, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) diff --git a/XMonad/Util/Image.hs b/XMonad/Util/Image.hs new file mode 100644 index 0000000..fe42a17 --- /dev/null +++ b/XMonad/Util/Image.hs @@ -0,0 +1,93 @@ +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Image +-- Copyright : (c) 2010 Alejandro Serrano +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : trupill@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- Utilities for manipulating [[Bool]] as images +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Image + ( -- * Usage: + -- $usage + Placement(..), + iconPosition, + drawIcon + ) where + +import XMonad +import Graphics.X11.Xlib.Misc +import Graphics.X11.Xlib.Types +import XMonad.Util.Font (stringToPixel) + +-- | Placement of the icon in the title bar +data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner + | OffsetRight Int Int -- ^ An exact amount of pixels from the right left corner + | CenterLeft Int -- ^ Centered in the y-axis, an amount of pixels from the left + | CenterRight Int -- ^ Centered in the y-axis, an amount of pixels from the right + deriving (Show, Read) + +-- $usage +-- This module uses matrices of boolean values as images. When drawing them, +-- a True value tells that we want the fore color, and a False value that we +-- want the background color to be painted. +-- In the module we suppose that those matrices are represented as [[Bool]], +-- so the lengths of the inner lists must be the same. +-- +-- See "Xmonad.Layout.Decoration" for usage examples + +-- | Gets the ('width', 'height') of an image +imageDims :: [[Bool]] -> (Int, Int) +imageDims img = (length (head img), length img) + +-- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing +-- the image given its 'Placement' +iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position) +iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y) +iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon = + let (icon_w, _) = imageDims icon + in (fi w - fi x - fi icon_w, fi y) +iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon = + let (_, icon_h) = imageDims icon + in (fi x, fi (h `div` 2) - fi (icon_h `div` 2)) +iconPosition (Rectangle _ _ w h) (CenterRight x) icon = + let (icon_w, icon_h) = imageDims icon + in (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2)) + +-- | Converts an image represented as [[Bool]] to a series of points +-- to be painted (the ones with True values) +iconToPoints :: [[Bool]] -> [Point] +iconToPoints icon = + let labels_inside = map (zip (iterate (1+) 0)) icon + filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside + labels_outside = zip (iterate (1+) 0) filtered_inside + in [Point x y | (y, l) <- labels_outside, x <- l] + +-- | Displaces a point ('a', 'b') along a vector ('x', 'y') +movePoint :: Position -> Position -> Point -> Point +movePoint x y (Point a b) = Point (a + x) (b + y) + +-- | Displaces a list of points along a vector 'x', 'y' +movePoints :: Position -> Position -> [Point] -> [Point] +movePoints x y points = map (movePoint x y) points + +-- | Draw an image into a X surface +drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String + ->String -> Position -> Position -> [[Bool]] -> m () +drawIcon dpy drw gc fc bc x y icon = do + let (i_w, i_h) = imageDims icon + fcolor <- stringToPixel dpy fc + bcolor <- stringToPixel dpy bc + io $ setForeground dpy gc bcolor + io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h) + io $ setForeground dpy gc fcolor + io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin + +-- | Short-hand for 'fromIntegral' +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs index 1995d31..acc4558 100644 --- a/XMonad/Util/XUtils.hs +++ b/XMonad/Util/XUtils.hs @@ -2,6 +2,7 @@ -- | -- Module : XMonad.Util.XUtils -- Copyright : (c) 2007 Andrea Rossato +-- 2010 Alejandro Serrano -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it @@ -25,6 +26,7 @@ module XMonad.Util.XUtils , deleteWindows , paintWindow , paintAndWrite + , paintTextAndIcons , stringToPixel , fi ) where @@ -32,11 +34,12 @@ module XMonad.Util.XUtils import Data.Maybe import XMonad import XMonad.Util.Font +import XMonad.Util.Image import Control.Monad -- $usage --- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage --- examples +-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or +-- "XMonad.Layout.Decoration" for usage examples -- | Compute the weighted average the colors of two given Pixel values. averagePixels :: Pixel -> Pixel -> Double -> X Pixel @@ -101,7 +104,7 @@ paintWindow :: Window -- ^ The window where to draw -> String -- ^ Border color -> X () paintWindow w wh ht bw c bc = - paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing + paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing Nothing -- | Fill a window with a rectangle and a border, and write -- | a number of strings to given positions @@ -122,12 +125,42 @@ paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do strPositions <- forM (zip als strs) $ \(al, str) -> stringPosition d fs (Rectangle 0 0 wh ht) al str let ms = Just (fs,ffc,fbc, zip strs strPositions) - paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms + paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing + +-- | Fill a window with a rectangle and a border, and write +-- | a number of strings and a number of icons to given positions +paintTextAndIcons :: Window -- ^ The window where to draw + -> XMonadFont -- ^ XMonad Font for drawing + -> Dimension -- ^ Window width + -> Dimension -- ^ Window height + -> Dimension -- ^ Border width + -> String -- ^ Window background color + -> String -- ^ Border color + -> String -- ^ String color + -> String -- ^ String background color + -> [Align] -- ^ String 'Align'ments + -> [String] -- ^ Strings to be printed + -> [Placement] -- ^ Icon 'Placements' + -> [[[Bool]]] -- ^ Icons to be printed + -> X () +paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do + d <- asks display + strPositions <- forM (zip als strs) $ \(al, str) -> + stringPosition d fs (Rectangle 0 0 wh ht) al str + let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons) + ms = Just (fs,ffc,fbc, zip strs strPositions) + is = Just (ffc, fbc, zip iconPositions icons) + paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is -- This stuff is not exported -paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) -> X () -paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff = do +-- | Paints a titlebar with some strings and icons +-- drawn inside it. +-- Not exported. +paintWindow' :: Window -> Rectangle -> Dimension -> String -> String + -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) + -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X () +paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do d <- asks display p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) gc <- io $ createGC d p @@ -140,10 +173,16 @@ paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff = do -- and now again io $ setForeground d gc color' io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) + -- paint strings when (isJust strStuff) $ do let (xmf,fc,bc,strAndPos) = fromJust strStuff forM_ strAndPos $ \(s, (x, y)) -> printStringXMF d p xmf gc fc bc x y s + -- paint icons + when (isJust iconStuff) $ do + let (fc, bc, iconAndPos) = fromJust iconStuff + forM_ iconAndPos $ \((x, y), icon) -> + drawIcon d p gc fc bc x y icon -- copy the pixmap over the window io $ copyArea d p win gc 0 0 wh ht 0 0 -- free the pixmap and GC diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index bcb3eaf..7f2a4b7 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -181,6 +181,7 @@ library XMonad.Layout.HintedGrid XMonad.Layout.HintedTile XMonad.Layout.IM + XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder XMonad.Layout.LayoutCombinators @@ -255,6 +256,7 @@ library XMonad.Util.ExtensibleState XMonad.Util.EZConfig XMonad.Util.Font + XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.Loggers XMonad.Util.NamedActions -- cgit v1.2.3