{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
module StatusNotifier.TransparentWindow where
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.GI.Base
import Foreign.Ptr (castPtr)
import qualified GI.Cairo
import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.Internal (Render(runRender))
import Graphics.Rendering.Cairo.Types (Cairo(Cairo))
renderWithContext :: GI.Cairo.Context -> Render () -> IO ()
renderWithContext ct r =
withManagedPtr ct $ \p -> runReaderT (runRender r) (Cairo (castPtr p))
makeWindowTransparent :: MonadIO m => Gtk.Window -> m ()
makeWindowTransparent window = do
screen <- Gtk.widgetGetScreen window
visual <- Gdk.screenGetRgbaVisual screen
Gtk.widgetSetVisual window visual
Gtk.setWidgetAppPaintable window True
_ <- Gtk.onWidgetDraw window transparentDraw
return ()
transparentDraw :: Gtk.WidgetDrawCallback
transparentDraw context = do
rGBA <- Gdk.newZeroRGBA
Gdk.setRGBAAlpha rGBA 0.0
Gdk.setRGBABlue rGBA 1.0
Gdk.setRGBARed rGBA 1.0
Gdk.setRGBAGreen rGBA 1.0
Gdk.cairoSetSourceRgba context rGBA
renderWithContext context $ do
setOperator OperatorSource
paint
setOperator OperatorOver
return False