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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE DuplicateRecordFields #-}
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
data Override =
Override
{ height_mm :: Maybe Int
, width_mm :: Maybe Int
}
deriving (Generic, Show)
instance FromJSON Override
emptyOverride :: Override
emptyOverride =
Override
{ height_mm = Nothing
, width_mm = Nothing
}
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
Override
{ width_mm = override_width_mm
, height_mm = override_height_mm
} <-
fromMaybe emptyOverride . maybe Nothing (decode . L8.pack)
<$> lookupEnv "XOUTINFO_OVERRIDE"
let
width = fromIntegral xrr_moninf_width
height = fromIntegral xrr_moninf_height
width_mm =
fromMaybe (fromIntegral xrr_moninf_mwidth)
override_width_mm
height_mm =
fromMaybe (fromIntegral xrr_moninf_mheight)
override_height_mm
dpi_x = fromIntegral width / fromIntegral width_mm * 25.4
dpi_y = fromIntegral height / fromIntegral height_mm * 25.4
return Output
{ name = name
, device_scale_factor = dpi_x / default_dpi
, dpi_x = dpi_x
, dpi_y = dpi_y
, width = width
, height = height
, width_mm = width_mm
, height_mm = height_mm
}
|
