summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2024-05-08 21:56:19 +0200
committertv <tv@krebsco.de>2024-05-08 21:56:19 +0200
commitcf7377886a55e36701bd0d5ce7c723aa6d7bd9bd (patch)
treeb8a8bc01688d668b7b03f658e7ef637dd774af6a
initial commitHEADmaster
-rw-r--r--.gitignore1
-rw-r--r--README2
-rw-r--r--app/xoutinfo.hs82
-rw-r--r--shell.nix21
-rw-r--r--xoutinfo.cabal20
5 files changed, 126 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..0f3bc17
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+/default.nix
diff --git a/README b/README
new file mode 100644
index 0000000..379dbc1
--- /dev/null
+++ b/README
@@ -0,0 +1,2 @@
+cabal2nix . > default.nix && nix-shell
+cabal run --builddir="$HOME"/tmp/cache/xoutinfo
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
+ }
diff --git a/shell.nix b/shell.nix
new file mode 100644
index 0000000..7fc0947
--- /dev/null
+++ b/shell.nix
@@ -0,0 +1,21 @@
+{ compiler ? "default"
+, nixpkgs ? import <nixpkgs> {}
+}: let
+
+ inherit (nixpkgs) lib pkgs;
+
+ haskellPackages =
+ if compiler == "default" then
+ pkgs.haskellPackages
+ else
+ pkgs.haskell.packages.${compiler};
+
+ drv = haskellPackages.callPackage (import ./.) {};
+
+in
+
+ lib.overrideDerivation drv.env (oldAttrs: {
+ buildInputs = [
+ pkgs.cabal-install
+ ];
+ })
diff --git a/xoutinfo.cabal b/xoutinfo.cabal
new file mode 100644
index 0000000..d393ae5
--- /dev/null
+++ b/xoutinfo.cabal
@@ -0,0 +1,20 @@
+cabal-version: 3.4
+name: xoutinfo
+version: 0.1.0.0
+license: WTFPL
+author: tv
+maintainer: tv@krebsco.de
+build-type: Simple
+
+common warnings
+ ghc-options: -Wall
+
+executable xoutinfo
+ import: warnings
+ main-is: xoutinfo.hs
+ build-depends: base
+ , aeson
+ , bytestring
+ , X11
+ hs-source-dirs: app
+ default-language: GHC2021