Merge pull request #5 from meck/master

Scale strut according to GDK_SCALE on hidpi
taffybar · Jun 9, 2020 · cc8d460 · cc8d460
2 parents 84a96d5 + c9c0fba
commit cc8d460
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 1 deletion.
diff --git a/src/Graphics/UI/EWMHStrut.hs b/src/Graphics/UI/EWMHStrut.hs
@@ -42,6 +42,22 @@ zeroStrutSettings = EWMHStrutSettings
   , _bottom_end_x = 0
   }
 
+scaleStrutSettings :: Int32 -> EWMHStrutSettings -> EWMHStrutSettings
+scaleStrutSettings scaleFactor st = st 
+  { _left = _left st * scaleFactor
+  , _right = _right st * scaleFactor
+  , _top = _top st * scaleFactor
+  , _bottom = _bottom st * scaleFactor
+  , _left_start_y = _left_start_y st * scaleFactor
+  , _left_end_y = _left_end_y st * scaleFactor
+  , _right_start_y = _right_start_y st * scaleFactor
+  , _right_end_y = _right_end_y st * scaleFactor
+  , _top_start_x = _top_start_x st * scaleFactor
+  , _top_end_x = _top_end_x st * scaleFactor
+  , _bottom_start_x = _bottom_start_x st * scaleFactor
+  , _bottom_end_x = _bottom_end_x st * scaleFactor
+  }
+
 strutSettingsToPtr :: MonadIO m => EWMHStrutSettings -> m (Ptr CULong)
 strutSettingsToPtr EWMHStrutSettings
                      { _left = left

diff --git a/src/Graphics/UI/GIGtkStrut.hs b/src/Graphics/UI/GIGtkStrut.hs
@@ -80,6 +80,7 @@ setupStrutWindow StrutConfig
   geometry <- Gdk.newZeroGeometry
 
   monitorGeometry <- Gdk.monitorGetGeometry monitor
+  monitorScaleFactor <- Gdk.monitorGetScaleFactor monitor
   monitorWidth <- Gdk.getRectangleWidth monitorGeometry
   monitorHeight <- Gdk.getRectangleHeight monitorGeometry
   monitorX <- Gdk.getRectangleX monitorGeometry
@@ -156,7 +157,8 @@ setupStrutWindow StrutConfig
       setStrutProperties =
         void $ runMaybeT $ do
           gdkWindow <- MaybeT $ Gtk.widgetGetWindow window
-          lift $ setStrut gdkWindow ewmhSettings
+          lift $ setStrut gdkWindow $ 
+              scaleStrutSettings monitorScaleFactor ewmhSettings
 
   void $ Gtk.onWidgetRealize window setStrutProperties