{-# 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 GI.Cairo hiding (OperatorOver, OperatorSource)
import GI.Cairo.Render
import GI.Cairo.Render.Connector
import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
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
flip renderWithContext context $ do
setOperator OperatorSource
paint
setOperator OperatorOver
return False