From 68c1d0f5d321fb88f0b87e9b8d2aa19512740342 Mon Sep 17 00:00:00 2001 From: Daniel Schoepe 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 +++++++++++++++++++++++--------------------- XMonad/Layout/Monitor.hs | 16 ++++++------ 2 files changed, 39 insertions(+), 35 deletions(-) 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 -- 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) diff --git a/XMonad/Layout/Monitor.hs b/XMonad/Layout/Monitor.hs index 5d13830..516c763 100644 --- a/XMonad/Layout/Monitor.hs +++ b/XMonad/Layout/Monitor.hs @@ -63,7 +63,7 @@ import Control.Monad -- > -- avoid flickering -- > , persistent = True -- > -- make the window transparent --- > , opacity = 0xAAAAAAAA +-- > , opacity = 0.6 -- > -- hide on start -- > , visible = False -- > -- assign it a name to be able to toggle it independently of others @@ -89,12 +89,12 @@ import Control.Monad -- Screenshot: data Monitor a = Monitor - { prop :: Property -- ^ property which uniquely identifies monitor window - , rect :: Rectangle -- ^ specifies where to put monitor - , visible :: Bool -- ^ is it visible by default? - , name :: String -- ^ name of monitor (useful when we have many of them) - , persistent :: Bool -- ^ is it shown on all layouts? - , opacity :: Integer -- ^ opacity level + { prop :: Property -- ^ property which uniquely identifies monitor window + , rect :: Rectangle -- ^ specifies where to put monitor + , visible :: Bool -- ^ is it visible by default? + , name :: String -- ^ name of monitor (useful when we have many of them) + , persistent :: Bool -- ^ is it shown on all layouts? + , opacity :: Rational -- ^ opacity level } deriving (Read, Show) -- | Template for 'Monitor' record. At least 'prop' and 'rect' should be @@ -106,7 +106,7 @@ monitor = Monitor , visible = True , name = "" , persistent = False - , opacity = 0xFFFFFFFF + , opacity = 1 } -- | Messages without names affect all monitors. Messages with names affect only -- cgit v1.2.3