diff --git a/gui-doc/scribblings/gui/canvas-intf.scrbl b/gui-doc/scribblings/gui/canvas-intf.scrbl index 4e537f97..cc18e9e2 100644 --- a/gui-doc/scribblings/gui/canvas-intf.scrbl +++ b/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"] + } diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 4435c67a..ea3c0b61 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.12") +(define version "1.13") diff --git a/gui-lib/mred/private/mrcanvas.rkt b/gui-lib/mred/private/mrcanvas.rkt index 29a0d202..f397c37f 100644 --- a/gui-lib/mred/private/mrcanvas.rkt +++ b/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) diff --git a/gui-lib/mred/private/wx/cocoa/canvas.rkt b/gui-lib/mred/private/wx/cocoa/canvas.rkt index c6e439ec..e4503c15 100644 --- a/gui-lib/mred/private/wx/cocoa/canvas.rkt +++ b/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) diff --git a/gui-lib/mred/private/wx/gtk/canvas.rkt b/gui-lib/mred/private/wx/gtk/canvas.rkt index afc5348d..3d4a0fa6 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/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))) diff --git a/gui-lib/mred/private/wx/win32/canvas.rkt b/gui-lib/mred/private/wx/win32/canvas.rkt index 4a9a7937..05e297a4 100644 --- a/gui-lib/mred/private/wx/win32/canvas.rkt +++ b/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)