{-# LANGUAGE OverloadedStrings #-}
-- | Invert individual window contents via compton/picom compositing manager.
--
-- @since 0.17.1
module XMonad.Actions.Invert 
  ( -- * Usage:
    -- $usage
    inversionStatus
  , invert
  ) where

import DBus
import DBus.Client
import Data.Maybe
import Data.Word
import Graphics.X11.Xlib.Display
import XMonad

-- $usage
-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.Invert
--
-- Then add an appropriate mouse binding:
--
-- >     , ((modm, xK_i), withDisplay $ \dpy -> withFocused $ \w -> inversionStatus dpy w >>= \status -> invert dpy w $ not status)
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".

dpyName :: Display -> String
dpyName :: Display -> String
dpyName Display
dpy = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Display -> String
displayString Display
dpy where
  replace :: Char -> Char
replace Char
':' = Char
'_'
  replace Char
'.' = Char
'_'
  replace Char
c = Char
c

-- | Ask compton/picom the inverted status of the specified window
inversionStatus :: Display -> Window -> X Bool
inversionStatus :: Display -> Window -> X Bool
inversionStatus Display
dpy Window
w =
  let mc :: MethodCall
mc = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
"/" InterfaceName
"com.github.chjj.compton" MemberName
"win_get")
             { methodCallDestination :: Maybe BusName
methodCallDestination = BusName -> Maybe BusName
forall a. a -> Maybe a
Just (BusName -> Maybe BusName) -> BusName -> Maybe BusName
forall a b. (a -> b) -> a -> b
$ String -> BusName
busName_ (String -> BusName) -> String -> BusName
forall a b. (a -> b) -> a -> b
$ String
"com.github.chjj.compton." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Display -> String
dpyName Display
dpy
             , methodCallBody :: [Variant]
methodCallBody = [Word32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Window -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
w :: Word32)
                                , String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String
"invert_color_force" :: String)
                                ]
             }
  in IO Bool -> X Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> X Bool) -> IO Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ do Client
client <- IO Client
connectSession
             MethodReturn
status <- Client -> MethodCall -> IO MethodReturn
call_ Client
client MethodCall
mc
             Client -> IO ()
disconnect Client
client
             Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0) (Word32 -> Bool) -> Word32 -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Word32 -> Word32
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Word32 -> Word32) -> Maybe Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (Variant -> Maybe Word32
forall a. IsVariant a => Variant -> Maybe a
fromVariant :: Variant -> Maybe Word32) (Variant -> Maybe Word32) -> Variant -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ [Variant] -> Variant
forall a. HasCallStack => [a] -> a
head ([Variant] -> Variant) -> [Variant] -> Variant
forall a b. (a -> b) -> a -> b
$ MethodReturn -> [Variant]
methodReturnBody MethodReturn
status

-- | Tell compton/picom to set the inverted status of the specified window
invert :: Display -> Window -> Bool -> X ()
invert :: Display -> Window -> Bool -> X ()
invert Display
dpy Window
w Bool
status =
  let mc :: MethodCall
mc = (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
"/" InterfaceName
"com.github.chjj.compton" MemberName
"win_set")
             { methodCallDestination :: Maybe BusName
methodCallDestination = BusName -> Maybe BusName
forall a. a -> Maybe a
Just (BusName -> Maybe BusName) -> BusName -> Maybe BusName
forall a b. (a -> b) -> a -> b
$ String -> BusName
busName_ (String -> BusName) -> String -> BusName
forall a b. (a -> b) -> a -> b
$ String
"com.github.chjj.compton." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Display -> String
dpyName Display
dpy
             , methodCallBody :: [Variant]
methodCallBody = [Word32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant (Window -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
w :: Word32)
                                , String -> Variant
forall a. IsVariant a => a -> Variant
toVariant (String
"invert_color_force" :: String)
                                , Word32 -> Variant
forall a. IsVariant a => a -> Variant
toVariant ((if Bool
status then Word32
1 else Word32
0) :: Word32)
                                ]
             }
  in IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ do Client
client <- IO Client
connectSession
             Client -> MethodCall -> IO ()
callNoReply Client
client MethodCall
mc
             Client -> IO ()
disconnect Client
client