Add floatDialogX11.hs

floatDialogX11.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Foreign.Marshal.Array (withArray)
+import Foreign.Ptr (castPtr)
+import Control.Monad (void)
+
+main :: IO ()
+main = do
+  dpy <- openDisplay ""
+
+  let screen = defaultScreen dpy       -- pure value
+  rootWin <- rootWindow dpy screen      -- IO Window
+
+  win <- createSimpleWindow dpy rootWin 100 100 400 100 1 0 0
+
+  mapWindow dpy win
+
+  atomNetWm  <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
+  atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
+  atomAtom   <- internAtom dpy "ATOM" False
+
+  withArray [atomDialog] $ \ptr ->
+    void $ xChangeProperty dpy win atomNetWm atomAtom 32 propModeReplace (castPtr ptr) 1
+
+  flush dpy
+
+  putStrLn "Window created. Press Enter to exit."
+  _ <- getLine
+
+  destroyWindow dpy win
+  closeDisplay dpy