summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar.hs')
-rw-r--r--src/Xmobar.hs34
1 files changed, 30 insertions, 4 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 459d6ef..3016f75 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -44,6 +44,9 @@ import Control.Exception (handle, SomeException(..))
import Data.Bits
import Data.Map hiding (foldr, map, filter)
import Data.Maybe (fromJust, isJust)
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.Ptr
import Bitmap
import Config
@@ -283,14 +286,37 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do
getWidth (Text s,cl,_) = textWidth d fs s >>= \tw -> return (Text s,cl,fi tw)
getWidth (Icon s,cl,_) = return (Icon s,cl,fi $ iconW s)
- withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do
+ withColors d [borderColor c] $ \[bdcolor] -> do
gc <- io $ createGC d w
-- create a pixmap to write to and fill it with a rectangle
p <- io $ createPixmap d w wid ht
(defaultDepthOfScreen (defaultScreenOfDisplay d))
- -- the fgcolor of the rectangle will be the bgcolor of the window
- io $ setForeground d gc bgcolor
- io $ fillRectangle d p gc 0 0 wid ht
+ io $ withRenderPicture d p $ \pic -> do
+ -- Handle background color
+ bgcolor <- parseRenderColor d (bgColor c)
+ withRenderFill d bgcolor $ \bgfill ->
+ -- I apparently don't know how to do this properly with
+ -- just bgcolor' (putting in the mask alpha directly has strange
+ -- results. I wish someone had better docs on how
+ -- XRenderComposite worked...)
+ withRenderFill d (XRenderColor 0 0 0 (257 * alpha c)) $ \m ->
+ xRenderComposite d pictOpSrc bgfill m pic 0 0 0 0 0 0 (fromIntegral wid) (fromIntegral ht)
+ -- Handle transparency
+ internAtom d "_XROOTPMAP_ID" False >>= \xid ->
+ let xroot = defaultRootWindow d in
+ alloca $ \x1 ->
+ alloca $ \x2 ->
+ alloca $ \x3 ->
+ alloca $ \x4 ->
+ alloca $ \pprop -> do
+ xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop
+ prop <- peek pprop
+ when (prop /= nullPtr) $ do
+ rootbg <- peek (castPtr prop) :: IO Pixmap
+ xFree prop
+ withRenderPicture d rootbg $ \bgpic ->
+ withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha c)) $ \m ->
+ xRenderComposite d pictOpAdd bgpic m pic 0 0 0 0 0 0 (fromIntegral wid) (fromIntegral ht)
-- write to the pixmap the new string
printStrings p gc fs 1 L =<< strLn left
printStrings p gc fs 1 R =<< strLn right