add get-scaled-client-size

gui-doc/scribblings/gui/canvas-intf.scrbl

@@ -292,5 +292,13 @@ See @racket[canvas<%>] for information on canvas flushing.
 Beware that suspending flushing for a canvas can discourage refreshes
 for other windows in the same frame on some platforms.}
 
+@defmethod[(get-scaled-client-size) (values dimension-integer? dimension-integer?)]{
+
+Returns the dimensions that the canvas supports drawing to. On Mac OS
+X, this may be different than the result returned by
+@racket[get-client-size] when the canvas is in "High Resolution" mode and the display is Retina-enabled.}
+
+@history[#:added "1.13"]
+
 }
 

gui-lib/info.rkt

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

gui-lib/mred/private/mrcanvas.rkt

@@ -30,7 +30,8 @@
     on-char on-event on-paint on-tab-in
     get-dc
     set-canvas-background get-canvas-background
-    set-resize-corner))
+    set-resize-corner
+    get-scaled-client-size))
 
 (define basic-canvas%
   (class* (make-subwindow% (make-window% #f (make-subarea% area%))) (canvas<%>)
@@ -57,6 +58,9 @@
                               h))
       (send wx make-compatible-bitmap w h))
 
+    (define/public (get-scaled-client-size)
+      (send wx get-scaled-client-size))
+
     (define/public (suspend-flush)
       (send wx begin-refresh-sequence))
     (define/public (resume-flush)

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

@@ -874,6 +874,17 @@
        (when is-combo?
          (set-box! yb (max 0 (- (unbox yb) combo-backing-dh)))))
 
+     (define/public (get-scaled-client-size)
+       (define bsr (tell #:type _NSRect (get-cocoa-content) bounds))
+       (define csr
+         (tell #:type _NSRect (get-cocoa-content)
+               convertRectToBacking:
+               #:type _NSRect bsr))
+       (define cs (NSRect-size csr))
+       (define cw (->long (NSSize-width cs)))
+       (define ch (->long (NSSize-height cs)))
+       (values cw ch))
+
      (define/override (get-cursor-width-delta)
        0)
 

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

@@ -436,6 +436,12 @@
      (define/public (make-compatible-bitmap w h)
        (send dc make-backing-bitmap w h))
 
+     (define/public (get-scaled-client-size)
+       (define wb (box #f))
+       (define hb (box #f))
+       (get-client-size wb hb)
+       (values (unbox wb) (unbox hb)))
+
      (define/override (get-client-gtk) client-gtk)
      (define/override (get-container-gtk) container-gtk)
      (define/override (handles-events? gtk) (not (ptr-equal? gtk combo-button-gtk)))

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

@@ -176,6 +176,12 @@
        (and (memq 'control-border style)
             (OpenThemeData canvas-hwnd "Edit")))
 
+     (define/public (get-scaled-client-size)
+       (define wb (box #f))
+       (define hb (box #f))
+       (get-client-size wb hb)
+       (values (unbox wb) (unbox hb)))
+
      (define/override (get-content-hwnd)
        content-hwnd)