{-# 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 :: forall (m :: * -> *). MonadIO m => Window -> m ()
makeWindowTransparent 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
-> ((?self::Window) => WidgetDrawCallback) -> m SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => WidgetDrawCallback) -> m SignalHandlerId
Gtk.onWidgetDraw Window
window (?self::Window) => WidgetDrawCallback
WidgetDrawCallback
transparentDraw
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
transparentDraw :: Gtk.WidgetDrawCallback
transparentDraw :: WidgetDrawCallback
transparentDraw 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 Double
0.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBABlue RGBA
rGBA Double
1.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBARed RGBA
rGBA Double
1.0
RGBA -> Double -> IO ()
forall (m :: * -> *). MonadIO m => RGBA -> Double -> m ()
Gdk.setRGBAGreen RGBA
rGBA Double
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False