module XMonad.Util.XUtils (
averagePixels
, createNewWindow
, showWindow
, hideWindow
, deleteWindow
, paintWindow
, paintAndWrite
, stringToPixel
) where
import Data.Maybe
import XMonad
import XMonad.Util.Font
import Control.Monad
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 * (1f))
Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)
return p
createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window
createNewWindow (Rectangle x y w h) m col = do
d <- asks display
rw <- asks theRoot
c <- stringToPixel d col
win <- io $ createSimpleWindow d rw x y w h 0 c c
case m of
Just em -> io $ selectInput d win em
Nothing -> io $ selectInput d win exposureMask
return win
showWindow :: Window -> X ()
showWindow w = do
d <- asks display
io $ mapWindow d w
hideWindow :: Window -> X ()
hideWindow w = do
d <- asks display
io $ unmapWindow d w
deleteWindow :: Window -> X ()
deleteWindow w = do
d <- asks display
io $ destroyWindow d w
paintWindow :: Window
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> X ()
paintWindow w wh ht bw c bc =
paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing
paintAndWrite :: Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> Align
-> String
-> X ()
paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do
(x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str
paintWindow' w (Rectangle x y wh ht) bw bc borc ms
where ms = Just (fs,ffc,fbc,str)
paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X ()
paintWindow' win (Rectangle x y wh ht) bw color b_color str = do
d <- asks display
p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d)
gc <- io $ createGC d p
io $ setGraphicsExposures d gc False
[color',b_color'] <- mapM (stringToPixel d) [color,b_color]
io $ setForeground d gc b_color'
io $ fillRectangle d p gc 0 0 wh ht
io $ setForeground d gc color'
io $ fillRectangle d p gc (fi bw) (fi bw) ((wh (bw * 2))) (ht (bw * 2))
when (isJust str) $ do
let (xmf,fc,bc,s) = fromJust str
printStringXMF d p xmf gc fc bc x y s
io $ copyArea d p win gc 0 0 wh ht 0 0
io $ freePixmap d p
io $ freeGC d gc
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral