racket/gui: DPI-aware on Windows

The `racket/draw` library is now independent of the screen resolution
on Windows. Font sizes in "points" are the only place where the
resolution mattered before, and now `racket/draw` assumes a
traditional 96dpi on Windows and Linux (and a traditional 72dpi
on Mac OS X).

Setting the scale for "text and other items" in Windows now adjusts
the backing scale of screen and canvas-compatible bitmaps, as well as
setting a scale on canvas drawing. Window and screen positions and
sizes are similarly scaled; for example, if the screen is 2048x1436
with text scaled by 200%, then `racket/gui` reports the display size
as 1024x768 (and the display backing scale as 2.0).

Backing scales of 1.25 and 1.5 are common for Windows. Rounding
associated with those scales could cause trouble for virtual -> actual
-> virtual conversions.

pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl

@@ -15,8 +15,10 @@ A bitmap has a @deftech{backing scale}, which is the number of pixels
  bitmap is used as a target for drawing or when the bitmap is drawn
  into another context.  For example, on Mac OS X when the main monitor
  is in Retina mode, @racket[make-screen-bitmap] returns a bitmap whose
- backing scale is @racket[2.0]. A monochrome bitmap always has a
+ backing scale is @racket[2.0]. On Windows, the backing scale of a screen
- backing scale of @racket[1.0].
+ bitmap corresponds to the system-wide text scale (see @secref[#:doc '(lib
+ "scribblings/gui/gui.scrbl") "display-resolution"]). A monochrome bitmap always
+ has a backing scale of @racket[1.0].
 
 A bitmap is convertible to @racket['png-bytes] through the
 @racketmodname[file/convertible] protocol.

pkgs/draw-pkgs/draw-doc/scribblings/draw/font-class.scrbl

@@ -76,7 +76,8 @@ A @defterm{font} is an object which determines the appearance of text,
 @item{size-in-pixels? --- @racket[#t] if the size of the font
  is in logical drawing units (i.e., pixels for an unscaled screen or
  bitmap drawing context), @racket[#f] if the size of the font is in
- points (which can depend on screen resolution).}
+ ``points'', where a ``point'' is equal to 1 pixel on Max OS X and
+ @racket[(/ 96 72)] pixels on Windows and Unix}
 
 @item{hinting --- Whether font metrics should be rounded to integers:
  @itemize[
@@ -94,6 +95,8 @@ To avoid creating multiple fonts with the same characteristics, use
 See also
 @racket[font-name-directory<%>].
 
+@history[#:changed "1.2" @elem{Defined ``points'' as  @racket[(/ 96 72)] pixels on Windows,
+                               independent of the screen resolution.}]
 
 
 @defconstructor*/make[(()

pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl

@@ -751,31 +751,22 @@ Different kinds of bitmaps can produce different results:
        constrained resources only during the drawing process.}
 
  @item{Drawing to a bitmap produced by @racket[make-screen-bitmap]
-       from @racketmodname[racket/gui/base] or by @xmethod[canvas%
+       from @racketmodname[racket/gui/base] uses the same
-       make-bitmap] uses the same platform-specific drawing operations
+       platform-specific drawing operations as drawing into a
-       as drawing into a @racket[canvas%] instance. A bitmap produced
+       @racket[canvas%] instance. A bitmap produced by
-       by @racket[make-screen-bitmap] is the same as one produced by
+       @racket[make-screen-bitmap] uses the same platform-specific
-       @racket[make-platform-bitmap] on Windows or Mac OS X, but it
+       drawing as @racket[make-platform-bitmap] on Windows or Mac OS
-       may be sensitive to the X11 server on Unix. On Mac OS X, when
+       X, but possibly scaled, and it may be sensitive to the X11
-       the main screen is in Retina mode (at the time that the bitmap
+       server on Unix.
-       is created), the bitmap is also internally scaled so that one
-       drawing unit uses two pixels.
  
-       Use @racket[make-screen-bitmap] when drawing to a bitmap as an
+       On Mac OS X, when the main screen is in Retina mode (at the
-       offscreen buffer before transferring an image to the screen, or
+       time that the bitmap is created), the bitmap is also internally
-       when consistency with screen drawing is needed for some other
+       scaled so that one drawing unit uses two pixels. Similarly, on
-       reason.}
+       Windows, when the main display's text scale is configured at
-
+       the operating-system level (see @secref[#:doc '(lib
- @item{Drawing to a bitmap produced by @racket[make-screen-bitmap]
+       "scribblings/gui/gui.scrbl") "display-resolution"]), the bitmap
-       from @racketmodname[racket/gui/base]
+       is internally scaled, where common configurations map a drawing
-       uses the same platform-specific drawing operations
+       unit to @math{1.25}, @math{1.5}, or @math{2} pixels.
-       as drawing into a @racket[canvas%] instance. A bitmap produced
-       by @racket[make-screen-bitmap] is the same as one produced by
-       @racket[make-platform-bitmap] on Windows or Mac OS X, but it
-       may be sensitive to the X11 server on Unix. On Mac OS X, when
-       the main screen is in Retina mode (at the time that the bitmap
-       is created), the bitmap is also internally scaled so that one
-       drawing unit uses two pixels.
 
        Use @racket[make-screen-bitmap] when drawing to a bitmap as an
        offscreen buffer before transferring an image to the screen, or
@@ -787,9 +778,12 @@ Different kinds of bitmaps can produce different results:
        @racket[make-screen-bitmap], but on Mac OS X, the bitmap is
        optimized for drawing to the screen (by taking advantage of
        system APIs that can, in turn, take advantage of graphics
-       hardware).}
+       hardware).
+
+       Use @xmethod[canvas% make-bitmap] for similar purposes
+       as @racket[make-screen-bitmap], particularly when the bitmap
+       will be drawn later to a known target canvas.}
 
 ]
 
-
 @close-eval[draw-eval]

pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt

@@ -1008,15 +1008,17 @@
     (init w h backing-scale)
     (super-make-object (make-alternate-bitmap-kind w h backing-scale))
 
-    (define s (build-cairo-surface w h))
+    (define s (build-cairo-surface w h backing-scale))
     ;; erase the bitmap
     (let ([cr (cairo_create s)])
       (cairo_set_source_rgba cr 1.0 1.0 1.0 1.0)
       (cairo_paint cr)
       (cairo_destroy cr))
 
-    (define/public (build-cairo-surface w h)
+    (define/public (build-cairo-surface w h backing-scale)
-      (cairo_win32_surface_create_with_dib CAIRO_FORMAT_RGB24 w h))
+      (let ([sw (*i backing-scale w)]
+	    [sh (*i backing-scale h)])
+	(cairo_win32_surface_create_with_dib CAIRO_FORMAT_RGB24 sw sh)))
 
     (define/override (ok?) #t)
     (define/override (is-color?) #t)

pkgs/draw-pkgs/draw-lib/racket/draw/private/font.rkt

@@ -119,6 +119,15 @@
      (cairo_destroy cr)
      (cairo_surface_destroy s))))
 
+(define dpi-scale
+  ;; Hard-wire 96dpi for Windows and Linux, but 72 dpi for Mac OS X
+  ;; (based on historical defaults on those platforms).
+  ;; If the actual DPI for the screen is different, we'll handle
+  ;; that by scaling to and from the screen.
+  (if (eq? 'macosx (system-type))
+      1.0
+      (/ 96.0 72.0)))
+
 (defclass font% object%
 
   (define table-key #f)
@@ -173,9 +182,8 @@
                                                       [(normal) PANGO_WEIGHT_MEDIUM]
                                                       [(light) PANGO_WEIGHT_LIGHT]
                                                       [(bold) PANGO_WEIGHT_BOLD])))
-          (if size-in-pixels?
+          (let ([size (if size-in-pixels? size (* dpi-scale size))])
-              (pango_font_description_set_absolute_size desc (* size PANGO_SCALE))
+            (pango_font_description_set_absolute_size desc (* size PANGO_SCALE)))
-              (pango_font_description_set_size desc (inexact->exact (floor (* size PANGO_SCALE)))))
           (install! desc)
           (atomically (hash-set! font-descs key desc))
           desc)))

pkgs/gui-pkgs/gui-doc/scribblings/gui/global-draw-funcs.scrbl

@@ -18,15 +18,19 @@ other actions depend on updating the display.}
                                     (or/c (>/c 0.0) #f)]{
 
 Returns the number of pixels that correspond to one drawing unit on a
-monitor.  The result is normally @racket[1.0], but it is @racket[2.0] on
+monitor.  The result is normally @racket[1.0], but it is @racket[2.0]
-Mac OS X in Retina display mode.
+on Mac OS X in Retina display mode, and on Windows it can be a value
+such as @racket[1.25], @racket[1.5], or @racket[2.0] when the operating-system
+scale for text is changed.  See also @secref["display-resolution"].
 
 On Mac OS X, the result can change at any time.  See also
 @xmethod[top-level-window<%> display-changed].
 
 If @racket[monitor] is not less than the current number of available
  monitors (which can change at any time), the is @racket[#f]. See also
- @xmethod[top-level-window<%> display-changed].}
+ @xmethod[top-level-window<%> display-changed].
+
+@history[#:changed "1.2" @elem{Added backing-scale support on Windows.}]}
 
 
 @defproc[(get-display-count) exact-positive-integer?]{
@@ -70,7 +74,8 @@ When the optional @racket[avoid-bars?] argument is true, for @racket[monitor]
 If @racket[monitor] is not less than the current number of available
  monitors (which can change at any time), the results are @racket[#f]
  and @racket[#f]. See also @xmethod[top-level-window<%> display-changed].
-}
+
+See also @secref["display-resolution"].}
 
 
 @defproc[(get-display-size [full-screen? any/c #f]
@@ -93,7 +98,9 @@ On Windows and Mac OS X, if the optional argument is true and @racket[monitor] i
 If @racket[monitor] is not less than the current number of available
  monitors (which can change at any time), the results are @racket[#f]
  and @racket[#f]. See also @xmethod[top-level-window<%> display-changed].
-}
+
+See also @secref["display-resolution"].}
+
 
 
 @defproc[(is-color-display?)

pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl

@@ -280,8 +280,9 @@ canvas in its default configuration.
 In particular, on Mac OS X when the main monitor is in Retina display
 mode, a drawing unit corresponds to two pixels, and the bitmap
 internally contains four times as many pixels as requested by
-@racket[width] and @racket[height]. See also
+@racket[width] and @racket[height]. On Windows, the backing scale
-@racket[get-display-backing-scale].
+is similarly increased by adjusting the operating-system text scale.
+See also @racket[get-display-backing-scale].
 
 See also @secref[#:doc '(lib "scribblings/draw/draw.scrbl") "Portability"].}
 

pkgs/gui-pkgs/gui-doc/scribblings/gui/win-overview.scrbl

@@ -999,3 +999,30 @@ suspend-flush] will soon follow, because the process of flushing to
 the screen can be starved if flushing is frequently suspend.  The
 method @xmethod[canvas% refresh-now] conveniently encapsulates this
 sequence.
+
+@; ----------------------------------------
+
+@section[#:tag "display-resolution"]{Screen Resolution and Text Scaling}
+
+On Mac OS X, screen sizes are described to users in terms of drawing
+units. A Retina display provides two pixels per drawing unit, while
+drawing units are used consistently for window sizes, child window
+positions, and canvas drawing. A ``point'' for font sizing is
+equivalent to a drawing unit.
+
+On Windows, screen sizes are described to users in terms of pixels,
+while a scale can be selected independently by the user to apply to
+text and other items. Typical text scales are 125%, 150%, and
+200%. The @racketmodname[racket/gui] library uses this scale for all
+GUI elements, including the screen, windows, buttons, and canvas
+drawing. For example, if the scale is 200%, then the screen size
+reported by @racket[get-display-size] will be half of the number of
+pixels in each dimension. Beware that round-off effects can cause the
+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, the @racketmodname[racket/gui] library always uses the
+drawing units of the X11 server, and it uses a backing scale of
+@math{1.0} for screen and canvas-compatible bitmaps.  A ``point'' for
+font sizing is equivalent to @racket[(/ 96 72)] drawing units.

pkgs/gui-pkgs/gui-lib/mred/private/wx/common/backing-dc.rkt

@@ -175,35 +175,51 @@
 (define (release-backing-bitmap bm)
   (send bm release-bitmap-storage))
 
+(define (scale-mixin %)
+  (class %
+    (define backing-scale 1.0)
+
+    (super-new)
+    
+    (define/override (init-cr-matrix cr)
+      (unless (= backing-scale 1.0)
+	      (cairo_scale cr backing-scale backing-scale))
+      (super init-cr-matrix cr))
+    
+    (define/override (reset-config s)
+      (set! backing-scale s)
+      (super reset-config))))
+
 (define cairo-dc
-  (make-object (dc-mixin
+  (make-object (scale-mixin
-                (class default-dc-backend%
+		(dc-mixin
-                  (inherit reset-cr)
+		 (class default-dc-backend%
+                   (inherit reset-cr)
 
-                  (define cr #f)
+                   (define cr #f)
-                  (define w 0)
+                   (define w 0)
-                  (define h 0)
+                   (define h 0)
 
-                  (super-new)
+                   (super-new)
 
-                  (define/public (set-cr new-cr new-w new-h)
+                   (define/public (set-cr new-cr new-w new-h)
-                    (set! cr new-cr)
+                     (set! cr new-cr)
-                    (set! w new-w)
+                     (set! w new-w)
-                    (set! h new-h)
+                     (set! h new-h)
-                    (when cr
+                     (when cr
-                      (reset-cr cr)))
+                       (reset-cr cr)))
 
-                  (define/override (get-cr) cr)
+                   (define/override (get-cr) cr)
 
-                  (define/override (reset-clip cr)
+                   (define/override (reset-clip cr)
-                    (super reset-clip cr)
+                     (super reset-clip cr)
-                    (cairo_rectangle cr 0 0 w h)
+                     (cairo_rectangle cr 0 0 w h)
-                    (cairo_clip cr))))))
+                     (cairo_clip cr)))))))
 
-(define (backing-draw-bm bm cr w h [dx 0] [dy 0])
+(define (backing-draw-bm bm cr w h [dx 0] [dy 0] [backing-scale 1.0])
   (if (procedure? bm)
       (begin
-        (send cairo-dc reset-config)
+        (send cairo-dc reset-config backing-scale)
         (send cairo-dc set-cr cr w h)
 	(unless (and (zero? dx) (zero? dy))
 	  (send cairo-dc translate dx dy))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/canvas.rkt

@@ -105,7 +105,7 @@
                              "PLTTabPanel"
                              #f
                              (bitwise-ior WS_CHILD)
-                             0 0 w h
+                             0 0 (->screen w) (->screen h)
                              (send parent get-content-hwnd)
                              #f
                              hInstance
@@ -122,7 +122,7 @@
                                      (if panel-hwnd WS_VISIBLE 0)
                                      (if hscroll? WS_HSCROLL 0)
                                      (if vscroll? WS_VSCROLL 0))
-                        0 0 w h
+                        0 0 (->screen w) (->screen h)
                         (or panel-hwnd (send parent get-content-hwnd))
                         #f
                         hInstance
@@ -136,7 +136,7 @@
                                                   CBS_DROPDOWNLIST 
                                                   WS_HSCROLL WS_VSCROLL
                                                   WS_BORDER WS_CLIPSIBLINGS)
-                                     0 0 w h
+                                     0 0 (->screen w) (->screen h)
                                      panel-hwnd
                                      #f
                                      hInstance
@@ -148,7 +148,7 @@
                             "PLTTabPanel"
                             #f
                             (bitwise-ior WS_CHILD WS_CLIPSIBLINGS WS_VISIBLE)
-                            0 0 w h
+                            0 0 (->screen w) (->screen h)
                             canvas-hwnd
                             #f
                             hInstance
@@ -282,10 +282,10 @@
        (when panel-hwnd
          (let* ([r (and (or (= w -1) (= h -1))
                         (GetWindowRect hwnd))]
-                [w (if (= w -1) (- (RECT-right r) (RECT-left r)) w)]
+                [w (if (= w -1) (->normal (- (RECT-right r) (RECT-left r))) w)]
-                [h (if (= h -1) (- (RECT-bottom r) (RECT-top r)) h)])
+                [h (if (= h -1) (->normal (- (RECT-bottom r) (RECT-top r))) h)])
-           (MoveWindow canvas-hwnd 0 0 (max 1 (- w COMBO-WIDTH)) h #t)
+           (MoveWindow canvas-hwnd 0 0 (->screen (max 1 (- w COMBO-WIDTH))) (->screen h) #t)
-           (MoveWindow combo-hwnd 0 0 (max 1 w) (- h 2) #t)))
+           (MoveWindow combo-hwnd 0 0 (->screen (max 1 w)) (->screen (- h 2)) #t)))
        (when (and (is-auto-scroll?)
                   (not (is-panel?)))
          (reset-auto-scroll))
@@ -618,14 +618,14 @@
     (define/override (notify-child-extent x y)
       (let* ([content-hwnd (get-content-hwnd)]
              [r (GetWindowRect content-hwnd)]
-             [w (- (RECT-right r) (RECT-left r))]
+             [w (->normal (- (RECT-right r) (RECT-left r)))]
-             [h (- (RECT-bottom r) (RECT-top r))])
+             [h (->normal (- (RECT-bottom r) (RECT-top r)))])
         (when (or (> x w) (> y h))
           (let ([pr (GetWindowRect (get-client-hwnd))])
             (MoveWindow content-hwnd 
                         (- (RECT-left r) (RECT-left pr))
                         (- (RECT-top r) (RECT-top pr))
-                        (max w x) (max y h)
+                        (->screen (max w x)) (->screen (max y h))
                         #t)))))
 
     (define/override (reset-dc-for-autoscroll)
@@ -635,8 +635,8 @@
              [w (- (RECT-right r) (RECT-left r))]
              [h (- (RECT-bottom r) (RECT-top r))])
         (MoveWindow content-hwnd 
-                    (- (get-virtual-h-pos))
+                    (->screen (- (get-virtual-h-pos)))
-                    (- (get-virtual-v-pos))
+                    (->screen (- (get-virtual-v-pos)))
                     w h
                     #t)))
 

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/const.rkt

@@ -611,6 +611,8 @@
 
 (define HORZRES       8)
 (define VERTRES       10)
+(define LOGPIXELSX    88)
+(define LOGPIXELSY    90)
 
 (define CBS_DROPDOWNLIST #x0003)
 (define CB_INSERTSTRING #x014A)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dc.rkt

@@ -36,18 +36,20 @@
     (init w h hwnd [gl-config #f])
     (inherit get-cairo-surface)
     (parameterize ([hwnd-param hwnd])
-      (super-new [w w] [h h] [backing-scale 1.0]))
+      (super-new [w w] [h h] [backing-scale (->screen 1.0)]))
     
-    (define/override (build-cairo-surface w h) 
+    (define/override (build-cairo-surface w h backing-scale)
       (define hwnd (hwnd-param))
       (if hwnd
           (atomically
            (let ([hdc (GetDC hwnd)])
              (begin0
-               (cairo_win32_surface_create_with_ddb hdc
+	      (let ([sw (inexact->exact (floor (* backing-scale w)))]
-                                                    CAIRO_FORMAT_RGB24 w h)
+		    [sh (inexact->exact (floor (* backing-scale h)))])
+		(cairo_win32_surface_create_with_ddb hdc
+						     CAIRO_FORMAT_RGB24 sw sh))
                (ReleaseDC hwnd hdc))))
-          (super build-cairo-surface w h)))
+          (super build-cairo-surface w h backing-scale)))
     
     (define gl (and gl-config
                     (let ([hdc (cairo_win32_surface_get_dc (get-cairo-surface))])
@@ -90,11 +92,10 @@
 	    (when v (set! gl v))
 	    v)))
 
-
     (define/override (make-backing-bitmap w h)
       (if (send canvas get-canvas-background)
           (make-object win32-bitmap% w h (send canvas get-hwnd))
-          (super make-backing-bitmap w h)))
+	  (make-object bitmap% w h #f #t (->screen 1.0))))
 
     (define/override (get-backing-size xb yb)
       (send canvas get-client-size xb yb))
@@ -125,7 +126,9 @@
           (let ([w (box 0)]
                 [h (box 0)])
             (send canvas get-client-size w h)
-	    (define r (make-RECT 0 0 (unbox w) (unbox h)))
+	    (define sw (->screen (unbox w)))
+	    (define sh (->screen (unbox h)))
+	    (define r (make-RECT 0 0 sw sh))
 	    (define clip-type
 	      (if win64?
 		  (GetClipBox hdc r)
@@ -135,8 +138,8 @@
 		   (not (and (= clip-type SIMPLEREGION)
 			     (= (RECT-left r) 0)
 			     (= (RECT-top r) 0)
-			     (= (RECT-right r) (unbox w))
+			     (= (RECT-right r) sw)
-			     (= (RECT-bottom r) (unbox h)))))
+			     (= (RECT-bottom r) sh))))
 	      ;; Another workaround: a clipping region installed by BeginPaint()
 	      ;; seems to interfere with Cairo drawing. So, draw to a
 	      ;; fresh context and copy back and forth using Win32.
@@ -149,7 +152,10 @@
 		     [cr (cairo_create surface)]
 		     [hdc2 (cairo_win32_surface_get_dc surface)])
 		(BitBlt hdc2 0 0 cw ch hdc (RECT-left r) (RECT-top r) SRCCOPY)
-		(backing-draw-bm bm cr (unbox w) (unbox h) (- (RECT-left r)) (- (RECT-top r)))
+		(cairo_scale cr (->screen 1.0) (->screen 1.0))
+		(backing-draw-bm bm cr (->normal sw) (->normal sh)
+				 (->normal (- (RECT-left r))) (->normal (- (RECT-top r)))
+				 (->screen 1.0))
 		(cairo_surface_flush surface)
 		(BitBlt hdc (RECT-left r) (RECT-top r) cw ch hdc2 0 0 SRCCOPY)
 		(cairo_surface_destroy surface)
@@ -158,7 +164,10 @@
 	      (let* ([surface (cairo_win32_surface_create hdc)]
 		     [cr (cairo_create surface)])
 		(cairo_surface_destroy surface)
-		(backing-draw-bm bm cr (unbox w) (unbox h))
+		(cairo_scale cr (->screen 1.0) (->screen 1.0))
+		(backing-draw-bm bm cr (->normal sw) (->normal sh)
+				 0 0
+				 (->screen 1.0))
 		(cairo_destroy cr))])))))
 
 (define (request-flush-delay canvas)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/font.rkt

@@ -21,10 +21,23 @@
 
 (define font-cache (pango_win32_font_cache_new))
 
+(define (scale-font f)
+  (if (= 1 (->screen 1))
+      f
+      (make-font #:size (->screen (send f get-point-size))
+		 #:face (send f get-face)
+		 #:family (send f get-family)
+		 #:style (send f get-style)
+		 #:weight (send f get-weight)
+		 #:underlined? (send f get-underlined)
+		 #:smoothing (send f get-smoothing)
+		 #:size-in-pixels? (send f get-size-in-pixels)
+		 #:hinting (send f get-hinting))))
+
 (define (font->hfont f)
   (let* ([pfont (or (pango_font_map_load_font display-font-map
 					      display-context
-					      (send f get-pango))
+					      (send (scale-font f) get-pango))
 		    ;; font load failed, so fall back to default
 		    ;; font with the same size and style:
 		    (pango_font_map_load_font display-font-map

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt

@@ -30,8 +30,6 @@
 (define-user32 SetFocus (_wfun _HWND -> _HWND))
 (define-user32 BringWindowToTop (_wfun _HWND -> (r : _BOOL) -> (unless r (failed 'BringWindowToTop))))
 
-(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))
-
 (define-user32 DrawMenuBar (_wfun _HWND -> (r : _BOOL)
                                   -> (unless r (failed 'DrawMenuBar))))
 
@@ -98,10 +96,10 @@
 					       ;; otherwise, preserve order:
 					       pos
 					       ;; monitor rectangle, which is the goal:
-					       (list (RECT-left r)
+					       (list (->normal (RECT-left r))
-						     (RECT-top r)
+						     (->normal (RECT-top r))
-						     (RECT-right r)
+						     (->normal (RECT-right r))
-						     (RECT-bottom r)))
+						     (->normal (RECT-bottom r))))
 					      rects))
 				 #t)
 			 #f)
@@ -125,14 +123,14 @@
    [all?
     (atomically
      (let ([hdc (GetDC #f)])
-       (set-box! xb (GetDeviceCaps hdc HORZRES))
+       (set-box! xb (->normal (GetDeviceCaps hdc HORZRES)))
-       (set-box! yb (GetDeviceCaps hdc VERTRES))
+       (set-box! yb (->normal (GetDeviceCaps hdc VERTRES)))
        (ReleaseDC #f hdc)))]
    [else
     (let ([r (make-RECT 0 0 0 0)])
       (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
-      (set-box! xb (- (RECT-right r) (RECT-left r)))
+      (set-box! xb (->normal (- (RECT-right r) (RECT-left r))))
-      (set-box! yb (- (RECT-bottom r) (RECT-top r))))]))
+      (set-box! yb (->normal (- (RECT-bottom r) (RECT-top r)))))]))
 
 (define (display-origin xb yb avoid-bars? num fail)
   (cond
@@ -146,8 +144,8 @@
    [avoid-bars?
     (let ([r (make-RECT 0 0 0 0)])
       (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
-      (set-box! xb (RECT-left r))
+      (set-box! xb (->normal (RECT-left r)))
-      (set-box! yb (RECT-top r)))]
+      (set-box! yb (->normal (RECT-top r))))]
    [else
     (set-box! xb 0)
     (set-box! yb 0)]))
@@ -163,7 +161,7 @@
 (define (display-bitmap-resolution num fail)
   (if (or (zero? num)
           (num . < . (display-count)))
-      1.0
+      (->screen 1.0)
       (fail)))
 
 (define mouse-frame #f)
@@ -224,9 +222,9 @@
                           0
                           (bitwise-ior WS_CAPTION
                                        WS_MINIMIZEBOX)))
-                     (or x CW_USEDEFAULT)
+                     (if x (->screen x) CW_USEDEFAULT)
-                     (or y CW_USEDEFAULT)
+                     (if y (->screen y) CW_USEDEFAULT)
-                     w h
+                     (->screen w) (->screen h)
                      #f
                      #f
                      hInstance
@@ -359,16 +357,16 @@
         (when (or max-width max-height)
           (set-MINMAXINFO-ptMaxTrackSize!
            mmi
-           (make-POINT (or max-width
+           (make-POINT (or (->screen max-width)
                            (POINT-x (MINMAXINFO-ptMaxTrackSize mmi)))
-                       (or max-height
+                       (or (->screen max-height)
                            (POINT-y (MINMAXINFO-ptMaxTrackSize mmi))))))
         (when (or min-width min-height)
           (set-MINMAXINFO-ptMinTrackSize!
            mmi
-           (make-POINT (or min-width
+           (make-POINT (or (->screen min-width)
                            (POINT-x (MINMAXINFO-ptMinTrackSize mmi)))
-                       (or min-height
+                       (or (->screen min-height)
                            (POINT-y (MINMAXINFO-ptMinTrackSize mmi)))))))
       0]
      [(= msg WM_DISPLAYCHANGE)
@@ -517,22 +515,24 @@
 	    (set-box! wh (unbox sh))))
       (get-size w h)
       (MoveWindow hwnd
-                  (if (or (eq? mode 'both)
+		  (->screen
-                          (eq? mode 'horizontal))
+		   (if (or (eq? mode 'both)
-                      (max 0 
+			   (eq? mode 'horizontal))
-			   (min (- (unbox sw) (unbox w))
+		       (max 0 
-				(+ (quotient (- (unbox ww) (unbox w)) 2) 
+			    (min (- (unbox sw) (unbox w))
-				   (unbox wx))))
+				 (+ (quotient (- (unbox ww) (unbox w)) 2) 
-                      (get-x))
+				    (unbox wx))))
-                  (if (or (eq? mode 'both)
+		       (get-x)))
-                          (eq? mode 'vertical))
+		  (->screen
-		      (max 0
+		   (if (or (eq? mode 'both)
-			   (min (- (unbox sh) (unbox h))
+			   (eq? mode 'vertical))
-				(+ (quotient (- (unbox wh) (unbox h)) 2) 
+		       (max 0
-				   (unbox wy))))
+			    (min (- (unbox sh) (unbox h))
-                      (get-x))
+				 (+ (quotient (- (unbox wh) (unbox h)) 2) 
-                  (unbox w)
+				    (unbox wy))))
-                  (unbox h)
+		       (get-x)))
+                  (->screen (unbox w))
+                  (->screen (unbox h))
                   #t)))
 
   (define saved-child #f)
@@ -593,8 +593,8 @@
     (if (iconized?)
         (let ([wp (get-placement)])
           (let ([r (WINDOWPLACEMENT-rcNormalPosition wp)])
-            (set-box! w (- (RECT-right r) (RECT-left r)))
+            (set-box! w (->normal (- (RECT-right r) (RECT-left r))))
-            (set-box! h (- (RECT-bottom r) (RECT-top r)))))
+            (set-box! h (->normal (- (RECT-bottom r) (RECT-top r))))))
         (super get-size w h)))
 
   (define/override (get-client-size w h)
@@ -608,14 +608,14 @@
   (define/override (get-x)
     (if (iconized?)
         (let ([wp (get-placement)])
-          (RECT-left (WINDOWPLACEMENT-rcNormalPosition wp)))
+          (->normal (RECT-left (WINDOWPLACEMENT-rcNormalPosition wp))))
-        (RECT-left (GetWindowRect hwnd))))
+        (->normal (RECT-left (GetWindowRect hwnd)))))
 
   (define/override (get-y)
     (if (iconized?)
         (let ([wp (get-placement)])
-          (RECT-top (WINDOWPLACEMENT-rcNormalPosition wp)))
+          (->normal (RECT-top (WINDOWPLACEMENT-rcNormalPosition wp))))
-        (RECT-top (GetWindowRect hwnd))))
+        (->normal (RECT-top (GetWindowRect hwnd)))))
 
   (define/override (get-width)
     (if (iconized?)
@@ -688,4 +688,3 @@
     (popup-menu-with-char #\space))
 
   (define/public (display-changed) (void)))
-

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gcwin.rkt

@@ -33,7 +33,7 @@
   (vector
    (vector 'osapi_ptr_ptr->void SelectObject/raw blit-hdc hbitmap)
    (vector 'osapi_ptr_int_int_int_int_ptr_int_int_long->void
-           BitBlt/raw hdc x y w h blit-hdc 0 0 SRCCOPY)
+           BitBlt/raw hdc (->screen x) (->screen y) (->screen w) (->screen h) blit-hdc 0 0 SRCCOPY)
    (vector 'ptr_ptr->void SelectObject/raw blit-hdc #f)))
 
 (define (make-gc-show-desc hdc hbitmap x y w h)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt

@@ -40,7 +40,7 @@
                        "PLTTabPanel"
                        #f
                        (bitwise-ior WS_CHILD WS_VISIBLE)
-                       0 0 w h
+                       0 0 (->screen w) (->screen h)
                        hwnd
                        #f
                        hInstance
@@ -69,4 +69,5 @@
     (define/override (set-size x y w h)
       (super set-size x y w h)
       (unless (or (= w -1) (= h -1))
-        (MoveWindow client-hwnd 3 (+ label-h 3) (- w 6) (- h label-h 6) #t)))))
+        (MoveWindow client-hwnd (->screen 3) (->screen (+ label-h 3))
+		    (->screen (- w 6)) (->screen (- h label-h 6)) #t)))))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt

@@ -25,7 +25,7 @@
 		 ;; RGB win32 bitmaps to RGB win32 bitmaps in a
 		 ;; way that sometimes mangles the alpha; avoid the
 		 ;; problem by first copying to a Cairo memory bitmap.
-		 (let* ([new-b (make-object bitmap% w h #f #f)]
+		 (let* ([new-b (make-object bitmap% w h #f #f (send bm get-backing-scale))]
 			[dc (make-object bitmap-dc% new-b)])
 		   (send dc draw-bitmap bm 0 0)
 		   (send dc set-bitmap #f)
@@ -36,14 +36,18 @@
          [to-frac (lambda (v) (/ v 255.0))]
          [screen-hdc (GetDC #f)]
          [hdc (CreateCompatibleDC screen-hdc)]
+	 [sc (->screen 1.0)]
+	 [scaled (lambda (v) (inexact->exact (ceiling (* v sc))))]
          [hbitmap (if b&w?
                       (CreateBitmap w h 1 1 #f)
-                      (CreateCompatibleBitmap screen-hdc w h))]
+                      (CreateCompatibleBitmap screen-hdc (scaled w) (scaled h)))]
          [old-hbitmap (SelectObject hdc hbitmap)])
     (ReleaseDC #f screen-hdc)
     (let* ([s (cairo_win32_surface_create hdc)]
            [cr (cairo_create s)])
       (cairo_surface_destroy s)
+      (unless (= sc 1)
+	(cairo_scale cr sc sc))
       (cairo_set_source_rgba cr 
                              (to-frac (GetRValue bg))
                              (to-frac (GetGValue bg))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt

@@ -371,8 +371,8 @@
            (set! max-col-width mx))
           (atomically
            (let ([col-desc (make-lvcolumn (bitwise-ior LVCF_WIDTH LVCF_MINWIDTH) #f)])
-             (set-LVCOLUMN-cx! col-desc w)
+             (set-LVCOLUMN-cx! col-desc (->screen w))
-             (set-LVCOLUMN-cxMin! col-desc mn)
+             (set-LVCOLUMN-cxMin! col-desc (->screen mn))
              (SendMessageW/ptr hwnd LVM_SETCOLUMNW col col-desc)
              (set! min-col-width mn)
              (set! max-col-width mx)))))
@@ -381,7 +381,7 @@
       (atomically
        (let ([col-desc (make-lvcolumn (bitwise-ior LVCF_WIDTH LVCF_MINWIDTH) #f)])
          (SendMessageW/ptr hwnd LVM_GETCOLUMNW col col-desc)
-         (let ([v (LVCOLUMN-cx col-desc)])
+         (let ([v (->normal (LVCOLUMN-cx col-desc))])
            (values (max v min-col-width) ; in XP, may have been sized too small
                    min-col-width
                    max-col-width)))))
@@ -417,7 +417,7 @@
 
     (define/public (number-of-visible-items)
       (if single-column?
-          (let ([ih (SendMessageW hwnd LB_GETITEMHEIGHT 0 0)])
+          (let ([ih (->normal (SendMessageW hwnd LB_GETITEMHEIGHT 0 0))])
             (let ([w (box 0)]
                   [h (box 0)])
               (get-client-size w h)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/menu.rkt

@@ -67,7 +67,7 @@
                                 TPM_RIGHTBUTTON
                                 TPM_NONOTIFY
                                 TPM_RETURNCMD)
-                               gx gy
+                               (->screen gx) (->screen gy)
                                0 hwnd #f)])
       (let* ([e (new popup-event% [event-type 'menu-popdown])])
         (unless (zero? cmd)

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/panel.rkt

@@ -112,7 +112,7 @@
                                               (if (memq 'border style)
                                                   WS_BORDER
                                                   0))
-                                 0 0 w h
+                                 0 0 (->screen w) (->screen h)
                                  (send parent get-content-hwnd)
                                  #f
                                  hInstance

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/printer-dc.rkt

@@ -78,10 +78,6 @@
 (define-gdi32 EndPage (_wfun _HDC -> (r : _int) -> (unless (positive? r) (failed 'EndPage))))
 (define-gdi32 EndDoc (_wfun _HDC -> (r : _int) -> (unless (positive? r) (failed 'EndDoc))))
 
-(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))
-
-(define LOGPIXELSX    88)
-(define LOGPIXELSY    90)
 (define PHYSICALOFFSETX 112)
 (define PHYSICALOFFSETY 113)
 
@@ -124,13 +120,9 @@
          ;; the hDevModes and hDevNames fields
          r)))))
 
-;; Pango uses the resolution of the screen to make point<->pixel
+;; Make on drawing unit in a printing context match the relative drawing
-;;  decisions for all devices (by default). So, we make on drawing unit in
+;; unit for the screen, where the conceptual drawing unit is always 96dpi
-;;  a printing context match the relative drawing unit for the screen.
+(define SCREEN-DPI 96)
-(define SCREEN-DPI (let ([hdc (GetDC #f)])
-		     (begin0
-		      (exact->inexact (GetDeviceCaps hdc LOGPIXELSX))
-		      (ReleaseDC #f hdc))))
 
 (define printer-dc%
   (class (record-dc-mixin (dc-mixin bitmap-dc-backend%))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/procs.rkt

@@ -84,7 +84,7 @@
 
 (define (get-double-click-time) 500)
 (define (get-control-font-face) (get-theme-font-face))
-(define (get-control-font-size) (get-theme-font-size))
+(define (get-control-font-size) (->normal (get-theme-font-size)))
 (define (get-control-font-size-in-pixels?) #t)
 
 (define-user32 MessageBeep (_wfun _UINT -> _BOOL))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/radio-box.rkt

@@ -53,7 +53,7 @@
         (let loop ([y 0] [w 0] [labels labels])
           (if (null? labels)
               (begin
-                (MoveWindow hwnd 0 0 w y #t)
+                (MoveWindow hwnd 0 0 (->screen w) (->screen y) #t)
                 null)
               (let* ([label (car labels)]
                      [bitmap? (label . is-a? . bitmap%)]
@@ -83,8 +83,12 @@
                               (auto-size font label 0 0 20 4
                                          (lambda (w1 h1)
                                            (if horiz?
-                                               (MoveWindow radio-hwnd (+ w SEP) 0 w1 h1 #t)
+                                               (MoveWindow radio-hwnd (->screen (+ w SEP)) 0
-                                               (MoveWindow radio-hwnd 0 (+ y SEP) w1 h1 #t))
+							   (->screen w1) (->screen h1)
+							   #t)
+                                               (MoveWindow radio-hwnd 0 (->screen (+ y SEP))
+							   (->screen w1) (->screen h1)
+							   #t))
                                            (values w1 h1)))])
                   (cons radio-hwnd
                         (loop (if horiz? (max y h) (+ y SEP h))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt

@@ -134,11 +134,15 @@
       (unless (or (= w -1) (= h -1))
         (if vertical?
             (let ([dx (quotient (- w THICKNESS value-w) 2)])
-              (MoveWindow slider-hwnd dx 0 THICKNESS h #T)
+              (MoveWindow slider-hwnd (->screen dx) 0
-              (MoveWindow value-hwnd (+ dx THICKNESS) (quotient (- h value-h) 2) value-w value-h #t))
+			  (->screen THICKNESS) (->screen h) #t)
+              (MoveWindow value-hwnd (->screen (+ dx THICKNESS)) (->screen (quotient (- h value-h) 2))
+			  (->screen value-w) (->screen value-h) #t))
             (let ([dy (quotient (- h THICKNESS value-h) 2)])
-              (MoveWindow slider-hwnd 0 dy w THICKNESS #t)
+              (MoveWindow slider-hwnd 0 (->screen dy)
-              (MoveWindow value-hwnd (quotient (- w value-w) 2) (+ dy THICKNESS) value-w value-h #t))))))
+			  (->screen w) (->screen THICKNESS) #t)
+              (MoveWindow value-hwnd (->screen (quotient (- w value-w) 2)) (->screen (+ dy THICKNESS))
+			  (->screen value-w) (->screen value-h) #t))))))
 
   (define/override (control-scrolled)
     (when value-hwnd

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt

@@ -65,7 +65,7 @@
                        "PLTTabPanel"
                        #f
                        (bitwise-ior WS_CHILD WS_VISIBLE)
-                       0 0 w h
+                       0 0 (->screen w) (->screen h)
                        hwnd
                        #f
                        hInstance
@@ -111,7 +111,9 @@
     (define/override (set-size x y w h)
       (super set-size x y w h)
       (unless (or (= w -1) (= h -1))
-        (MoveWindow client-hwnd 1 (+ tab-height 2) (- w 4) (- h tab-height 6) #t)))
+        (MoveWindow client-hwnd (->screen 1) (->screen (+ tab-height 2))
+		    (->screen (- w 4)) (->screen (- h tab-height 6))
+		    #t)))
 
     (define/override (is-command? cmd)
       (= cmd -551))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt

@@ -3,7 +3,9 @@
 	 ffi/unsafe/define
 	 ffi/unsafe/alloc
          "../common/utils.rkt"
-         "types.rkt")
+	 "../../lock.rkt"
+         "types.rkt"
+	 "const.rkt")
 
 (provide
  define-mz
@@ -43,7 +45,10 @@
               ModifyMenuW
               RemoveMenu
               SelectObject
-              WideCharToMultiByte))
+              WideCharToMultiByte
+	      GetDeviceCaps
+	      ->screen
+	      ->normal))
 
 (define gdi32-lib (ffi-lib "gdi32.dll"))
 (define user32-lib (ffi-lib "user32.dll"))
@@ -156,3 +161,31 @@
 (define-kernel32 WideCharToMultiByte (_wfun _UINT _DWORD _pointer _int
                                             _pointer _int _pointer _pointer
                                             -> _int))
+;; ----------------------------------------
+
+(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))
+
+(define screen-dpi
+  (atomically
+   (let ([hdc (GetDC #f)])
+     (begin0
+      (GetDeviceCaps hdc LOGPIXELSX)
+      (ReleaseDC #f hdc)))))
+
+;; Convert a normalized (conceptually 96-dpi) measure into a screen measure
+(define (->screen x)
+  (and x
+       (if (= screen-dpi 96)
+	   x
+	   (if (exact? x)
+	       (ceiling (/ (* x screen-dpi) 96))
+	       (/ (* x screen-dpi) 96)))))
+
+;; Convert a screen measure to a normalize (conceptually 96-dpi) measure
+(define (->normal x)
+  (and x
+       (if (= screen-dpi 96)
+	   x
+	   (if (exact? x)
+	       (floor (/ (* x 96) screen-dpi))
+	       (/ (* x 96) screen-dpi)))))

pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt

@@ -307,18 +307,18 @@
   (define/public (get-x)
     (let ([r (GetWindowRect hwnd)]
           [pr (GetWindowRect (send parent get-content-hwnd))])
-      (- (RECT-left r) (RECT-left pr))))
+      (->normal (- (RECT-left r) (RECT-left pr)))))
   (define/public (get-y)
     (let ([r (GetWindowRect hwnd)]
           [pr (GetWindowRect (send parent get-content-hwnd))])
-      (- (RECT-top r) (RECT-top pr))))
+      (->normal (- (RECT-top r) (RECT-top pr)))))
 
   (define/public (get-width)
     (let ([r (GetWindowRect hwnd)])
-      (- (RECT-right r) (RECT-left r))))
+      (->normal (- (RECT-right r) (RECT-left r)))))
   (define/public (get-height)
     (let ([r (GetWindowRect hwnd)])
-      (- (RECT-bottom r) (RECT-top r))))
+      (->normal (- (RECT-bottom r) (RECT-top r)))))
 
   (define/public (notify-child-extent x y)
     (void))
@@ -330,13 +330,13 @@
                           (= w -1)
                           (= h -1))
                       (let ([r (GetWindowRect hwnd)])
-                        (values (or x (RECT-left r))
+                        (values (or x (->normal (RECT-left r)))
-                                (or y (RECT-top r))
+                                (or y (->normal (RECT-top r)))
-                                (if (= w -1) (- (RECT-right r) (RECT-left r)) w)
+                                (if (= w -1) (->normal (- (RECT-right r) (RECT-left r))) w)
-                                (if (= h -1) (- (RECT-bottom r) (RECT-top r)) h)))
+                                (if (= h -1) (->normal (- (RECT-bottom r) (RECT-top r))) h)))
                       (values x y w h))])
       (when parent (send parent notify-child-extent (+ x w) (+ y h)))
-      (MoveWindow hwnd x y w h #t))
+      (MoveWindow hwnd (->screen x) (->screen y) (->screen w) (->screen h) #t))
     (unless (and (= w -1) (= h -1))
       (on-resized))
     (queue-on-size)
@@ -433,23 +433,23 @@
   (define/public (screen-to-client x y)
     (internal-screen-to-client x y))
   (define/public (internal-screen-to-client x y)
-    (let ([p (make-POINT (unbox x) (unbox y))])
+    (let ([p (make-POINT (->screen (unbox x)) (->screen (unbox y)))])
       (ScreenToClient (get-client-hwnd) p)
-      (set-box! x (POINT-x p))
+      (set-box! x (->normal (POINT-x p)))
-      (set-box! y (POINT-y p))))
+      (set-box! y (->normal (POINT-y p)))))
   (define/public (client-to-screen x y)
     (internal-client-to-screen x y))
   (define/public (internal-client-to-screen x y)
-    (let ([p (make-POINT (unbox x) (unbox y))])
+    (let ([p (make-POINT (->screen (unbox x)) (->screen (unbox y)))])
       (ClientToScreen (get-client-hwnd) p)
-      (set-box! x (POINT-x p))
+      (set-box! x (->normal (POINT-x p)))
-      (set-box! y (POINT-y p))))
+      (set-box! y (->normal (POINT-y p)))))
 
   (define/public (warp-pointer x y)
     (define xb (box x))
     (define yb (box y))
     (client-to-screen xb yb)
-    (void (SetCursorPos (unbox xb) (unbox yb))))
+    (void (SetCursorPos (->screen (unbox xb)) (->screen (unbox yb)))))
 
   (define/public (in-content? p)
     (ScreenToClient (get-client-hwnd) p)
@@ -477,13 +477,13 @@
 
   (define/public (get-client-size w h)
     (let ([r (GetClientRect (get-client-hwnd))])
-      (set-box! w (- (RECT-right r) (RECT-left r)))
+      (set-box! w (->normal (- (RECT-right r) (RECT-left r))))
-      (set-box! h (- (RECT-bottom r) (RECT-top r)))))
+      (set-box! h (->normal (- (RECT-bottom r) (RECT-top r))))))
 
   (define/public (get-size w h)
     (let ([r (GetWindowRect (get-client-hwnd))])
-      (set-box! w (- (RECT-right r) (RECT-left r)))
+      (set-box! w (->normal (- (RECT-right r) (RECT-left r))))
-      (set-box! h (- (RECT-bottom r) (RECT-top r)))))
+      (set-box! h (->normal (- (RECT-bottom r) (RECT-top r))))))
 
   (define cursor-handle #f)
   (define/public (set-cursor c)
@@ -586,7 +586,7 @@
      [(= msg WM_MOUSELEAVE)
       (let ([p (make-POINT 0 0)])
         (let ([f (and (GetCursorPos p)
-		      (location->window (POINT-x p) (POINT-y p)))])
+		      (location->window* (POINT-x p) (POINT-y p)))])
           (unless (and (eq? f (get-top-frame))
 		       (send f in-content? p))
             (do-mouse w msg #f 'leave wParam lParam))))
@@ -636,7 +636,7 @@
           [bit? (lambda (v b) (not (zero? (bitwise-and v b))))])
       (let ([make-e 
              (lambda (type)
-               (define-values (mx my) (adjust-event-position x y))
+               (define-values (mx my) (adjust-event-position (->normal x) (->normal y)))
                (new mouse-event%
                     [event-type type]
                     [left-down (case type
@@ -836,7 +836,7 @@
   (unless default-control-font
     (set! default-control-font
 	  (make-object font%
-		       (get-theme-font-size)
+		       (->normal (get-theme-font-size))
                        (logfont->pango-family
                          (get-theme-logfont))
 		       'system
@@ -850,7 +850,8 @@
 (define (queue-window-refresh-event win thunk)
   (queue-refresh-event (send win get-eventspace) thunk))
 
-(define (location->window x y)
+;; arguments in screen coordinates
+(define (location->window* x y)
   (let ([hwnd (WindowFromPoint (make-POINT x y))])
     (let loop ([hwnd hwnd])
       (and hwnd
@@ -858,6 +859,9 @@
                  (and wx (send wx get-top-frame)))
                (loop (GetParent hwnd)))))))
 
+(define (location->window x y)
+  (location->window* (->screen x) (->screen y)))
+
 (define (flush-display)
   (atomically
    (pre-event-sync #t)))

pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt

@@ -104,8 +104,7 @@
        
       (define already-trying? #f)
       (define was-bad? #f)    ; hack around min-frame-size limitations
-      (define last-width -1)
+      (define tried-sizes #hash())
-      (define last-height -1)
        
       ;; pointer to panel in the frame for use in on-size
       (define panel #f)
@@ -352,19 +351,19 @@
                   [(and (= new-width correct-w) (= new-height correct-h))
                    ;; Good size; do panel
                    (set! was-bad? #f)
+		   (set! tried-sizes #hash())
                    (enforce-size min-w min-h
                                  (if sx? -1 min-w) (if sy? -1 min-h)
                                  1 1)
                    (set-panel-size)]
-                  [(and (= last-width correct-w) (= last-height correct-h)
+                  [(and (hash-ref tried-sizes (cons correct-w correct-h) #f)
                         was-bad?)
                    ;; We give up; do panel
                    (set-panel-size)]
                   [else
                    ;; Too large/small; try to fix it, but give up after a while
                    (set! was-bad? #t)
-                   (set! last-width correct-w)
+		   (set! tried-sizes (hash-set tried-sizes (cons correct-w correct-h) #t))
-                   (set! last-height correct-h)
                    (set! already-trying? #t)
                    (enforce-size -1 -1 -1 -1 1 1)
                    (set-size #f #f correct-w correct-h)

racket/src/worksp/gracket/gracket.manifest

@@ -1,4 +1,4 @@
-<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
   <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
     <security>
       <requestedPrivileges>
@@ -19,4 +19,9 @@
       </assemblyIdentity>
     </dependentAssembly>
   </dependency>
+  <asmv3:application>
+    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
+      <dpiAware>true</dpiAware>
+    </asmv3:windowsSettings>
+  </asmv3:application>
 </assembly>

racket/src/worksp/racket/racket.manifest

@@ -1,4 +1,4 @@
-<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
   <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
     <security>
       <requestedPrivileges>
@@ -19,4 +19,9 @@
       </assemblyIdentity>
     </dependentAssembly>
   </dependency>
+  <asmv3:application>
+    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
+      <dpiAware>true</dpiAware>
+    </asmv3:windowsSettings>
+  </asmv3:application>
 </assembly>