content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Util.XUtils
  -- Copyright   :  (c) 2007 Andrea Rossato
  --                    2010 Alejandro Serrano
  -- License     :  BSD-style (see xmonad/LICENSE)
  --
  -- Maintainer  :  andrea.rossato@unibz.it
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- A module for painting on the screen
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Util.XUtils
      ( -- * Usage:
        -- $usage
        averagePixels
      , createNewWindow
      , showWindow
      , showWindows
      , hideWindow
      , hideWindows
      , deleteWindow
      , deleteWindows
      , paintWindow
      , paintAndWrite
      , paintTextAndIcons
      , stringToPixel
      , fi
      ) where
  
  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" or
  -- "XMonad.Layout.Decoration" for usage examples
  
  -- | Compute the weighted average the colors of two given Pixel values.
  averagePixels :: Pixel -> Pixel -> Double -> X Pixel
  averagePixels p1 p2 f =
      do d <- asks display
         let cm = defaultColormap d (defaultScreen d)
         [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]
         let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f))
         Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)
         return p
  
  -- | Create a simple window given a rectangle. If Nothing is given
  -- only the exposureMask will be set, otherwise the Just value.
  -- Use 'showWindow' to map and hideWindow to unmap.
  createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window
  createNewWindow (Rectangle x y w h) m col o = do
    d   <- asks display
    rw  <- asks theRoot
    c   <- stringToPixel d col
    win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o
    case m of
      Just em -> io $ selectInput d win em
      Nothing -> io $ selectInput d win exposureMask
    -- @@@ ugly hack to prevent compositing
    whenX (return $ isJust m) $ flip catchX (return ()) $ do
      wINDOW_TYPE <- getAtom "_NET_WM_WINDOW_TYPE"
      dESKTOP <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
      io $ changeProperty32 d win wINDOW_TYPE aTOM propModeReplace [fi dESKTOP]
    return win
  
  -- | Map a window
  showWindow :: Window -> X ()
  showWindow w = do
    d <- asks display
    io $ mapWindow d w
  
  -- | the list version
  showWindows :: [Window] -> X ()
  showWindows = mapM_ showWindow
  
  -- | unmap a window
  hideWindow :: Window -> X ()
  hideWindow w = do
    d <- asks display
    io $ unmapWindow d w
  
  -- | the list version
  hideWindows :: [Window] -> X ()
  hideWindows = mapM_ hideWindow
  
  -- | destroy a window
  deleteWindow :: Window -> X ()
  deleteWindow w = do
    d <- asks display
    io $ destroyWindow d w
  
  -- | the list version
  deleteWindows :: [Window] -> X ()
  deleteWindows = mapM_ deleteWindow
  
  -- | Fill a window with a rectangle and a border
  paintWindow :: Window     -- ^ The window where to draw
              -> Dimension  -- ^ Window width
              -> Dimension  -- ^ Window height
              -> Dimension  -- ^ Border width
              -> String     -- ^ Window background color
              -> String     -- ^ Border color
              -> X ()
  paintWindow w wh ht bw c bc =
      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
  paintAndWrite :: 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
                -> X ()
  paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do
      d <- asks display
      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 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
  
  -- | 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
    -- draw
    io $ setGraphicsExposures d gc False
    [color',b_color'] <- mapM (stringToPixel d) [color,b_color]
    -- we start with the border
    io $ setForeground d gc b_color'
    io $ fillRectangle d p gc 0 0 wh ht
    -- 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
    io $ freePixmap    d p
    io $ freeGC        d gc
  
  -- | Creates a window with the possibility of setting some attributes.
  -- Not exported.
  mkWindow :: Display -> Screen -> Window -> Position
           -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window
  mkWindow d s rw x y w h p o = do
    let visual = defaultVisualOfScreen s
        attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel
    allocaSetWindowAttributes $
           \attributes -> do
             set_override_redirect attributes o
             set_border_pixel      attributes p
             set_background_pixel  attributes p
             createWindow d rw x y w h 0 (defaultDepthOfScreen s)
                          inputOutput visual attrmask attributes
  
  