From 329a11c99f2d8b0b3c6c4937a6cdc66b5bbef714 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 7 Jun 2018 14:06:13 -0700 Subject: [PATCH] gl: Scale gl:viewport's dimensions per gdk_window_get_scale_factor. --- src/gl/gl-glx.scm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/gl/gl-glx.scm b/src/gl/gl-glx.scm index 0b3e70d41..11de2df14 100644 --- a/src/gl/gl-glx.scm +++ b/src/gl/gl-glx.scm @@ -231,10 +231,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (define-method fix-widget-new-geometry-callback ((widget )) (call-next-method widget) - (if (glx-widget-xwindow widget) - (let ((geometry (fix-widget-geometry widget))) - (let ((w (fix-rect-width geometry)) - (h (fix-rect-height geometry))) + (let ((xwindow (glx-widget-xwindow widget))) + (if xwindow + (let ((geometry (fix-widget-geometry widget)) + (scale (C-call "gdk_window_get_scale_factor" xwindow))) + (let ((w (fix:* scale (fix-rect-width geometry))) + (h (fix:* scale (fix-rect-height geometry)))) (let ((aspect (->flonum (/ w h)))) (with-glx-widget widget (lambda () @@ -244,7 +246,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (glu:perspective (glx-viewport-fovy widget) aspect (glx-viewport-near widget) - (glx-viewport-far widget))))))))) + (glx-viewport-far widget)))))))))) (define (draw-callback widget cr) (declare (ignore cr)) -- 2.25.1