From cf7377886a55e36701bd0d5ce7c723aa6d7bd9bd Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Wed, 8 May 2024 21:56:19 +0200
Subject: initial commit

---
 app/xoutinfo.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 82 insertions(+)
 create mode 100644 app/xoutinfo.hs

(limited to 'app')

diff --git a/app/xoutinfo.hs b/app/xoutinfo.hs
new file mode 100644
index 0000000..da1360a
--- /dev/null
+++ b/app/xoutinfo.hs
@@ -0,0 +1,82 @@
+module Main (main) where
+
+import Control.Exception
+import Data.Aeson
+import Data.ByteString.Lazy.Char8 qualified as L8
+import Data.Maybe
+import GHC.Generics
+import Graphics.X11.Xlib.Atom
+import Graphics.X11.Xlib.Display
+import Graphics.X11.Xlib.Misc
+import Graphics.X11.Xrandr
+import System.Environment
+
+
+data Output =
+    Output
+      { device_scale_factor :: Float
+      , dpi_x :: Float
+      , dpi_y :: Float
+      , height :: Int
+      , height_mm :: Int
+      , name :: String
+      , width :: Int
+      , width_mm :: Int
+      }
+    deriving (Generic, Show)
+
+instance ToJSON Output
+
+
+main :: IO ()
+main = do
+    let
+        -- This assumes DPI has not been configured
+        -- (e.g. by passing -dpi to X or calling xrandr --dpi)
+        default_dpi = 96
+    bracket (getEnv "DISPLAY" >>= openDisplay) closeDisplay $ \dpy -> do
+      let w = defaultRootWindow dpy
+      (_, _, _, x, y, _, _, _) <- queryPointer dpy w
+      filter (isPointedAt x y) . fromJust <$> xrrGetMonitors dpy w True
+        >>= mapM (xrrMonitorInfoToOutput dpy default_dpi)
+        >>= mapM_ (L8.putStrLn . encode)
+  where
+    isPointedAt
+        x
+        y
+        XRRMonitorInfo
+          { xrr_moninf_x
+          , xrr_moninf_y
+          , xrr_moninf_width
+          , xrr_moninf_height
+          } =
+      xrr_moninf_x <= x && x < xrr_moninf_x + xrr_moninf_width &&
+      xrr_moninf_y <= y && y < xrr_moninf_y + xrr_moninf_height
+    xrrMonitorInfoToOutput
+        dpy
+        default_dpi
+        XRRMonitorInfo
+          { xrr_moninf_name
+          , xrr_moninf_width
+          , xrr_moninf_height
+          , xrr_moninf_mwidth
+          , xrr_moninf_mheight
+          } = do
+      name <- fromMaybe "???" <$> getAtomName dpy xrr_moninf_name
+      let
+          width = fromIntegral xrr_moninf_width
+          height = fromIntegral xrr_moninf_height
+          width_mm = fromIntegral xrr_moninf_mwidth
+          height_mm = fromIntegral xrr_moninf_mheight
+          dpi_x = width / width_mm * 25.4
+          dpi_y = height / height_mm * 25.4
+      return Output
+        { name = name
+        , device_scale_factor = dpi_x / default_dpi
+        , dpi_x = dpi_x
+        , dpi_y = dpi_y
+        , width = fromIntegral xrr_moninf_width
+        , height = fromIntegral xrr_moninf_height
+        , width_mm = fromIntegral xrr_moninf_mwidth
+        , height_mm = fromIntegral xrr_moninf_mheight
+        }
-- 
cgit v1.2.3