{-# 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 -> m ()
makeWindowTransparent window :: Window
window = do
Screen
screen <- Window -> m Screen
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m Screen
Gtk.widgetGetScreen Window
window
Maybe Visual
visual <- Screen -> m (Maybe Visual)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScreen a) =>
a -> m (Maybe Visual)
Gdk.screenGetRgbaVisual Screen
screen
Window -> Maybe Visual -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWidget a, IsVisual b) =>
a -> Maybe b -> m ()
Gtk.widgetSetVisual Window
window Maybe Visual
visual
Window -> Bool -> m ()
forall (m :: * -> *) o.
(MonadIO m, IsWidget o) =>
o -> Bool -> m ()
Gtk.setWidgetAppPaintable Window
window Bool
True
SignalHandlerId
_ <- Window -> WidgetDrawCallback -> m SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> WidgetDrawCallback -> m SignalHandlerId
Gtk.onWidgetDraw Window
window WidgetDrawCallback
transparentDraw
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
transparentDraw :: Gtk.WidgetDrawCallback
transparentDraw :: WidgetDrawCallback
transparentDraw context :: Context
context = do
RGBA
rGBA <- IO RGBA
forall (m :: * -> *). MonadIO m => m RGBA
Gdk.newZeroRGBA
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBAAlpha RGBA
rGBA 0.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBABlue RGBA
rGBA 1.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBARed RGBA
rGBA 1.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBAGreen RGBA
rGBA 1.0
Context -> RGBA -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> RGBA -> m ()
Gdk.cairoSetSourceRgba Context
context RGBA
rGBA
(Render () -> Context -> IO ()) -> Context -> Render () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Render () -> Context -> IO ()
forall (m :: * -> *) a. MonadIO m => Render a -> Context -> m a
renderWithContext Context
context (Render () -> IO ()) -> Render () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Operator -> Render ()
setOperator Operator
OperatorSource
Render ()
paint
Operator -> Render ()
setOperator Operator
OperatorOver
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False