diff --git a/gui-doc/scribblings/gui/canvas-class.scrbl b/gui-doc/scribblings/gui/canvas-class.scrbl index badaa604..c761e347 100644 --- a/gui-doc/scribblings/gui/canvas-class.scrbl +++ b/gui-doc/scribblings/gui/canvas-class.scrbl @@ -100,6 +100,20 @@ The @racket[gl-config] argument determines properties of an OpenGL } +@defmethod[(get-gl-client-size) (values dimension-integer? dimension-integer?)]{ + +Returns the canvas's drawing-area dimensions in OpenGL units for a +@racket[canvas%] instance with the @racket['gl] style. + +The result is the same as @method[canvas<%> get-unscaled-client-size] +in a canvas without the @racket['gl] style or on Windows and Unix. On +Mac OS X, the result can be the same as @method[window<%> +get-client-size] if the @racket[gl-config%] specification provided on +creation does not specify high-resolution mode. + +@history[#:added "1.16]} + + @defmethod[(get-scroll-page [which (or/c 'horizontal 'vertical)]) positive-dimension-integer?]{ diff --git a/gui-doc/scribblings/gui/canvas-intf.scrbl b/gui-doc/scribblings/gui/canvas-intf.scrbl index 117bd97a..3af58dd0 100644 --- a/gui-doc/scribblings/gui/canvas-intf.scrbl +++ b/gui-doc/scribblings/gui/canvas-intf.scrbl @@ -158,7 +158,8 @@ a viewport size for OpenGL drawing in @racket[canvas%] instance with the @racket['gl] style. On Mac OS X, however, the viewport will match the scaled size unless the canvas is created with a @racket[gl-config%] specification that is adjusted to high-resolution -mode via @method[gl-config% set-hires-mode]. +mode via @method[gl-config% set-hires-mode]. See also +@xmethod[canvas% get-gl-client-size]. @history[#:added "1.13"]} diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index e64074a2..db8dd6e8 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.15") +(define version "1.16") diff --git a/gui-lib/mred/private/mrcanvas.rkt b/gui-lib/mred/private/mrcanvas.rkt index f397c37f..03f88faf 100644 --- a/gui-lib/mred/private/mrcanvas.rkt +++ b/gui-lib/mred/private/mrcanvas.rkt @@ -134,6 +134,8 @@ (if ctx (send ctx call-as-current thunk) (fail)))) + (define/public (get-gl-client-size) + (send wx get-gl-client-size)) (define accept-tab-focus (entry-point (case-lambda diff --git a/gui-lib/mred/private/wx/cocoa/canvas.rkt b/gui-lib/mred/private/wx/cocoa/canvas.rkt index e4503c15..41b3c4f6 100644 --- a/gui-lib/mred/private/wx/cocoa/canvas.rkt +++ b/gui-lib/mred/private/wx/cocoa/canvas.rkt @@ -884,6 +884,15 @@ (define cw (->long (NSSize-width cs))) (define ch (->long (NSSize-height cs))) (values cw ch)) + + (define/public (get-gl-client-size) + (if (or (not is-gl?) + (tell #:type _BOOL content-cocoa wantsBestResolutionOpenGLSurface)) + (get-scaled-client-size) + (let ([x (box 0)] + [y (box 0)]) + (get-client-size x y) + (values (unbox x) (unbox y))))) (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 c9e4ae70..38e1f41b 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/gui-lib/mred/private/wx/gtk/canvas.rkt @@ -504,7 +504,13 @@ (define wb (box #f)) (define hb (box #f)) (get-client-size wb hb) - (values (->screen (unbox wb)) (->screen (unbox hb)))) + (define s (if gtk3? + (gtk_widget_get_scale_factor gtk) + 1)) + (values (* s (->screen (unbox wb))) (* s (->screen (unbox hb))))) + + (define/public (get-gl-client-size) + (get-scaled-client-size)) (define/override (get-client-gtk) client-gtk) (define/override (get-container-gtk) container-gtk) diff --git a/gui-lib/mred/private/wx/win32/window.rkt b/gui-lib/mred/private/wx/win32/window.rkt index 29f18cc0..38b0dfc4 100644 --- a/gui-lib/mred/private/wx/win32/window.rkt +++ b/gui-lib/mred/private/wx/win32/window.rkt @@ -491,6 +491,9 @@ (let ([r (GetClientRect (get-client-hwnd))]) (values (- (RECT-right r) (RECT-left r)) (- (RECT-bottom r) (RECT-top r))))) + + (define/public (get-gl-client-size) + (get-scaled-client-size)) (define/public (get-size w h) (let ([r (GetWindowRect (get-client-hwnd))])