HiDPI support on Unix (Gtk2)

Support GUI scaling in much the same way as on Windows, where
the OS setting ("org.gnome.desktop.interface.scaling-factor"
times "...text-scaling-factor") determines the scale that is
used for both graphics and GUI sizing.

As I understand it, a complete solution requires porting to
Gtk3. With Gtk2, the graphical part of a widget doesn't scale.
Text and image labels should scale correctly, though.

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

@@ -19,11 +19,11 @@ other actions depend on updating the display.}
 
 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 Mac OS X in Retina display mode, and on Windows it can be a value
+on Mac OS X in Retina display mode, and on Windows or Unix 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
+On Mac OS X or Unix, 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

gui-doc/scribblings/gui/libs.scrbl

@@ -14,6 +14,7 @@ system libraries must be installed for @racketmodname[racket/gui/base]:
  @item{@filepath{libgdk-x11-2.0[.0]}}
  @item{@filepath{libgdk_pixbuf-2.0[.0]}}
  @item{@filepath{libgtk-x11-2.0[.0]}}
+ @item{@filepath{libgio-2.0[.0]} --- optional, for detecting interface scaling}
  @item{@filepath{libGL} --- optional, for OpenGL support}
  @item{@filepath{libunique-1.0[.0]} --- optional, for single-instance support}
 ]

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

@@ -1012,7 +1012,7 @@ 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,
+On Windows and Unix, 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
@@ -1024,7 +1024,4 @@ 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
+@history[#:changed "1.14" @elem{Added support for scaling on Unix.}]
-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.

gui-lib/info.rkt

@@ -30,4 +30,4 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.13")
+(define version "1.14")

gui-lib/mred/private/wx/common/canvas-mixin.rkt

@@ -203,7 +203,7 @@
            (= (send on get-width) w)
            (= (send on get-height) h))
       on
-      (let ([bm (make-object bitmap% w h)])
+      (let ([bm (make-object bitmap% w h #:backing-scale (send on get-backing-scale))])
         (let ([dc (make-object bitmap-dc% on)])
           (send dc draw-bitmap-section on 0 0 on-x on-y w h)
           (send dc set-bitmap #f)

gui-lib/mred/private/wx/gtk/button.rkt

@@ -66,7 +66,8 @@
                    [else
                     (let ([pixbuf (bitmap->pixbuf (if (pair? label) 
                                                       (car label)
-                                                      label))])
+                                                      label)
+						  (->screen 1.0))])
                       (atomically
                        (let ([gtk (if (pair? label)
                                       (as-gtk-allocation (gtk_new_with_mnemonic (cadr label)))
@@ -125,7 +126,7 @@
       (gtk_button_set_label gtk (mnemonic-string s))
       (when the-font (install-control-font (get-label-gtk) the-font))]
      [else
-      (let ([pixbuf (bitmap->pixbuf s)])
+      (let ([pixbuf (bitmap->pixbuf s (->screen 1.0))])
         (atomically
          (let ([image-gtk (gtk_image_new_from_pixbuf pixbuf)])
            (release-pixbuf pixbuf)

gui-lib/mred/private/wx/gtk/canvas.rkt

@@ -798,10 +798,13 @@
      (define/public (register-collecting-blit x y w h on off on-x on-y off-x off-y)
        (let ([on (fix-bitmap-size on w h on-x on-y)]
              [off (fix-bitmap-size off w h off-x off-y)])
-         (let ([on-pixbuf (bitmap->pixbuf on)]
+         (let ([on-pixbuf (bitmap->pixbuf on (->screen 1.0))]
-               [off-pixbuf (bitmap->pixbuf off)])
+               [off-pixbuf (bitmap->pixbuf off (->screen 1.0))])
            (atomically
-            (set! reg-blits (cons (register-one-blit x y w h on-pixbuf off-pixbuf) reg-blits))))))
+            (set! reg-blits (cons (register-one-blit (->screen x) (->screen y)
+						     (->screen w) (->screen h)
+						     on-pixbuf off-pixbuf)
+				  reg-blits))))))
      
      (define/public (unregister-collecting-blits)
        (atomically
@@ -827,9 +830,9 @@
         (gtk_widget_size_request container-gtk req)
         (gtk_widget_set_size_request container-gtk
                                      (max (GtkRequisition-width req)
-                                          (+ x w))
+                                          (->screen (+ x w)))
                                      (max (GtkRequisition-height req)
-                                          (+ y h))))
+                                          (->screen (+ y h)))))
       (super set-child-size child-gtk x y w h))
 
     (define/override (reset-dc-for-autoscroll)

gui-lib/mred/private/wx/gtk/client-window.rkt

@@ -19,10 +19,10 @@
     (let ([wx (gtk->wx gtk)])
       (when wx
         (send wx save-client-size 
-              (GtkAllocation-x a)
+	      (->normal (GtkAllocation-x a))
-              (GtkAllocation-y a)
+              (->normal (GtkAllocation-y a))
-              (GtkAllocation-width a)
+              (->normal (GtkAllocation-width a))
-              (GtkAllocation-height a))))
+              (->normal (GtkAllocation-height a)))))
     #t))
 
 (define (client-size-mixin %)

gui-lib/mred/private/wx/gtk/dc.rkt

@@ -45,11 +45,11 @@
 (define x11-bitmap%
   (class bitmap%
     (init w h gdk-win)
-    (super-make-object (make-alternate-bitmap-kind w h 1.0))
+    (super-make-object (make-alternate-bitmap-kind w h (->screen 1.0)))
 
     (define pixmap (gdk_pixmap_new gdk-win 
-				   (min (max 1 w) 32000)
+				   (min (max 1 (->screen w)) 32000)
-				   (min (max 1 h) 32000)
+				   (min (max 1 (->screen h)) 32000)
 				   (if gdk-win 
 				       -1
 				       (GdkVisual-rec-depth
@@ -60,8 +60,8 @@
                                  (gdk_x11_drawable_get_xid pixmap)
 				 (gdk_x11_visual_get_xvisual
 				  (gdk_drawable_get_visual pixmap))
-                                 w
+                                 (->screen w)
-                                 h))
+                                 (->screen h)))
 
     ;; initialize bitmap to white:
     (let ([cr (cairo_create s)])
@@ -172,5 +172,6 @@
                 [h (box 0)])
             (send canvas get-client-size w h)
             (let ([cr (gdk_cairo_create win)])
-              (backing-draw-bm bm cr (unbox w) (unbox h))
+	      (cairo_scale cr (->screen 1.0) (->screen 1.0))
+              (backing-draw-bm bm cr (unbox w) (unbox h) 0 0 (->screen 1.0))
               (cairo_destroy cr))))))

gui-lib/mred/private/wx/gtk/frame.rkt

@@ -15,6 +15,7 @@
          "widget.rkt"
          "cursor.rkt"
          "pixbuf.rkt"
+	 "resolution.rkt"
          "../common/queue.rkt")
 
 (provide 
@@ -101,10 +102,10 @@
     (let ([wx (gtk->wx gtk)])
       (when wx
         (send wx remember-size 
-              (GdkEventConfigure-x a)
+              (->normal (GdkEventConfigure-x a))
-              (GdkEventConfigure-y a)
+              (->normal (GdkEventConfigure-y a))
-              (GdkEventConfigure-width a)
+              (->normal (GdkEventConfigure-width a))
-              (GdkEventConfigure-height a))))
+              (->normal (GdkEventConfigure-height a)))))
     #f))
 
 (define-cstruct _GdkEventWindowState ([type _int]
@@ -227,8 +228,8 @@
     ;(gtk_window_add_accel_group (widget-window gtk) the-accelerator-group)
 
     (define/override (set-child-size child-gtk x y w h)
-      (gtk_fixed_move panel-gtk child-gtk x y)
+      (gtk_fixed_move panel-gtk child-gtk (->screen x) (->screen y))
-      (gtk_widget_set_size_request child-gtk w h))
+      (gtk_widget_set_size_request child-gtk (->screen w) (->screen h)))
 
     (define/public (on-close) #t)
 
@@ -253,13 +254,13 @@
     (define saved-enforcements (vector 0 0 -1 -1))
 
     (define/public (enforce-size min-x min-y max-x max-y inc-x inc-y)
-      (define (to-max v) (if (= v -1) #x3FFFFF v))
+      (define (to-max v) (if (= v -1) #x3FFFFF (->screen v)))
       (set! saved-enforcements (vector min-x min-y max-x max-y))
       (gtk_window_set_geometry_hints gtk gtk 
-                                     (make-GdkGeometry min-x min-y
+                                     (make-GdkGeometry (->screen min-x) (->screen min-y)
                                                        (to-max max-x) (to-max max-y)
                                                        0 0
-                                                       inc-x inc-y
+                                                       (->screen inc-x) (->screen inc-y)
                                                        0.0 0.0
                                                        0)
                                      (bitwise-ior GDK_HINT_MIN_SIZE
@@ -307,12 +308,12 @@
     (define/public (set-top-position x y)
       (unless (and (not x) (not y))
         (gtk_widget_set_uposition gtk
-                                  (or x -2)
+                                  (or (and x (->screen x)) -2)
-                                  (or y -2))))
+                                  (or (and y (->screen y)) -2))))
 
     (define/override (really-set-size gtk x y processed-x processed-y w h)
       (set-top-position x y)
-      (gtk_window_resize gtk (max 1 w) (max 1 h)))
+      (gtk_window_resize gtk (max 1 (->screen w)) (max 1 (->screen h))))
 
     (define/override (show on?)
       (let ([es (get-eventspace)])
@@ -457,8 +458,8 @@
       (let-values ([(dx dy) (gtk_window_get_position gtk)]
                    [(cdx cdy) (get-client-delta)])
         (gtk_window_set_gravity gtk GDK_GRAVITY_NORTH_WEST)
-        (set-box! x (+ (unbox x) dx cdx))
+        (set-box! x (+ (unbox x) (->normal (+ dx cdx))))
-        (set-box! y (+ (unbox y) dy cdy))))
+        (set-box! y (+ (unbox y) (->normal (+ dy cdy))))))
 
     (define/public (on-toolbar-click) (void))
     (define/public (on-menu-click) (void))
@@ -563,22 +564,24 @@
 
 (define (display-origin x y all? num fail)
   (let ([r (monitor-rect num fail)])
-    (set-box! x (- (GdkRectangle-x r)))
+    (set-box! x (->normal (- (GdkRectangle-x r))))
-    (set-box! y (- (GdkRectangle-y r)))))
+    (set-box! y (->normal (- (GdkRectangle-y r))))))
 
 (define (display-size w h all? num fail)
   (let ([r (monitor-rect num fail)])
-    (set-box! w (GdkRectangle-width r))
+    (set-box! w (->normal (GdkRectangle-width r)))
-    (set-box! h (GdkRectangle-height r))))
+    (set-box! h (->normal (GdkRectangle-height r)))))
 
 (define (display-count)
   (gdk_screen_get_n_monitors (gdk_screen_get_default)))
 
 (define (display-bitmap-resolution num fail)
+  (define (get) (or (get-interface-scale-factor num)
+		    1.0))
   (if (zero? num)
-      1.0
+      (get)
       (if (num . < . (gdk_screen_get_n_monitors (gdk_screen_get_default)))
-          1.0
+          (get)
           (fail))))
 
 (define (location->window x y)

gui-lib/mred/private/wx/gtk/gsettings.rkt

@@ -0,0 +1,41 @@
+#lang racket/base
+(require ffi/unsafe
+	 ffi/unsafe/define
+	 ffi/unsafe/alloc
+	 racket/draw/unsafe/glib
+	 racket/draw/private/libs
+	 "types.rkt")
+
+(provide (protect-out (all-defined-out)))
+
+(define-runtime-lib gio-lib
+  [(unix) (ffi-lib "libgio-2.0" '("0" ""))]
+  [(macosx)
+   (ffi-lib "libgio-2.0.0.dylib")]
+  [(windows) 
+   (ffi-lib "libgio-2.0-0.dll")])
+
+(define-ffi-definer define-gio gio-lib
+  #:default-make-fail (lambda (id) (lambda () #f)))
+
+(define _GSettings-pointer (_cpointer 'GSettings))
+(define _GSettingsSchemeSource-pointer (_cpointer 'GSettingsSchemeSource))
+(define _GVariant-pointer (_cpointer 'GVariant))
+
+(define-gobj g_object_unref (_fun _pointer -> _void)
+  #:wrap (deallocator))
+
+(define-gio g_settings_schema_source_get_default (_fun -> _GSettingsSchemeSource-pointer))
+(define-gio g_settings_schema_source_lookup (_fun _GSettingsSchemeSource-pointer
+						  _string
+						  _gboolean
+						  -> _pointer)) 
+
+(define-gio g_settings_new (_fun _string -> _GSettings-pointer)
+  #:wrap (allocator g_object_unref))
+(define-gio g_settings_get_value (_fun _GSettings-pointer _string -> _GVariant-pointer))
+
+(define-glib g_variant_get_type_string (_fun _GVariant-pointer -> _string))
+(define-glib g_variant_get_int32 (_fun _GVariant-pointer -> _int32))
+(define-glib g_variant_get_uint32 (_fun _GVariant-pointer -> _uint32))
+(define-glib g_variant_get_double (_fun _GVariant-pointer -> _gdouble))

gui-lib/mred/private/wx/gtk/item.rkt

@@ -2,6 +2,7 @@
 (require ffi/unsafe
          racket/class
          racket/draw/private/local
+         (only-in racket/draw make-font)
           "../../syntax.rkt"
          "window.rkt"
          "utils.rkt"
@@ -16,7 +17,19 @@
 
 (define (install-control-font gtk font)
   (when font
-    (gtk_widget_modify_font gtk (send font get-pango))))
+    (let* ([s (->screen 1)]
+    	   [font (if (= s 1)
+		     font
+		      (make-font #:size (->screen (send font get-size))
+				 #:face (send font get-face)
+				 #:family (send font get-family)
+				 #:style (send font get-style)
+				 #:weight (send font get-weight)
+				 #:underlined? (send font get-underlined)
+				 #:smoothing (send font get-smoothing)
+				 #:size-in-pixels? (send font get-size-in-pixels)
+				 #:hinting (send font get-hinting)))])
+      (gtk_widget_modify_font gtk (send font get-pango)))))
 
 (defclass item% window%
   (inherit get-client-gtk)

gui-lib/mred/private/wx/gtk/menu.rkt

@@ -132,11 +132,11 @@
                         (let* ([s (gtk_widget_get_screen menu)]
                                [sw (gdk_screen_get_width s)]
                                [sh (gdk_screen_get_height s)])
-                          (ptr-set! _x _int (min x
+                          (ptr-set! _x _int (min (->screen x)
                                                  (max 0
                                                       (- sw
                                                          (GtkRequisition-width r)))))
-                          (ptr-set! _y _int (min y
+                          (ptr-set! _y _int (min (->screen y)
                                                  (max 0
                                                       (- sh
                                                          (GtkRequisition-height r)))))))

gui-lib/mred/private/wx/gtk/message.rkt

@@ -49,7 +49,7 @@
                              [(caution) (gtk_image_new_from_stock "gtk-dialog-warning" icon-size)]
                              [(stop) (gtk_image_new_from_stock "gtk-dialog-error" icon-size)]
                              [else (gtk_image_new_from_stock "gtk-dialog-question" icon-size)]))
-                          (let ([pixbuf (bitmap->pixbuf label)])
+                          (let ([pixbuf (bitmap->pixbuf label (->screen 1.0))])
                             (begin0
                              (as-gtk-allocation
                               (gtk_image_new_from_pixbuf pixbuf))
@@ -67,7 +67,7 @@
      [(string? s)
       (gtk_label_set_text_with_mnemonic (get-gtk) (mnemonic-string s))]
      [else
-      (let ([pixbuf (bitmap->pixbuf s)])
+      (let ([pixbuf (bitmap->pixbuf s (->screen 1.0))])
         (atomically
          (gtk_image_set_from_pixbuf (get-gtk) pixbuf)
          (release-pixbuf pixbuf)))]))

gui-lib/mred/private/wx/gtk/panel.rkt

@@ -102,8 +102,8 @@
     (inherit get-container-gtk)
     (super-new)
     (define/override (set-child-size child-gtk x y w h)
-      (gtk_fixed_move (get-container-gtk) child-gtk x y)
+      (gtk_fixed_move (get-container-gtk) child-gtk (->screen x) (->screen y))
-      (gtk_widget_set_size_request child-gtk w h))))
+      (gtk_widget_set_size_request child-gtk (->screen w) (->screen h)))))
 
 (define panel%
   (class (panel-container-mixin (panel-mixin window%))

gui-lib/mred/private/wx/gtk/pixbuf.rkt

@@ -46,26 +46,33 @@
                               #f
                               #t))
 
-(define (bitmap->pixbuf bm)
+(define (bitmap->pixbuf orig-bm [scale 1.0])
-  (let* ([w (send bm get-width)]
+  (let* ([w (send orig-bm get-width)]
-         [h (send bm get-height)]
+         [h (send orig-bm get-height)]
-         [str (make-bytes (* w h 4) 255)])
+	 [sw (ceiling (inexact->exact (* scale w)))]
-    (send bm get-argb-pixels 0 0 w h str #f)
+         [sh (ceiling (inexact->exact (* scale h)))]
+         [str (make-bytes (* sw sh 4) 255)])
+    (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)]
+       [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)])
       (when mask
-        (send mask get-argb-pixels 0 0 w h str #t)))
+        (send mask get-argb-pixels 0 0 usw ush str #t #:unscaled? unscaled?)))
     (atomically
-     (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])
+     (let ([rgba (scheme_make_sized_byte_string (malloc (* sw sh 4) 'raw) (* sw sh 4) 0)])
-       (memcpy rgba (ptr-add str 1) (sub1 (* w h 4)))
+       (memcpy rgba (ptr-add str 1) (sub1 (* sw sh 4)))
-       (for ([i (in-range 0 (* w h 4) 4)])
+       (for ([i (in-range 0 (* sw sh 4) 4)])
          (bytes-set! rgba (+ i 3) (bytes-ref str i)))
        (gdk_pixbuf_new_from_data rgba
                                  0
                                  #t
                                  8
-                                 w
+                                 sw
-                                 h
+                                 sh
-                                 (* w 4)
+                                 (* sw 4)
                                  free-it
                                  #f)))))
 
@@ -80,3 +87,14 @@
     (cairo_fill cr)
     (cairo_destroy cr)
     bm))
+
+(define (rescale bm scale)
+  (define w (send bm get-width))
+  (define h (send bm get-height))
+  (define new-bm (make-bitmap (ceiling (inexact->exact (* scale w)))
+			      (ceiling (inexact->exact (* scale h)))))
+  (define dc (send new-bm make-dc))
+  (send dc set-scale scale scale)
+  (send dc set-smoothing 'smoothed)
+  (send dc draw-bitmap bm 0 0)
+  new-bm)

gui-lib/mred/private/wx/gtk/radio-box.rkt

@@ -55,7 +55,7 @@
                                           [(string? lbl)
                                            (gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
                                           [else
-                                           (let ([pixbuf (bitmap->pixbuf lbl)])
+                                           (let ([pixbuf (bitmap->pixbuf lbl (->screen 1.0))])
                                              (let ([radio-gtk (gtk_radio_button_new #f)]
                                                    [image-gtk (gtk_image_new_from_pixbuf pixbuf)])
                                                (release-pixbuf pixbuf)

gui-lib/mred/private/wx/gtk/resolution.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+(require "gsettings.rkt")
+
+(provide get-interface-scale-factor)
+
+
+(define (get-interface-scale-factor display-num)
+  (with-handlers ([exn:fail? (lambda (exn) #f)])
+    (define schema "org.gnome.desktop.interface")
+    (define gs (and (g_settings_schema_source_lookup
+		     (g_settings_schema_source_get_default)
+		     schema
+		     #f)
+		    (g_settings_new schema)))
+    (define v
+      (* (g_variant_get_uint32
+	  (g_settings_get_value gs "scaling-factor"))
+	 (g_variant_get_double
+	  (g_settings_get_value gs "text-scaling-factor"))))
+    (g_object_unref gs)
+    v))

gui-lib/mred/private/wx/gtk/types.rkt

@@ -14,6 +14,8 @@
               _fnpointer
               _gboolean
               _gfloat
+	      _gsize
+	      _gdouble
 
               _GdkEventButton _GdkEventButton-pointer
               (struct-out GdkEventButton)
@@ -55,6 +57,8 @@
 (define _fnpointer _pointer) ; a function pointer that can be NULL
 (define _gboolean _bool)
 (define _gfloat _float)
+(define _gsize _long)
+(define _gdouble _double)
 (define _GdkEventType _int)
 
 (define _GdkAtom _intptr)

gui-lib/mred/private/wx/gtk/utils.rkt

@@ -6,7 +6,8 @@
          racket/draw/unsafe/glib
          (only-in '#%foreign ctype-c->scheme)
          "../common/utils.rkt"
-         "types.rkt")
+         "types.rkt"
+	 "resolution.rkt")
 
 (provide 
  define-mz
@@ -48,7 +49,10 @@
               gdk_screen_get_default
 
               ;; for declaring derived structures:
-              _GtkObject)
+              _GtkObject
+
+	      ;; window size adjustments for screen scale:
+	      ->screen ->screen* ->normal)
  mnemonic-string)
 
 (define gdk-lib 
@@ -196,3 +200,29 @@
        "__")
       "_\\1"))
    "&"))
+
+;; ----------------------------------------
+
+(define screen-scale-factor
+  (inexact->exact (get-interface-scale-factor 0)))
+
+(define (->screen x)
+  (and x
+       (if (= screen-scale-factor 1)
+	   x
+	   (if (exact? x)
+	       (ceiling (* x screen-scale-factor))
+	       (* x screen-scale-factor)))))
+(define (->screen* x)
+  (if (and (not (= screen-scale-factor 1))
+	   (exact? x))
+      (floor (* x screen-scale-factor))
+      (->screen x)))
+
+(define (->normal x)
+  (and x
+       (if (= screen-scale-factor 1)
+	   x
+	   (if (exact? x)
+	       (floor (/ x screen-scale-factor))
+	       (/ x screen-scale-factor)))))

gui-lib/mred/private/wx/gtk/window.rkt

@@ -175,10 +175,10 @@
     (let ([wx (gtk->wx gtk)])
       (when wx
         (send wx save-size 
-              (GtkAllocation-x a)
+              (->normal (GtkAllocation-x a))
-              (GtkAllocation-y a)
+              (->normal (GtkAllocation-y a))
-              (GtkAllocation-width a)
+              (->normal (GtkAllocation-width a))
-              (GtkAllocation-height a))))
+              (->normal (GtkAllocation-height a)))))
     #t))
 ;; ----------------------------------------
 
@@ -368,13 +368,15 @@
                   [m (let-values ([(x y)
                                    (send wx
                                          adjust-event-position
-                                         (->long ((if motion? 
+					 (->normal
-                                                      GdkEventMotion-x 
+					  (->long ((if motion? 
-                                                      (if crossing? GdkEventCrossing-x GdkEventButton-x))
+						       GdkEventMotion-x 
-                                                  event))
+						       (if crossing? GdkEventCrossing-x GdkEventButton-x))
-                                         (->long ((if motion? GdkEventMotion-y 
+						   event)))
-                                                      (if crossing? GdkEventCrossing-y GdkEventButton-y))
+					 (->normal
-                                                  event)))])
+					  (->long ((if motion? GdkEventMotion-y 
+						       (if crossing? GdkEventCrossing-y GdkEventButton-y))
+						   event))))])
                        (new mouse-event%
                             [event-type type]
                             [left-down (case type
@@ -505,8 +507,9 @@
       (send parent set-child-size gtk x y w h))
 
     (define/public (set-child-size child-gtk x y w h)
-      (gtk_widget_set_size_request child-gtk w h)
+      (gtk_widget_set_size_request child-gtk (->screen w) (->screen h))
-      (gtk_widget_size_allocate child-gtk (make-GtkAllocation x y w h)))
+      (gtk_widget_size_allocate child-gtk (make-GtkAllocation (->screen x) (->screen y)
+							      (->screen w) (->screen h))))
 
     (define/public (remember-size x y w h)
       ;; called in event-pump thread
@@ -538,20 +541,22 @@
         (when sub-h-gtk
           (gtk_widget_size_request sub-h-gtk hreq))
         (when w?
-          (set! client-delta-w (- (GtkRequisition-width req)
+          (set! client-delta-w (->normal
-                                  (max (GtkRequisition-width creq)
+				(- (GtkRequisition-width req)
-                                       (GtkRequisition-width hreq)))))
+				   (max (GtkRequisition-width creq)
+					(GtkRequisition-width hreq))))))
         (when h?
-          (set! client-delta-h (- (GtkRequisition-height req)
+          (set! client-delta-h (->normal
-                                  (GtkRequisition-height creq))))))
+				(- (GtkRequisition-height req)
+				   (GtkRequisition-height creq)))))))
 
     (define/public (set-auto-size [dw 0] [dh 0])
       (let ([req (make-GtkRequisition 0 0)])
         (gtk_widget_size_request gtk req)
         (set-size #f
                   #f
-                  (+ (GtkRequisition-width req) dw)
+                  (+ (->normal (GtkRequisition-width req)) dw)
-                  (+ (GtkRequisition-height req) dh))))
+                  (+ (->normal (GtkRequisition-height req)) dh))))
 
     (define shown? #f)
     (define/public (direct-show on?)
@@ -765,8 +770,8 @@
       (client-to-screen xb yb)
       (gdk_display_warp_pointer (gtk_widget_get_display gtk)
                                 (gtk_widget_get_screen gtk)
-                                (unbox xb)
+                                (->screen (unbox xb))
-                                (unbox yb)))
+                                (->screen (unbox yb))))
 
     (define/public (gets-focus?) #t)))