From 68c1d0f5d321fb88f0b87e9b8d2aa19512740342 Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@gmail.com>
Date: Fri, 21 Aug 2009 22:39:36 +0200
Subject: More flexible interface for X.H.FadeInactive

Ignore-this: e905086d3fb640cbccf4eec2f11f293

This patch allows setting the opacity on a per-window basis and lets the
user specify it as a percentage instead of an Integer between 0 and 2^32-1.

darcs-hash:20090821203936-7f603-b7753508f41955036232b43effd5e93ab73dfc2f.gz
---
 XMonad/Hooks/FadeInactive.hs | 58 +++++++++++++++++++++++---------------------
 1 file changed, 31 insertions(+), 27 deletions(-)

(limited to 'XMonad/Hooks/FadeInactive.hs')

diff --git a/XMonad/Hooks/FadeInactive.hs b/XMonad/Hooks/FadeInactive.hs
index 13b2683..aeacc3c 100644
--- a/XMonad/Hooks/FadeInactive.hs
+++ b/XMonad/Hooks/FadeInactive.hs
@@ -19,6 +19,7 @@ module XMonad.Hooks.FadeInactive (
     isUnfocused,
     fadeIn,
     fadeOut,
+    fadeIf,
     fadeInactiveLogHook,
     fadeOutLogHook
     ) where
@@ -35,11 +36,11 @@ import Control.Monad
 -- >
 -- > myLogHook :: X ()
 -- > myLogHook = fadeInactiveLogHook fadeAmount
--- >     where fadeAmount = 0xdddddddd
+-- >     where fadeAmount = 0.8
 -- >
 -- > main = xmonad defaultConfig { logHook = myLogHook }
 --
--- fadeAmount can be any integer
+-- fadeAmount can be any rational between 0 and 1.
 -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
 -- or something similar for this to do anything
 --
@@ -51,40 +52,43 @@ import Control.Monad
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
--- |
--- sets the opacity of a window
-setOpacity :: Window -> Integer -> X ()
+-- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY
+rationalToOpacity :: Integral a => Rational -> a
+rationalToOpacity perc
+    | perc < 0 || perc > 1 = 0xffffffff -- invalid input, default to opaque
+    | otherwise = round $ perc * 0xffffffff
+
+-- | sets the opacity of a window
+setOpacity :: Window -> Rational -> X ()
 setOpacity w t = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_WINDOW_OPACITY"
     c <- getAtom "CARDINAL"
-    io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t]
+    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
--- |
--- fades a window out by setting the opacity
-fadeOut :: Integer -> Window -> X ()
-fadeOut amt = flip setOpacity amt
+-- | fades a window out by setting the opacity
+fadeOut :: Rational -> Window -> X ()
+fadeOut = flip setOpacity
 
--- |
--- makes a window completely opaque
+-- | makes a window completely opaque
 fadeIn :: Window -> X ()
-fadeIn = flip setOpacity 0xffffffff
+fadeIn = fadeOut 1
 
--- |
--- lowers the opacity of inactive windows to the specified amount
-fadeInactiveLogHook :: Integer -> X ()
-fadeInactiveLogHook amt = fadeOutLogHook isUnfocused amt
+-- | Fades a window by the specified amount if it satisfies the first query, otherwise
+-- makes it opaque.
+fadeIf :: Query Bool -> Rational -> Query Rational
+fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1
+
+-- | sets the opacity of inactive windows to the specified amount
+fadeInactiveLogHook :: Rational -> X ()
+fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused
 
 -- | returns True if the window doesn't have the focus.
-isUnfocused :: Window -> X Bool
-isUnfocused w = withWindowSet $ \s -> return $
-                case W.stack . W.workspace . W.current $ s of
-                  Nothing -> False
-                  Just stack -> W.focus stack /= w
+isUnfocused :: Query Bool
+isUnfocused = ask >>= \w -> liftX . gets $ maybe False (w /=) . W.peek . windowset
 
--- | fades out every window that satisfies a given property.
-fadeOutLogHook :: (Window -> X Bool) -> Integer -> X ()
-fadeOutLogHook p amt = withWindowSet $ \s -> do
+-- | fades out every window by the amount returned by the query.
+fadeOutLogHook :: Query Rational -> X ()
+fadeOutLogHook qry = withWindowSet $ \s -> do
     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
                       concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
-    mapM_ fadeIn =<< filterM (fmap not . p) visibleWins
-    mapM_ (fadeOut amt) =<< filterM p visibleWins
+    forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)
-- 
cgit v1.2.3