{-# 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 = Just $ busName_ $ "com.github.chjj.compton." ++ dpyName dpy
             , methodCallBody = [toVariant (fromIntegral w :: Word32)
                                , toVariant ("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 <- IO Client
connectSession
             status <- call_ client mc
             disconnect client
             return $ (/= 0) $ fromJust $ (fromVariant :: Variant -> Maybe Word32) $ head $ methodReturnBody 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 = Just $ busName_ $ "com.github.chjj.compton." ++ dpyName dpy
             , methodCallBody = [toVariant (fromIntegral w :: Word32)
                                , toVariant ("invert_color_force" :: String)
                                , toVariant ((if status then 1 else 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 <- IO Client
connectSession
             callNoReply client mc
             disconnect client