From fac247d340455328ab7e18db10546939bb067f4a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 30 Oct 2013 17:12:24 -0600 Subject: [PATCH] Mac OS X: support Retina mode Seems to work for Mac OS X 10.9 (Mavericks), at least. In Retina mode, a drawing unit corresponds to two pixels on the screen or in a bitmap created by `make-screen-bitmap'. In particular, a bitmap created by `make-screen-bitmap' is actually twice as big in each dimension as requested, and the bitmap is scaled when transferring to other drawing contexts. When transferring onto the screen, scalings cancel so that the result looks right. Adds `get-display-backing-scale` to `racket/gui/base`, and also `get-backing-scale` to `bitmap%`. To do: add a way to set the backing scale of a bitmap. That option will provide a way to give controls higher-resolution bitmaps as labels. --- .../scribblings/draw/bitmap-class.scrbl | 12 +++++++ .../scribblings/draw/bitmap-dc-class.scrbl | 7 +++- .../draw-doc/scribblings/draw/guide.scrbl | 7 ++-- .../racket/draw/private/bitmap-dc.rkt | 11 ++++++- .../draw-lib/racket/draw/private/bitmap.rkt | 28 +++++++++++++--- .../draw-lib/racket/draw/private/dc.rkt | 9 ++++++ .../draw-lib/racket/draw/private/local.rkt | 1 + .../draw-lib/racket/draw/unsafe/cairo.rkt | 4 +++ .../scribblings/gui/global-draw-funcs.scrbl | 19 +++++++++-- .../scribblings/gui/miscwin-funcs.scrbl | 9 ++++-- .../gui/top-level-window-intf.scrbl | 5 +-- pkgs/gui-pkgs/gui-lib/mred/HISTORY.txt | 6 +++- pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt | 1 + pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt | 1 + .../gui-lib/mred/private/wx/cocoa/canvas.rkt | 2 +- .../gui-lib/mred/private/wx/cocoa/dc.rkt | 32 ++++++++++++++++--- .../mred/private/wx/cocoa/platform.rkt | 1 + .../gui-lib/mred/private/wx/cocoa/procs.rkt | 5 +-- .../mred/private/wx/common/backing-dc.rkt | 6 ++++ .../gui-lib/mred/private/wx/gtk/frame.rkt | 8 +++++ .../gui-lib/mred/private/wx/gtk/platform.rkt | 1 + .../gui-lib/mred/private/wx/gtk/procs.rkt | 1 + .../gui-lib/mred/private/wx/platform.rkt | 1 + .../gui-lib/mred/private/wx/win32/frame.rkt | 16 ++++++++-- .../mred/private/wx/win32/platform.rkt | 1 + .../gui-lib/mred/private/wx/win32/procs.rkt | 1 + pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt | 7 ++++ racket/src/mac/osx_appl.rkt | 15 +++++++-- 28 files changed, 188 insertions(+), 29 deletions(-) diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl index 2bbd8d3fc5..1964f0e3c7 100644 --- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl +++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl @@ -76,6 +76,18 @@ the bitmap is selected into another DC, attached as a button label, etc.). } +@defmethod[(get-backing-scale) + (>/c 0.0)]{ + +Gets the number of pixels that correspond to a drawing unit for the +bitmap, either when the 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].} + + @defmethod[(get-depth) exact-nonnegative-integer?]{ diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl index cffce48b0e..7e481d6b52 100644 --- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl +++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl @@ -90,7 +90,12 @@ If @racket[pre-multiplied?] is true, @racket[just-alpha?] is false, are scaled by the corresponding alpha value (i.e., multiplied by the alpha value and then divided by 255). -} +If the bitmap has a backing scale (see @xmethod[bitmap% + get-backing-scale]) other than @racket[1.0], the the result of + @method[bitmap-dc% get-argb-pixels] is as if the bitmap is drawn to a + bitmap with a backing scale of @racket[1.0] and the pixels of the + target bitmap are returned.} + @defmethod[(get-bitmap) (or/c (is-a?/c bitmap%) #f)]{ diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl index 23d4125d62..75088f25ac 100644 --- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl +++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/guide.scrbl @@ -755,8 +755,11 @@ Different kinds of bitmaps can produce different results: make-bitmap] uses the same platform-specific drawing operations 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. + @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 diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt index 5d9e241b7f..b9395f6e98 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap-dc.rkt @@ -21,7 +21,16 @@ (define b&w? #f) (when _bm - (do-set-bitmap _bm #f)) + (do-set-bitmap _bm #f) + ;; Needed if the bitmap has a device scale: + (when c (init-cr-matrix c))) + + (define/override (init-cr-matrix cr) + (when bm + (define s (send bm get-cairo-device-scale)) + (unless (= s 1) + (cairo_scale cr s s))) + (super init-cr-matrix cr)) (define/override (ok?) (and c #t)) diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt index e893897e3c..09067a01bf 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt @@ -504,6 +504,13 @@ (let ([p (cairo_get_source cr)]) (cairo_pattern_reference p) (cairo_set_source_surface cr (get-cairo-surface) (- x) (- y)) + (let ([sc (get-cairo-device-scale)]) + (unless (= sc 1) + (let ([m (make-cairo_matrix_t 0.0 0.0 0.0 0.0 0.0 0.0)]) + (cairo_matrix_init_translate m 0 0) + (cairo_matrix_scale m sc sc) + (cairo_matrix_translate m x y) + (cairo_pattern_set_matrix (cairo_get_source cr) m)))) (cairo_new_path cr) (cairo_rectangle cr 0 0 w h) (cairo_fill cr) @@ -633,6 +640,10 @@ alpha-s)) (get-empty-surface))) + (define/public (get-cairo-device-scale) 1.0) + + (define/public (get-backing-scale) (get-cairo-device-scale)) + (define/public (get-handle) s) (define/public (get-argb-pixels x y w h bstr @@ -912,15 +923,24 @@ (define quartz-bitmap% (class bitmap% - (init w h [with-alpha? #t]) + (init w h [with-alpha? #t] [resolution 1.0]) (super-make-object (make-alternate-bitmap-kind w h)) - + + (define cocoa-resolution resolution) + + (define/override (get-cairo-device-scale) + cocoa-resolution) + (define s (let ([s (cairo_quartz_surface_create (if with-alpha? CAIRO_FORMAT_ARGB32 CAIRO_FORMAT_RGB24) - w - h)]) + (inexact->exact + (ceiling + (* cocoa-resolution w))) + (inexact->exact + (ceiling + (* cocoa-resolution h))))]) ;; initialize bitmap to empty - needed? (let ([cr (cairo_create s)]) (cairo_set_operator cr (if with-alpha? diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt index bd2bd60e66..b5314e2cc4 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt @@ -1774,6 +1774,15 @@ (send src get-cairo-surface) (- a-dest-x a-src-x) (- a-dest-y a-src-y)) + (let ([sc (send src get-cairo-device-scale)]) + (unless (= sc 1) + (let ([m (make-cairo_matrix_t 0.0 0.0 0.0 0.0 0.0 0.0)]) + (cairo_matrix_init_translate m 0 0) + (cairo_matrix_scale m sc sc) + (cairo_matrix_translate m + (- (- a-dest-x a-src-x)) + (- (- a-dest-y a-src-y))) + (cairo_pattern_set_matrix (cairo_get_source cr) m)))) (adjust-pattern-filter (cairo_get_source cr)) (if mask (stamp-pattern mask a-msrc-x a-msrc-y) diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt index 0807f263d8..ab567c965d 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt @@ -10,6 +10,7 @@ ;; bitmap% get-cairo-surface get-cairo-alpha-surface + get-cairo-device-scale release-bitmap-storage get-bitmap-gl-context drop-alpha-s diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt index 9365e7d6d0..c60c990360 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt @@ -265,6 +265,10 @@ #:wrap (allocator cairo_surface_destroy)) (define-cairo cairo_ps_surface_create (_cfun _path _double* _double* -> _cairo_surface_t) #:wrap (allocator cairo_surface_destroy)) +(define-cairo cairo_surface_set_fallback_resolution (_cfun _cairo_surface_t _double* _double* -> _void)) +(define-cairo cairo_surface_get_fallback_resolution (_cfun _cairo_surface_t (x : (_ptr o _double)) (y : (_ptr o _double)) + -> _void + -> (values x y))) ;; Stream surfaces diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/global-draw-funcs.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/global-draw-funcs.scrbl index 78b894fe5c..023550a39a 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/global-draw-funcs.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/global-draw-funcs.scrbl @@ -14,13 +14,26 @@ Normally, drawing is automatically flushed to the screen. Use other actions depend on updating the display.} +@defproc[(get-display-backing-scale [#:monitor monitor exact-nonnegative-integer? 0]) + (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 +Mac OS X in Retina display mode. + +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].} + + @defproc[(get-display-count) exact-positive-integer?]{ Returns the number of monitors currently active. On Windows and Mac OS X, the result can change at any time. -See also @xmethod[top-level-window<%> display-changed]. - -} +See also @xmethod[top-level-window<%> display-changed].} @defproc[(get-display-depth) diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl index 2da9618c39..0dfec35ba2 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl @@ -275,8 +275,13 @@ environment of the result namespace.} Creates a bitmap that draws in a way that is the same as drawing to a canvas in its default configuration. -See also @secref[#:doc '(lib "scribblings/draw/draw.scrbl") "Portability"]. -} +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[get-display-backing-scale]. + +See also @secref[#:doc '(lib "scribblings/draw/draw.scrbl") "Portability"].} @defproc[(play-sound [filename path-string?] diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/top-level-window-intf.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/top-level-window-intf.scrbl index 2820d9a495..0762cfecf6 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/top-level-window-intf.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/top-level-window-intf.scrbl @@ -197,8 +197,9 @@ Returns @|void-const|. Called when the displays configuration changes. To determine the new monitor configuration, use - @racket[get-display-count], @racket[get-display-size], and - @racket[get-display-left-top-inset]. + @racket[get-display-count], @racket[get-display-size], + @racket[get-display-left-top-inset], and + @racket[get-display-backing-scale]. Note that this method may be invoked multiple times for a single logical change to the monitors. diff --git a/pkgs/gui-pkgs/gui-lib/mred/HISTORY.txt b/pkgs/gui-pkgs/gui-lib/mred/HISTORY.txt index aab906c1f6..e4c42e8005 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/HISTORY.txt +++ b/pkgs/gui-pkgs/gui-lib/mred/HISTORY.txt @@ -1,6 +1,10 @@ +Version 5.90.0.9 +Added get-display-backing-scale +Added get-backing-scale to bitmap% + Version 5.90.0.5 -Fix key-event% get-key-release-code to return 'press instead of 'down +Fixed key-event% get-key-release-code to return 'press instead of 'down for a key-down event ---------------------------------------- diff --git a/pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt b/pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt index 2f0b39892f..d071cafa9f 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/mred-sig.rkt @@ -82,6 +82,7 @@ get-color-from-user get-current-mouse-state get-default-shortcut-prefix get-directory +get-display-backing-scale get-display-count get-display-depth get-display-left-top-inset diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt index 669ba84d5a..54f5e53c95 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/mred.rkt @@ -251,6 +251,7 @@ get-display-size get-display-left-top-inset get-display-count + get-display-backing-scale get-color-from-user get-font-from-user append-editor-operation-menu-items diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt index 6613d6cbb0..69be809546 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/canvas.rkt @@ -413,7 +413,7 @@ (define/public (get-dc) dc) (define/public (make-compatible-bitmap w h) - (make-object quartz-bitmap% w h)) + (make-screen-bitmap w h)) (define/override (fix-dc [refresh? #t]) (when (dc . is-a? . dc%) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt index 94c463235d..ec8b8effad 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/dc.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require racket/class +(require "../../syntax.rkt" + racket/class ffi/unsafe ffi/unsafe/objc racket/draw/unsafe/cairo @@ -16,9 +17,11 @@ (provide (protect-out dc% - do-backing-flush)) + do-backing-flush) + display-bitmap-resolution + make-screen-bitmap) -(import-class NSOpenGLContext) +(import-class NSOpenGLContext NSScreen) (define NSOpenGLCPSwapInterval 222) (define dc% @@ -59,7 +62,8 @@ ;; Use a quartz bitmap so that text looks good: (define trans? transparent?) (define/override (make-backing-bitmap w h) - (make-object quartz-bitmap% w h trans?)) + (make-object quartz-bitmap% w h trans? + (display-bitmap-resolution 0 void))) (define/override (can-combine-text? sz) #t) (define/override (get-backing-size xb yb) @@ -104,3 +108,23 @@ (backing-draw-bm bm cr (unbox w) (unbox h)) (cairo_destroy cr)))))) (tellv ctx restoreGraphicsState))) + +(define (display-bitmap-resolution num fail) + (let ([r (atomically + (with-autorelease + (let ([s (if (zero? num) + (tell NSScreen mainScreen) + (let ([screens (tell NSScreen screens)]) + (if (num . < . (tell #:type _NSUInteger screens count)) + (tell screens objectAtIndex: #:type _NSUInteger num) + #f)))]) + (and s + (tell #:type _CGFloat s backingScaleFactor)))))]) + (cond + [(not r) (fail)] + [(zero? r) 1.0] + [else r]))) + +(define/top (make-screen-bitmap [exact-positive-integer? w] + [exact-positive-integer? h]) + (make-object quartz-bitmap% w h #t (display-bitmap-resolution 0 void))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/platform.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/platform.rkt index 1567a0c7d4..99d3b54d89 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/platform.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/platform.rkt @@ -62,6 +62,7 @@ display-size display-origin display-count + display-bitmap-resolution flush-display get-current-mouse-state fill-private-color diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/procs.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/procs.rkt index 3064355586..d5edd7491f 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/procs.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/cocoa/procs.rkt @@ -53,6 +53,7 @@ get-highlight-background-color get-highlight-text-color check-for-break) + display-bitmap-resolution make-screen-bitmap make-gl-bitmap show-print-setup @@ -157,10 +158,6 @@ (define (id-to-menu-item id) id) (define (can-show-print-setup?) #t) -(define/top (make-screen-bitmap [exact-positive-integer? w] - [exact-positive-integer? h]) - (make-object quartz-bitmap% w h)) - (define/top (make-gl-bitmap [exact-positive-integer? w] [exact-positive-integer? h] [gl-config% c]) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/backing-dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/backing-dc.rkt index 655da62df5..45c7936298 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/backing-dc.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/common/backing-dc.rkt @@ -214,6 +214,12 @@ (cairo_translate cr dx dy)) (cairo_pattern_reference s) (cairo_set_source_surface cr (send bm get-cairo-surface) 0 0) + (let ([sc (send bm get-cairo-device-scale)]) + (unless (= sc 1) + (let ([m (make-cairo_matrix_t 0.0 0.0 0.0 0.0 0.0 0.0)]) + (cairo_matrix_init_translate m 0 0) + (cairo_matrix_scale m sc sc) + (cairo_pattern_set_matrix (cairo_get_source cr) m)))) (cairo_new_path cr) (cairo_rectangle cr 0 0 w h) (cairo_fill cr) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/frame.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/frame.rkt index 7ee11f9656..188397f9eb 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/frame.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/frame.rkt @@ -22,6 +22,7 @@ display-origin display-size display-count + display-bitmap-resolution location->window get-current-mouse-state)) @@ -558,6 +559,13 @@ (define (display-count) (gdk_screen_get_n_monitors (gdk_screen_get_default))) +(define (display-bitmap-resolution num fail) + (if (zero? num) + 1.0 + (if (num . < . (gdk_screen_get_n_monitors (gdk_screen_get_default))) + 1.0 + (fail)))) + (define (location->window x y) (for/or ([f (in-hash-keys all-frames)]) (let ([fx (send f get-x)] diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/platform.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/platform.rkt index 1194feef74..125744392b 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/platform.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/platform.rkt @@ -63,6 +63,7 @@ display-size display-origin display-count + display-bitmap-resolution flush-display get-current-mouse-state fill-private-color diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/procs.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/procs.rkt index cacf3d1829..c9f84e17a5 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/procs.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/procs.rkt @@ -48,6 +48,7 @@ show-print-setup display-origin display-size + display-bitmap-resolution flush-display location->window make-screen-bitmap diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/platform.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/platform.rkt index 5c2e0654e1..8029396a56 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/platform.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/platform.rkt @@ -49,6 +49,7 @@ display-size display-origin display-count + display-bitmap-resolution flush-display get-current-mouse-state fill-private-color diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt index 647e13e421..de9cf186f7 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/frame.rkt @@ -22,7 +22,8 @@ (protect-out frame% display-size display-origin - display-count)) + display-count + display-bitmap-resolution)) (define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL)) (define-user32 GetActiveWindow (_wfun -> _HWND)) @@ -152,7 +153,18 @@ (set-box! yb 0)])) (define (display-count) - (length (get-all-screen-rects))) + (let ([pos 0]) + (EnumDisplayMonitors #f #f (lambda (mon dc r ptr) + (set! pos (add1 pos)) + #t) + #f) + pos)) + +(define (display-bitmap-resolution num fail) + (if (or (zero? num) + (num . < . (display-count))) + 1.0 + (fail))) (define mouse-frame #f) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/platform.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/platform.rkt index e3d775ef3f..1461b2b100 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/platform.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/platform.rkt @@ -63,6 +63,7 @@ display-size display-origin display-count + display-bitmap-resolution flush-display get-current-mouse-state fill-private-color diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/procs.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/procs.rkt index 81ef379e7a..e557c4037b 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/procs.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/procs.rkt @@ -53,6 +53,7 @@ file-creator-and-type display-origin display-size + display-bitmap-resolution make-screen-bitmap make-gl-bitmap special-control-key diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt index 4587579279..ba907c204f 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt @@ -18,6 +18,7 @@ get-display-size get-display-left-top-inset get-display-count + get-display-backing-scale (protect-out make-top-container% make-top-level-window-glue% wx-frame% @@ -59,6 +60,12 @@ (lambda () (wx:display-count))) + (define get-display-backing-scale + (lambda (#:monitor [monitor 0]) + (unless (exact-nonnegative-integer? monitor) + (raise-argument-error 'get-display-backing-scale "exact-nonnegative-integer?" monitor)) + (wx:display-bitmap-resolution monitor (lambda () #f)))) + (define-values (left-margin top-margin init-top-x init-top-y) (let-values ([(x y) (get-display-left-top-inset #f)] [(x2 y2) (get-display-left-top-inset #t)]) diff --git a/racket/src/mac/osx_appl.rkt b/racket/src/mac/osx_appl.rkt index 3976e33222..e9f83c924e 100644 --- a/racket/src/mac/osx_appl.rkt +++ b/racket/src/mac/osx_appl.rkt @@ -15,8 +15,17 @@ racket/file racket/path) + (define (try . l) + (or (ormap (lambda (f) + (and (file-exists? f) + f)) + l) + (car (reverse l)))) + (define rez-path (or (getenv "REZ") - "/Developer/Tools/Rez")) + (find-executable-path "Rez") + (try "/Applications/Xcode.app/Contents/Developer/Tools/Rez" + "/Developer/Tools/Rez"))) (define for-3m? (getenv "BUILDING_3M")) @@ -101,7 +110,9 @@ (assoc-pair "CFBundleVersion" ,(version)) (assoc-pair "CFBundleShortVersionString" - ,(version)))) + ,(version)) + (assoc-pair "NSPrincipalClass" "NSApplicationMain") + (assoc-pair "NSHighResolutionCapable" (true)))) (create-app (build-path (current-directory) (if for-3m? 'up 'same)) (string-append "GRacket" suffix)