1 files changed, 25 insertions, 9 deletions
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index ea71ef2..980cbe7 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -4,7 +4,8 @@ import Control.Monad (forM_, unless)
 import Control.Monad.Writer (execWriter, tell)
 import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
 import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.Maybe (isJust)
+import Data.List (find, isPrefixOf)
+import Data.Maybe (fromMaybe, isJust)
 import Rahm.Desktop.Layout.Draw (drawLayout)
 import Rahm.Desktop.Logger
   ( LogLevel (Debug, Error, Fatal, Trace, Warn),
@@ -21,8 +22,11 @@ import Rahm.Desktop.Workspaces
     getPopulatedWorkspaces,
   )
 import Rahm.Desktop.XMobarLog.PendingBuffer (getPendingBuffer)
+import System.Exit (ExitCode (..))
 import System.IO (Handle, hPutStrLn, hSetEncoding, utf8)
+import System.Process (readProcessWithExitCode)
 import Text.Printf (printf)
+import Text.Read (readMaybe)
 import XMonad (X)
 import qualified XMonad as X (XState (windowset), gets, io)
 import XMonad.Util.NamedWindows (getName)
@@ -30,16 +34,28 @@ import XMonad.Util.Run (runProcessWithInput, spawnPipe)
 
 newtype XMobarLog = XMobarLog Handle
 
--- The log hook for XMobar. This is a custom log hook that does not use any
--- of the Xmonad dynamic log libraries.
---
--- This is because the given dynamic log libraries don't handle unicode properly
--- and this has been causing issues. It is also more flexible and frankly easier
+getDPI :: IO Double
+getDPI = do
+  out <- runProcessWithInput "xrdb" ["-query"] ""
+  pure $
+    case find (isPrefixOf "Xft.dpi:") (lines out) of
+      Just line -> fromMaybe 144 . readMaybe . dropWhile (== ' ') . drop 1 . dropWhile (/= ':') $ line
+      Nothing -> 144
+
 -- to just DIY.
 
 spawnXMobar :: IO XMobarLog
 spawnXMobar = do
-  pipe <- spawnPipe "xmobar"
+  putStrLn "get dpi"
+  dpi <- getDPI
+  let scale = dpi / 120
+
+  putStrLn $ "DPI: " ++ show dpi
+  putStrLn $ "scale: " ++ show scale
+
+  pipe <-
+    spawnPipe $
+      printf "xmobar --dpi=%d --position='TopSize C 99 %d'" (round dpi :: Int) ((round $ scale * 60.0) :: Int)
   hSetEncoding pipe utf8
   return (XMobarLog pipe)
 
@@ -127,14 +143,14 @@ xMobarLogHook = do
       | isAsciiUpper ch
           || isAsciiLower ch
           || isDigit ch =
-        printf "<action=`xdotool key 'Super_L+g' '%s'` button=1><action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
+          printf "<action=`xdotool key 'Super_L+g' '%s'` button=1><action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
     toTheaterAction [ch]
       | isAsciiUpper ch
           || isAsciiLower ch
           || isDigit ch =
-        printf "<action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=1>%s</action>" [ch] [ch]
+          printf "<action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=1>%s</action>" [ch] [ch]
     toTheaterAction ch = ch
 
     toChangeLayoutAction :: String -> String