Merge branch 'transparency' of https://github.com/ezyang/xmobar

Conflicts:
	src/Config.hs
	src/Main.hs
	src/Parsers.hs
	src/XUtil.hsc
	src/Xmobar.hs

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