{-# LANGUAGE FlexibleInstances #-}
module XMonad.Hooks.FadeWindows (
fadeWindowsLogHook
,FadeHook
,Opacity
,idFadeHook
,opaque
,solid
,transparent
,invisible
,transparency
,translucence
,fadeBy
,opacity
,fadeTo
,fadeWindowsEventHook
,doS
,isFloating
,isUnfocused
) where
import XMonad.Core
import XMonad.Prelude
import XMonad.ManageHook (liftX)
import qualified XMonad.StackSet as W
import XMonad.Hooks.FadeInactive (setOpacity
,isUnfocused
)
import Control.Monad.Reader (ask
,asks)
import Control.Monad.State (gets)
import qualified Data.Map as M
import Graphics.X11.Xlib.Extras (Event(..))
data Opacity = Opacity Rational | OEmpty
instance Semigroup Opacity where
Opacity
r <> :: Opacity -> Opacity -> Opacity
<> Opacity
OEmpty = Opacity
r
Opacity
_ <> Opacity
r = Opacity
r
instance Monoid Opacity where
mempty :: Opacity
mempty = Opacity
OEmpty
type FadeHook = Query Opacity
opaque :: FadeHook
opaque :: FadeHook
opaque = forall m. Monoid m => m -> Query m
doS (Rational -> Opacity
Opacity Rational
1)
transparent :: FadeHook
transparent :: FadeHook
transparent = forall m. Monoid m => m -> Query m
doS (Rational -> Opacity
Opacity Rational
0)
transparency :: Rational
-> FadeHook
transparency :: Rational -> FadeHook
transparency = forall m. Monoid m => m -> Query m
doS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Opacity
Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
1forall a. Num a => a -> a -> a
-) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
clampRatio
opacity :: Rational
-> FadeHook
opacity :: Rational -> FadeHook
opacity = forall m. Monoid m => m -> Query m
doS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Opacity
Opacity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
clampRatio
fadeTo, translucence, fadeBy :: Rational -> FadeHook
fadeTo :: Rational -> FadeHook
fadeTo = Rational -> FadeHook
transparency
translucence :: Rational -> FadeHook
translucence = Rational -> FadeHook
transparency
fadeBy :: Rational -> FadeHook
fadeBy = Rational -> FadeHook
opacity
invisible, solid :: FadeHook
invisible :: FadeHook
invisible = FadeHook
transparent
solid :: FadeHook
solid = FadeHook
opaque
doS :: Monoid m => m -> Query m
doS :: forall m. Monoid m => m -> Query m
doS = forall (m :: * -> *) a. Monad m => a -> m a
return
idFadeHook :: FadeHook
idFadeHook :: FadeHook
idFadeHook = FadeHook
opaque
isFloating :: Query Bool
isFloating :: Query Bool
isFloating = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
fadeWindowsLogHook :: FadeHook -> X ()
fadeWindowsLogHook :: FadeHook -> X ()
fadeWindowsLogHook FadeHook
h = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
s -> do
let visibleWins :: [Window]
visibleWins = (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
s) forall a. [a] -> [a] -> [a]
++
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
s)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Window]
visibleWins forall a b. (a -> b) -> a -> b
$ \Window
w -> do
Opacity
o <- forall a. a -> X a -> X a
userCodeDef (Rational -> Opacity
Opacity Rational
1) (forall a. Query a -> Window -> X a
runQuery FadeHook
h Window
w)
Window -> Rational -> X ()
setOpacity Window
w forall a b. (a -> b) -> a -> b
$ case Opacity
o of
Opacity
OEmpty -> Rational
1
Opacity Rational
r -> Rational
r
fadeWindowsEventHook :: Event -> X All
fadeWindowsEventHook :: Event -> X All
fadeWindowsEventHook MapNotifyEvent{} =
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> XConfig Layout
config forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (l :: * -> *). XConfig l -> X ()
logHook forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
fadeWindowsEventHook Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
clampRatio :: Rational -> Rational
clampRatio :: Rational -> Rational
clampRatio Rational
r | Rational
r forall a. Ord a => a -> a -> Bool
>= Rational
0 Bool -> Bool -> Bool
&& Rational
r forall a. Ord a => a -> a -> Bool
<= Rational
1 = Rational
r
| Rational
r forall a. Ord a => a -> a -> Bool
< Rational
0 = Rational
0
| Bool
otherwise = Rational
1