From 54de09f30e5fe039227403519ea8ad56db2b2af3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 3 Aug 2015 18:47:20 -0600
Subject: [PATCH] add PLT_DISPLAY_BACKING_SCALE

Also, fix conversion of @2x bitmaps to pixbufs at 2.0 scale.
---
 dconf/user                                 | Bin 0 -> 2 bytes
 gui-doc/scribblings/gui/win-overview.scrbl |   6 ++++++
 gui-lib/mred/private/wx/gtk/pixbuf.rkt     |   2 +-
 gui-lib/mred/private/wx/gtk/resolution.rkt |  10 +++++++++-
 4 files changed, 16 insertions(+), 2 deletions(-)
 create mode 100644 dconf/user

diff --git a/dconf/user b/dconf/user
new file mode 100644
index 0000000000000000000000000000000000000000..09f370e38f498a462e1ca0faa724559b6630c04f
GIT binary patch
literal 2
JcmZQz0000200961

literal 0
HcmV?d00001

diff --git a/gui-doc/scribblings/gui/win-overview.scrbl b/gui-doc/scribblings/gui/win-overview.scrbl
index 69fdb7a4..f8c9e5c0 100644
--- a/gui-doc/scribblings/gui/win-overview.scrbl
+++ b/gui-doc/scribblings/gui/win-overview.scrbl
@@ -1024,4 +1024,10 @@ reported size of a window to be different than a size to which a
 window has just been set.  A ``point'' for font sizing is equivalent
 to @racket[(/ 96 72)] drawing units.
 
+On Unix, if the @indexed-envvar{PLT_DISPLAY_BACKING_SCALE} environment
+variable is set to a positive real number, then it overrides any
+system setting for @racketmodname[racket/gui] scaling.  Menus, control
+labels using the default label font, and non-label control parts will
+not use the specified scale, however.
+
 @history[#:changed "1.14" @elem{Added support for scaling on Unix.}]
diff --git a/gui-lib/mred/private/wx/gtk/pixbuf.rkt b/gui-lib/mred/private/wx/gtk/pixbuf.rkt
index e1f3a8a5..4a73da23 100644
--- a/gui-lib/mred/private/wx/gtk/pixbuf.rkt
+++ b/gui-lib/mred/private/wx/gtk/pixbuf.rkt
@@ -55,7 +55,7 @@
     (define-values (bm unscaled? usw ush)
       (cond
        [(= scale 1.0) (values orig-bm #f w h)]
-       [(= scale (send orig-bm get-backing-scale)) (values orig-bm #t w h)]
+       [(= scale (send orig-bm get-backing-scale)) (values orig-bm #t sw sh)]
        [else (values (rescale orig-bm scale) #f sw sh)]))
     (send bm get-argb-pixels 0 0 usw ush str #f #:unscaled? unscaled?)
     (let ([mask (send bm get-loaded-mask)])
diff --git a/gui-lib/mred/private/wx/gtk/resolution.rkt b/gui-lib/mred/private/wx/gtk/resolution.rkt
index 1a869516..c387b572 100644
--- a/gui-lib/mred/private/wx/gtk/resolution.rkt
+++ b/gui-lib/mred/private/wx/gtk/resolution.rkt
@@ -6,9 +6,17 @@
 (provide get-interface-scale-factor)
 
 (define (get-interface-scale-factor display-num)
-  (or (get-gnome-interface-scale-factor)
+  (or (get-environment-variable-scale-factor)
+      (get-gnome-interface-scale-factor)
       1.0))
 
+(define (get-environment-variable-scale-factor)
+  (define s (getenv "PLT_DISPLAY_BACKING_SCALE"))
+  (define n (and s (string->number s)))
+  (and (rational? n)
+       (positive? n)
+       (exact->inexact n)))
+
 (define interface-settings
   (let ([interface-schema "org.gnome.desktop.interface"])
     (delay