diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | README | 2 | ||||
| -rw-r--r-- | app/xoutinfo.hs | 82 | ||||
| -rw-r--r-- | shell.nix | 21 | ||||
| -rw-r--r-- | xoutinfo.cabal | 20 |
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 @@ -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 |