diff options
Diffstat (limited to 'src/Xmobar.hs')
-rw-r--r-- | src/Xmobar.hs | 34 |
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 |