From a98ac8fba46b8858959cee6062a49c9121f07fe9 Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@mit.edu>
Date: Mon, 28 Nov 2011 02:09:41 -0500
Subject: Transparency and tint support.

New configuration option 'alpha' which adjusts alpha transparency
(0 is transparent, 255 is opaque).

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
---
 src/Xmobar.hs | 34 ++++++++++++++++++++++++++++++----
 1 file changed, 30 insertions(+), 4 deletions(-)

(limited to 'src/Xmobar.hs')

diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index 3cff475..823b594 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -43,6 +43,9 @@ import Control.Exception (handle, SomeException(..))
 import Data.Bits
 import Data.Map hiding (foldr, map, filter)
 import Data.Maybe (fromJust)
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.Ptr
 
 import Bitmap
 import Config
@@ -276,14 +279,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
-- 
cgit v1.2.3