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/Util/Image.hs | 93 +++++++++++++++++++++++++++++++++++++++++++++++++++ XMonad/Util/XUtils.hs | 51 ++++++++++++++++++++++++---- 2 files changed, 138 insertions(+), 6 deletions(-) create mode 100644 XMonad/Util/Image.hs (limited to 'XMonad/Util') 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 -- cgit v1.2.3