From d0ad808990c138590d59e4baedc19fda3228c21c Mon Sep 17 00:00:00 2001 From: hashirama Date: Sun, 9 Nov 2025 19:17:46 +0000 Subject: [PATCH] polymorphic functions && sub-window example --- castToDialogGDKx11.hs | 65 +++++++++++++++++++++++++++---------------- 1 file changed, 41 insertions(+), 24 deletions(-) diff --git a/castToDialogGDKx11.hs b/castToDialogGDKx11.hs index 45e3e98..6743e2d 100644 --- a/castToDialogGDKx11.hs +++ b/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