Commit aa402ea45d3c7c7b8488568aa1f9a3d7d9615f69
Parent: 4922c6351ff54e1b6ac87da32521d7405a3017dd
Author: mcol <mcol@posteo.net>
Date: 2021-11-02 16:36:47 +0000
Committer: mcol <mcol@posteo.net>
Committed: 2021-11-02 16:36:47 +0000

Implement wlr-layer-surface protocol

src/Window.hs Modified

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -8,12 +7,12 @@
 
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Maybe
-import GHC.Int (Int32)
 
 import Data.GI.Base
 import qualified GI.Gdk as Gdk
 import qualified GI.Gdk.Enums as Enums
 import qualified GI.Gtk as Gtk
+import qualified GI.GtkLayerShell as LS
 
 initWindow :: Gtk.Application -> IO Gtk.ApplicationWindow
 initWindow app = do
@@ -23,23 +22,30 @@
         , #resizable := False
         ]
 
-    geometry <- runMaybeT getGeometry
-    case geometry of
-        Nothing -> error "Could not open display."
-        Just (width, height) -> Gtk.windowSetDefaultSize win width height
-
+    initWayland win
+    runMaybeT $ initX11 win
     addCSS win
-    Gtk.windowSetTypeHint win Enums.WindowTypeHintDesktop
     return win
 
-getGeometry :: MaybeT IO (Int32, Int32)
-getGeometry = do
+initWayland :: Gtk.ApplicationWindow -> IO ()
+initWayland win = do
+    LS.initForWindow win
+    LS.setLayer win LS.LayerBackground
+    LS.setKeyboardMode win LS.KeyboardModeOnDemand
+    LS.setAnchor win LS.EdgeTop True
+    LS.setAnchor win LS.EdgeBottom True
+    LS.setAnchor win LS.EdgeLeft True
+    LS.setAnchor win LS.EdgeRight True
+
+initX11 :: Gtk.ApplicationWindow -> MaybeT IO ()
+initX11 win = do
+    Gtk.windowSetTypeHint win Enums.WindowTypeHintDesktop
     display <- MaybeT Gdk.displayGetDefault
     monitor <- MaybeT $ Gdk.displayGetMonitor display 0
     rect <- liftIO $ Gdk.monitorGetGeometry monitor
     width <- Gdk.getRectangleWidth rect
     height <- Gdk.getRectangleHeight rect
-    return (width, height)
+    Gtk.windowSetDefaultSize win width height
 
 addCSS :: Gtk.ApplicationWindow -> IO ()
 addCSS win = do