polymorphic functions && sub-window example

castToDialogGDKx11.hs

@@ -17,29 +17,27 @@ import Foreign.C.Types (CULong)
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras (xChangeProperty, propModeReplace)
 
-
-
--- | Set _NET_WM_WINDOW_TYPE to _NET_WM_WINDOW_TYPE_DIALOG for a realized GTK window.
---   Safe to call from the GTK main thread after the window has a surface (i.e. after realize).
-setWindowAsDialog :: Gtk.ApplicationWindow -> IO ()
+-- Polymorphic: accepts any GTK window type
+setWindowAsDialog :: Gtk.IsWindow w => w -> IO ()
 setWindowAsDialog win = do
-  mSurface <- #getSurface win
+  -- upcast to concrete Gtk.Window right away (resolves ambiguity)
+  wnd <- Gtk.toWindow win
+
+  -- now get surface with a concrete Window type in scope
+  mSurface <- #getSurface wnd
   case mSurface of
-    Just surface -> do
-      -- Cast to X11 surface & display
-      mX11Surface <- castTo GdkX11.X11Surface surface
+    Just (surface :: Gdk.Surface) -> do
+      -- cast to GDK X11 surface & display (explicit IO results)
+      mX11Surface <- (castTo GdkX11.X11Surface surface) :: IO (Maybe GdkX11.X11Surface)
       display     <- Gdk.surfaceGetDisplay surface
-      mX11Display <- castTo GdkX11.X11Display display
+      mX11Display <- (castTo GdkX11.X11Display display) :: IO (Maybe GdkX11.X11Display)
 
       case (mX11Display, mX11Surface) of
         (Just _gdkX11Disp, Just x11Surf) -> do
-          -- get window XID
+          -- get window XID and set ATOM via X11
           xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
 
-          -- open a short-lived X11 connection (Xlib Display*)
           dpy <- openDisplay ""
-
-          -- intern atoms and set property as ATOM (EWMH)
           atomType   <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
           atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
           atomAtom   <- internAtom dpy "ATOM" False
@@ -54,10 +52,11 @@ setWindowAsDialog win = do
         _ -> putStrLn "Not running under X11."
     Nothing -> putStrLn "No surface available"
 
--- | Attach setting the dialog atom to the window's #realize signal.
---   Returns the SignalHandlerId so you can disconnect if needed.
-attachDialogOnRealize :: Gtk.ApplicationWindow -> IO SignalHandlerId
-attachDialogOnRealize win = on win #realize (setWindowAsDialog win)
+-- Polymorphic attach helper
+attachDialogOnRealize :: Gtk.IsWindow w => w -> IO SignalHandlerId
+attachDialogOnRealize win = do
+  wnd <- Gtk.toWindow win
+  on wnd #realize (setWindowAsDialog win)
 
 
 main :: IO ()
@@ -65,6 +64,7 @@ main = do
   app <- new Gtk.Application [#applicationId := "org.example.test"]
 
   on app #activate $ do
+    -- Main window
     win <- new Gtk.ApplicationWindow
       [ #application := app
       , #title := "Dialog Window"
@@ -73,17 +73,34 @@ main = do
       , #resizable := False
       , #decorated := False
       ]
-
-    -- preferred default size before showing
     Gtk.windowSetDefaultSize win 400 100
-
-    -- attach the handler in the GTK main context with high priority
     void $ mainContextInvokeFull Nothing (-99) $ do
       _ <- attachDialogOnRealize win
       return False
-
-    -- now realize & show the window (the handler will run on realize)
     #realize win
     Gtk.widgetShow win
 
+    -- Spawn a dialog window
+    dlg <- new Gtk.Dialog
+      [ #transientFor := win  -- dialog is attached to main window
+      , #title := "This is a Dialog"
+      , #modal := True
+      , #resizable := False
+      , #decorated := False
+      ]
+    Gtk.windowSetDefaultSize dlg 300 80
+
+    -- Add a label with text inside the dialog
+    contentArea <- Gtk.dialogGetContentArea dlg
+    lbl <- new Gtk.Label [#label := "Hello, I am a dialog!"]
+    Gtk.boxAppend contentArea lbl
+
+    -- Attach dialog X11 role
+    void $ mainContextInvokeFull Nothing (-99) $ do
+      _ <- attachDialogOnRealize dlg
+      return False
+
+    #realize dlg
+    Gtk.widgetShow dlg
+
   void $ applicationRun app Nothing