Commit ff63a185844b28e86b5db5d1ab8a643a673a8d6e
Parent: 841d620a6a0ba0782deb102949d284244be5b2d2
Author: mcol <mcol@posteo.net>
Date: 2021-11-01 01:11:55 +0000
Committer: mcol <mcol@posteo.net>
Committed: 2021-11-01 01:11:55 +0000

Set window size to monitor size

xanadu.cabal Modified

@@ -17,6 +17,7 @@
   hs-source-dirs:      src
   main-is:             Main.hs
   other-modules:       Icons
+                     , Window
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , directory

src/Window.hs Added

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Window (
+    initWindow
+) where
+
+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
+
+initWindow :: Gtk.Application -> IO Gtk.ApplicationWindow
+initWindow app = do
+    win <- new Gtk.ApplicationWindow
+        [ #application := app
+        , #title := "xanadu"
+        , #resizable := False
+        ]
+
+    geometry <- runMaybeT getGeometry
+    case geometry of
+        Nothing -> error "Could not open display."
+        Just (width, height) -> Gtk.windowSetDefaultSize win width height
+
+    Gtk.windowSetTypeHint win Enums.WindowTypeHintDesktop
+    return win
+
+getGeometry :: MaybeT IO (Int32, Int32)
+getGeometry = do
+    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)

src/Main.hs Modified

@@ -3,10 +3,10 @@
 
 module Main where
 
-import qualified Icons
+import Icons (initIcons)
+import Window (initWindow)
 
 import Data.GI.Base
-import qualified GI.Gdk.Enums as Enums
 import qualified GI.Gio as Gio
 import qualified GI.Gtk as Gtk
 
@@ -22,13 +22,8 @@
 
 activateApp :: Gtk.Application -> IO ()
 activateApp app = do
-    win <- new Gtk.ApplicationWindow
-        [ #application := app
-        , #title := "xanadu"
-        , #resizable := False
-        ]
-    #setTypeHint win Enums.WindowTypeHintDesktop
-    iconView <- Icons.initIcons win
+    win <- initWindow app
+    iconView <- initIcons win
     #add win iconView
     #showAll win
     return ()