1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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
}
|
