{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      : StatusNotifier.TransparentWindow
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- Make a window transparent. Approach adapted from python code from
-- https://stackoverflow.com/questions/3908565/how-to-make-gtk-window-background-transparent/33294727#33294727
-----------------------------------------------------------------------------
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 <- Window -> m Screen
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m Screen
Gtk.widgetGetScreen Window
window
  visual <- Gdk.screenGetRgbaVisual screen
  Gtk.widgetSetVisual window visual
  Gtk.setWidgetAppPaintable window True
  _ <- Gtk.onWidgetDraw window transparentDraw
  return ()

transparentDraw :: Gtk.WidgetDrawCallback
transparentDraw :: WidgetDrawCallback
transparentDraw Context
context = do
  rGBA <- IO RGBA
forall (m :: * -> *). MonadIO m => m 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