allow overriding {width,height}_mm

1 files changed, 30 insertions, 2 deletions

diff --git a/app/xoutinfo.hs b/app/xoutinfo.hs
index e2fa1e3..4fd944f 100644
--- a/app/xoutinfo.hs
+++ b/app/xoutinfo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 module Main (main) where
 
 import Control.Exception
@@ -27,6 +28,21 @@ data Output =
 
 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
@@ -63,11 +79,23 @@ main = do
           , 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 = fromIntegral xrr_moninf_mwidth
-          height_mm = fromIntegral xrr_moninf_mheight
+          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