From 20bc95fb98fe8486edb1f90b58c3e570d2226a87 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 23 Sep 2014 08:40:34 -0600 Subject: [PATCH] racket/gui: DPI-aware on Windows The `racket/draw` library is now independent of the screen resolution on Windows. Font sizes in "points" are the only place where the resolution mattered before, and now `racket/draw` assumes a traditional 96dpi on Windows and Linux (and a traditional 72dpi on Mac OS X). Setting the scale for "text and other items" in Windows now adjusts the backing scale of screen and canvas-compatible bitmaps, as well as setting a scale on canvas drawing. Window and screen positions and sizes are similarly scaled; for example, if the screen is 2048x1436 with text scaled by 200%, then `racket/gui` reports the display size as 1024x768 (and the display backing scale as 2.0). Backing scales of 1.25 and 1.5 are common for Windows. Rounding associated with those scales could cause trouble for virtual -> actual -> virtual conversions. original commit: a64a1cb17722a49558ee76b5400d54aa040d1825 --- .../scribblings/gui/global-draw-funcs.scrbl | 17 ++-- .../scribblings/gui/miscwin-funcs.scrbl | 5 +- .../scribblings/gui/win-overview.scrbl | 27 ++++++ .../mred/private/wx/common/backing-dc.rkt | 56 +++++++----- .../gui-lib/mred/private/wx/win32/canvas.rkt | 28 +++--- .../gui-lib/mred/private/wx/win32/const.rkt | 2 + .../gui-lib/mred/private/wx/win32/dc.rkt | 33 ++++--- .../gui-lib/mred/private/wx/win32/font.rkt | 15 +++- .../gui-lib/mred/private/wx/win32/frame.rkt | 85 +++++++++---------- .../gui-lib/mred/private/wx/win32/gcwin.rkt | 2 +- .../mred/private/wx/win32/group-panel.rkt | 5 +- .../gui-lib/mred/private/wx/win32/hbitmap.rkt | 8 +- .../mred/private/wx/win32/list-box.rkt | 8 +- .../gui-lib/mred/private/wx/win32/menu.rkt | 2 +- .../gui-lib/mred/private/wx/win32/panel.rkt | 2 +- .../mred/private/wx/win32/printer-dc.rkt | 14 +-- .../gui-lib/mred/private/wx/win32/procs.rkt | 2 +- .../mred/private/wx/win32/radio-box.rkt | 10 ++- .../gui-lib/mred/private/wx/win32/slider.rkt | 12 ++- .../mred/private/wx/win32/tab-panel.rkt | 6 +- .../gui-lib/mred/private/wx/win32/utils.rkt | 37 +++++++- .../gui-lib/mred/private/wx/win32/window.rkt | 52 ++++++------ pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt | 9 +- 23 files changed, 277 insertions(+), 160 deletions(-) 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 023550a3..4e458d30 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 @@ -18,15 +18,19 @@ other actions depend on updating the display.} (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. +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 +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 @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].} + @xmethod[top-level-window<%> display-changed]. + +@history[#:changed "1.2" @elem{Added backing-scale support on Windows.}]} @defproc[(get-display-count) exact-positive-integer?]{ @@ -70,7 +74,8 @@ When the optional @racket[avoid-bars?] argument is true, for @racket[monitor] If @racket[monitor] is not less than the current number of available monitors (which can change at any time), the results are @racket[#f] and @racket[#f]. See also @xmethod[top-level-window<%> display-changed]. -} + +See also @secref["display-resolution"].} @defproc[(get-display-size [full-screen? any/c #f] @@ -93,7 +98,9 @@ On Windows and Mac OS X, if the optional argument is true and @racket[monitor] i If @racket[monitor] is not less than the current number of available monitors (which can change at any time), the results are @racket[#f] and @racket[#f]. See also @xmethod[top-level-window<%> display-changed]. -} + +See also @secref["display-resolution"].} + @defproc[(is-color-display?) 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 9a4d0fe5..1d9661ba 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/miscwin-funcs.scrbl @@ -280,8 +280,9 @@ canvas in its default configuration. 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]. +@racket[width] and @racket[height]. On Windows, the backing scale +is similarly increased by adjusting the operating-system text scale. +See also @racket[get-display-backing-scale]. See also @secref[#:doc '(lib "scribblings/draw/draw.scrbl") "Portability"].} diff --git a/pkgs/gui-pkgs/gui-doc/scribblings/gui/win-overview.scrbl b/pkgs/gui-pkgs/gui-doc/scribblings/gui/win-overview.scrbl index 5c2a5e9d..a3ab1905 100644 --- a/pkgs/gui-pkgs/gui-doc/scribblings/gui/win-overview.scrbl +++ b/pkgs/gui-pkgs/gui-doc/scribblings/gui/win-overview.scrbl @@ -999,3 +999,30 @@ suspend-flush] will soon follow, because the process of flushing to the screen can be starved if flushing is frequently suspend. The method @xmethod[canvas% refresh-now] conveniently encapsulates this sequence. + +@; ---------------------------------------- + +@section[#:tag "display-resolution"]{Screen Resolution and Text Scaling} + +On Mac OS X, screen sizes are described to users in terms of drawing +units. A Retina display provides two pixels per drawing unit, while +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, +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 +GUI elements, including the screen, windows, buttons, and canvas +drawing. For example, if the scale is 200%, then the screen size +reported by @racket[get-display-size] will be half of the number of +pixels in each dimension. Beware that round-off effects can cause the +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 +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. 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 45c79362..0836b155 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 @@ -175,35 +175,51 @@ (define (release-backing-bitmap bm) (send bm release-bitmap-storage)) +(define (scale-mixin %) + (class % + (define backing-scale 1.0) + + (super-new) + + (define/override (init-cr-matrix cr) + (unless (= backing-scale 1.0) + (cairo_scale cr backing-scale backing-scale)) + (super init-cr-matrix cr)) + + (define/override (reset-config s) + (set! backing-scale s) + (super reset-config)))) + (define cairo-dc - (make-object (dc-mixin - (class default-dc-backend% - (inherit reset-cr) + (make-object (scale-mixin + (dc-mixin + (class default-dc-backend% + (inherit reset-cr) - (define cr #f) - (define w 0) - (define h 0) + (define cr #f) + (define w 0) + (define h 0) - (super-new) + (super-new) - (define/public (set-cr new-cr new-w new-h) - (set! cr new-cr) - (set! w new-w) - (set! h new-h) - (when cr - (reset-cr cr))) + (define/public (set-cr new-cr new-w new-h) + (set! cr new-cr) + (set! w new-w) + (set! h new-h) + (when cr + (reset-cr cr))) - (define/override (get-cr) cr) + (define/override (get-cr) cr) - (define/override (reset-clip cr) - (super reset-clip cr) - (cairo_rectangle cr 0 0 w h) - (cairo_clip cr)))))) + (define/override (reset-clip cr) + (super reset-clip cr) + (cairo_rectangle cr 0 0 w h) + (cairo_clip cr))))))) -(define (backing-draw-bm bm cr w h [dx 0] [dy 0]) +(define (backing-draw-bm bm cr w h [dx 0] [dy 0] [backing-scale 1.0]) (if (procedure? bm) (begin - (send cairo-dc reset-config) + (send cairo-dc reset-config backing-scale) (send cairo-dc set-cr cr w h) (unless (and (zero? dx) (zero? dy)) (send cairo-dc translate dx dy)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/canvas.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/canvas.rkt index 9a8ecec1..0a84def6 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/canvas.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/canvas.rkt @@ -105,7 +105,7 @@ "PLTTabPanel" #f (bitwise-ior WS_CHILD) - 0 0 w h + 0 0 (->screen w) (->screen h) (send parent get-content-hwnd) #f hInstance @@ -122,7 +122,7 @@ (if panel-hwnd WS_VISIBLE 0) (if hscroll? WS_HSCROLL 0) (if vscroll? WS_VSCROLL 0)) - 0 0 w h + 0 0 (->screen w) (->screen h) (or panel-hwnd (send parent get-content-hwnd)) #f hInstance @@ -136,7 +136,7 @@ CBS_DROPDOWNLIST WS_HSCROLL WS_VSCROLL WS_BORDER WS_CLIPSIBLINGS) - 0 0 w h + 0 0 (->screen w) (->screen h) panel-hwnd #f hInstance @@ -148,7 +148,7 @@ "PLTTabPanel" #f (bitwise-ior WS_CHILD WS_CLIPSIBLINGS WS_VISIBLE) - 0 0 w h + 0 0 (->screen w) (->screen h) canvas-hwnd #f hInstance @@ -282,10 +282,10 @@ (when panel-hwnd (let* ([r (and (or (= w -1) (= h -1)) (GetWindowRect hwnd))] - [w (if (= w -1) (- (RECT-right r) (RECT-left r)) w)] - [h (if (= h -1) (- (RECT-bottom r) (RECT-top r)) h)]) - (MoveWindow canvas-hwnd 0 0 (max 1 (- w COMBO-WIDTH)) h #t) - (MoveWindow combo-hwnd 0 0 (max 1 w) (- h 2) #t))) + [w (if (= w -1) (->normal (- (RECT-right r) (RECT-left r))) w)] + [h (if (= h -1) (->normal (- (RECT-bottom r) (RECT-top r))) h)]) + (MoveWindow canvas-hwnd 0 0 (->screen (max 1 (- w COMBO-WIDTH))) (->screen h) #t) + (MoveWindow combo-hwnd 0 0 (->screen (max 1 w)) (->screen (- h 2)) #t))) (when (and (is-auto-scroll?) (not (is-panel?))) (reset-auto-scroll)) @@ -618,14 +618,14 @@ (define/override (notify-child-extent x y) (let* ([content-hwnd (get-content-hwnd)] [r (GetWindowRect content-hwnd)] - [w (- (RECT-right r) (RECT-left r))] - [h (- (RECT-bottom r) (RECT-top r))]) + [w (->normal (- (RECT-right r) (RECT-left r)))] + [h (->normal (- (RECT-bottom r) (RECT-top r)))]) (when (or (> x w) (> y h)) (let ([pr (GetWindowRect (get-client-hwnd))]) (MoveWindow content-hwnd - (- (RECT-left r) (RECT-left pr)) + (- (RECT-left r) (RECT-left pr)) (- (RECT-top r) (RECT-top pr)) - (max w x) (max y h) + (->screen (max w x)) (->screen (max y h)) #t))))) (define/override (reset-dc-for-autoscroll) @@ -635,8 +635,8 @@ [w (- (RECT-right r) (RECT-left r))] [h (- (RECT-bottom r) (RECT-top r))]) (MoveWindow content-hwnd - (- (get-virtual-h-pos)) - (- (get-virtual-v-pos)) + (->screen (- (get-virtual-h-pos))) + (->screen (- (get-virtual-v-pos))) w h #t))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/const.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/const.rkt index 0ace67bf..0bbba5c8 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/const.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/const.rkt @@ -611,6 +611,8 @@ (define HORZRES 8) (define VERTRES 10) +(define LOGPIXELSX 88) +(define LOGPIXELSY 90) (define CBS_DROPDOWNLIST #x0003) (define CB_INSERTSTRING #x014A) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dc.rkt index 5ad449a3..541b0bd4 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dc.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/dc.rkt @@ -36,18 +36,20 @@ (init w h hwnd [gl-config #f]) (inherit get-cairo-surface) (parameterize ([hwnd-param hwnd]) - (super-new [w w] [h h] [backing-scale 1.0])) + (super-new [w w] [h h] [backing-scale (->screen 1.0)])) - (define/override (build-cairo-surface w h) + (define/override (build-cairo-surface w h backing-scale) (define hwnd (hwnd-param)) (if hwnd (atomically (let ([hdc (GetDC hwnd)]) (begin0 - (cairo_win32_surface_create_with_ddb hdc - CAIRO_FORMAT_RGB24 w h) + (let ([sw (inexact->exact (floor (* backing-scale w)))] + [sh (inexact->exact (floor (* backing-scale h)))]) + (cairo_win32_surface_create_with_ddb hdc + CAIRO_FORMAT_RGB24 sw sh)) (ReleaseDC hwnd hdc)))) - (super build-cairo-surface w h))) + (super build-cairo-surface w h backing-scale))) (define gl (and gl-config (let ([hdc (cairo_win32_surface_get_dc (get-cairo-surface))]) @@ -89,12 +91,11 @@ #f)]) (when v (set! gl v)) v))) - (define/override (make-backing-bitmap w h) (if (send canvas get-canvas-background) (make-object win32-bitmap% w h (send canvas get-hwnd)) - (super make-backing-bitmap w h))) + (make-object bitmap% w h #f #t (->screen 1.0)))) (define/override (get-backing-size xb yb) (send canvas get-client-size xb yb)) @@ -125,7 +126,9 @@ (let ([w (box 0)] [h (box 0)]) (send canvas get-client-size w h) - (define r (make-RECT 0 0 (unbox w) (unbox h))) + (define sw (->screen (unbox w))) + (define sh (->screen (unbox h))) + (define r (make-RECT 0 0 sw sh)) (define clip-type (if win64? (GetClipBox hdc r) @@ -135,8 +138,8 @@ (not (and (= clip-type SIMPLEREGION) (= (RECT-left r) 0) (= (RECT-top r) 0) - (= (RECT-right r) (unbox w)) - (= (RECT-bottom r) (unbox h))))) + (= (RECT-right r) sw) + (= (RECT-bottom r) sh)))) ;; Another workaround: a clipping region installed by BeginPaint() ;; seems to interfere with Cairo drawing. So, draw to a ;; fresh context and copy back and forth using Win32. @@ -149,7 +152,10 @@ [cr (cairo_create surface)] [hdc2 (cairo_win32_surface_get_dc surface)]) (BitBlt hdc2 0 0 cw ch hdc (RECT-left r) (RECT-top r) SRCCOPY) - (backing-draw-bm bm cr (unbox w) (unbox h) (- (RECT-left r)) (- (RECT-top r))) + (cairo_scale cr (->screen 1.0) (->screen 1.0)) + (backing-draw-bm bm cr (->normal sw) (->normal sh) + (->normal (- (RECT-left r))) (->normal (- (RECT-top r))) + (->screen 1.0)) (cairo_surface_flush surface) (BitBlt hdc (RECT-left r) (RECT-top r) cw ch hdc2 0 0 SRCCOPY) (cairo_surface_destroy surface) @@ -158,7 +164,10 @@ (let* ([surface (cairo_win32_surface_create hdc)] [cr (cairo_create surface)]) (cairo_surface_destroy surface) - (backing-draw-bm bm cr (unbox w) (unbox h)) + (cairo_scale cr (->screen 1.0) (->screen 1.0)) + (backing-draw-bm bm cr (->normal sw) (->normal sh) + 0 0 + (->screen 1.0)) (cairo_destroy cr))]))))) (define (request-flush-delay canvas) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/font.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/font.rkt index 2da8ac29..25c1a799 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/font.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/font.rkt @@ -21,10 +21,23 @@ (define font-cache (pango_win32_font_cache_new)) +(define (scale-font f) + (if (= 1 (->screen 1)) + f + (make-font #:size (->screen (send f get-point-size)) + #:face (send f get-face) + #:family (send f get-family) + #:style (send f get-style) + #:weight (send f get-weight) + #:underlined? (send f get-underlined) + #:smoothing (send f get-smoothing) + #:size-in-pixels? (send f get-size-in-pixels) + #:hinting (send f get-hinting)))) + (define (font->hfont f) (let* ([pfont (or (pango_font_map_load_font display-font-map display-context - (send f get-pango)) + (send (scale-font f) get-pango)) ;; font load failed, so fall back to default ;; font with the same size and style: (pango_font_map_load_font display-font-map 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 80aef820..1f511cf7 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 @@ -30,8 +30,6 @@ (define-user32 SetFocus (_wfun _HWND -> _HWND)) (define-user32 BringWindowToTop (_wfun _HWND -> (r : _BOOL) -> (unless r (failed 'BringWindowToTop)))) -(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int)) - (define-user32 DrawMenuBar (_wfun _HWND -> (r : _BOOL) -> (unless r (failed 'DrawMenuBar)))) @@ -98,10 +96,10 @@ ;; otherwise, preserve order: pos ;; monitor rectangle, which is the goal: - (list (RECT-left r) - (RECT-top r) - (RECT-right r) - (RECT-bottom r))) + (list (->normal (RECT-left r)) + (->normal (RECT-top r)) + (->normal (RECT-right r)) + (->normal (RECT-bottom r)))) rects)) #t) #f) @@ -125,14 +123,14 @@ [all? (atomically (let ([hdc (GetDC #f)]) - (set-box! xb (GetDeviceCaps hdc HORZRES)) - (set-box! yb (GetDeviceCaps hdc VERTRES)) + (set-box! xb (->normal (GetDeviceCaps hdc HORZRES))) + (set-box! yb (->normal (GetDeviceCaps hdc VERTRES))) (ReleaseDC #f hdc)))] [else (let ([r (make-RECT 0 0 0 0)]) (SystemParametersInfoW SPI_GETWORKAREA 0 r 0) - (set-box! xb (- (RECT-right r) (RECT-left r))) - (set-box! yb (- (RECT-bottom r) (RECT-top r))))])) + (set-box! xb (->normal (- (RECT-right r) (RECT-left r)))) + (set-box! yb (->normal (- (RECT-bottom r) (RECT-top r)))))])) (define (display-origin xb yb avoid-bars? num fail) (cond @@ -146,8 +144,8 @@ [avoid-bars? (let ([r (make-RECT 0 0 0 0)]) (SystemParametersInfoW SPI_GETWORKAREA 0 r 0) - (set-box! xb (RECT-left r)) - (set-box! yb (RECT-top r)))] + (set-box! xb (->normal (RECT-left r))) + (set-box! yb (->normal (RECT-top r))))] [else (set-box! xb 0) (set-box! yb 0)])) @@ -163,7 +161,7 @@ (define (display-bitmap-resolution num fail) (if (or (zero? num) (num . < . (display-count))) - 1.0 + (->screen 1.0) (fail))) (define mouse-frame #f) @@ -224,9 +222,9 @@ 0 (bitwise-ior WS_CAPTION WS_MINIMIZEBOX))) - (or x CW_USEDEFAULT) - (or y CW_USEDEFAULT) - w h + (if x (->screen x) CW_USEDEFAULT) + (if y (->screen y) CW_USEDEFAULT) + (->screen w) (->screen h) #f #f hInstance @@ -359,16 +357,16 @@ (when (or max-width max-height) (set-MINMAXINFO-ptMaxTrackSize! mmi - (make-POINT (or max-width + (make-POINT (or (->screen max-width) (POINT-x (MINMAXINFO-ptMaxTrackSize mmi))) - (or max-height + (or (->screen max-height) (POINT-y (MINMAXINFO-ptMaxTrackSize mmi)))))) (when (or min-width min-height) (set-MINMAXINFO-ptMinTrackSize! mmi - (make-POINT (or min-width + (make-POINT (or (->screen min-width) (POINT-x (MINMAXINFO-ptMinTrackSize mmi))) - (or min-height + (or (->screen min-height) (POINT-y (MINMAXINFO-ptMinTrackSize mmi))))))) 0] [(= msg WM_DISPLAYCHANGE) @@ -517,22 +515,24 @@ (set-box! wh (unbox sh)))) (get-size w h) (MoveWindow hwnd - (if (or (eq? mode 'both) - (eq? mode 'horizontal)) - (max 0 - (min (- (unbox sw) (unbox w)) - (+ (quotient (- (unbox ww) (unbox w)) 2) - (unbox wx)))) - (get-x)) - (if (or (eq? mode 'both) - (eq? mode 'vertical)) - (max 0 - (min (- (unbox sh) (unbox h)) - (+ (quotient (- (unbox wh) (unbox h)) 2) - (unbox wy)))) - (get-x)) - (unbox w) - (unbox h) + (->screen + (if (or (eq? mode 'both) + (eq? mode 'horizontal)) + (max 0 + (min (- (unbox sw) (unbox w)) + (+ (quotient (- (unbox ww) (unbox w)) 2) + (unbox wx)))) + (get-x))) + (->screen + (if (or (eq? mode 'both) + (eq? mode 'vertical)) + (max 0 + (min (- (unbox sh) (unbox h)) + (+ (quotient (- (unbox wh) (unbox h)) 2) + (unbox wy)))) + (get-x))) + (->screen (unbox w)) + (->screen (unbox h)) #t))) (define saved-child #f) @@ -593,8 +593,8 @@ (if (iconized?) (let ([wp (get-placement)]) (let ([r (WINDOWPLACEMENT-rcNormalPosition wp)]) - (set-box! w (- (RECT-right r) (RECT-left r))) - (set-box! h (- (RECT-bottom r) (RECT-top r))))) + (set-box! w (->normal (- (RECT-right r) (RECT-left r)))) + (set-box! h (->normal (- (RECT-bottom r) (RECT-top r)))))) (super get-size w h))) (define/override (get-client-size w h) @@ -608,14 +608,14 @@ (define/override (get-x) (if (iconized?) (let ([wp (get-placement)]) - (RECT-left (WINDOWPLACEMENT-rcNormalPosition wp))) - (RECT-left (GetWindowRect hwnd)))) + (->normal (RECT-left (WINDOWPLACEMENT-rcNormalPosition wp)))) + (->normal (RECT-left (GetWindowRect hwnd))))) (define/override (get-y) (if (iconized?) (let ([wp (get-placement)]) - (RECT-top (WINDOWPLACEMENT-rcNormalPosition wp))) - (RECT-top (GetWindowRect hwnd)))) + (->normal (RECT-top (WINDOWPLACEMENT-rcNormalPosition wp)))) + (->normal (RECT-top (GetWindowRect hwnd))))) (define/override (get-width) (if (iconized?) @@ -688,4 +688,3 @@ (popup-menu-with-char #\space)) (define/public (display-changed) (void))) - diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gcwin.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gcwin.rkt index 3bb5a83e..1fde4f6e 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gcwin.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gcwin.rkt @@ -33,7 +33,7 @@ (vector (vector 'osapi_ptr_ptr->void SelectObject/raw blit-hdc hbitmap) (vector 'osapi_ptr_int_int_int_int_ptr_int_int_long->void - BitBlt/raw hdc x y w h blit-hdc 0 0 SRCCOPY) + BitBlt/raw hdc (->screen x) (->screen y) (->screen w) (->screen h) blit-hdc 0 0 SRCCOPY) (vector 'ptr_ptr->void SelectObject/raw blit-hdc #f))) (define (make-gc-show-desc hdc hbitmap x y w h) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt index dd58feea..fb1fa128 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/group-panel.rkt @@ -40,7 +40,7 @@ "PLTTabPanel" #f (bitwise-ior WS_CHILD WS_VISIBLE) - 0 0 w h + 0 0 (->screen w) (->screen h) hwnd #f hInstance @@ -69,4 +69,5 @@ (define/override (set-size x y w h) (super set-size x y w h) (unless (or (= w -1) (= h -1)) - (MoveWindow client-hwnd 3 (+ label-h 3) (- w 6) (- h label-h 6) #t))))) + (MoveWindow client-hwnd (->screen 3) (->screen (+ label-h 3)) + (->screen (- w 6)) (->screen (- h label-h 6)) #t))))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt index ecb9b015..560295e8 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt @@ -25,7 +25,7 @@ ;; RGB win32 bitmaps to RGB win32 bitmaps in a ;; way that sometimes mangles the alpha; avoid the ;; problem by first copying to a Cairo memory bitmap. - (let* ([new-b (make-object bitmap% w h #f #f)] + (let* ([new-b (make-object bitmap% w h #f #f (send bm get-backing-scale))] [dc (make-object bitmap-dc% new-b)]) (send dc draw-bitmap bm 0 0) (send dc set-bitmap #f) @@ -36,14 +36,18 @@ [to-frac (lambda (v) (/ v 255.0))] [screen-hdc (GetDC #f)] [hdc (CreateCompatibleDC screen-hdc)] + [sc (->screen 1.0)] + [scaled (lambda (v) (inexact->exact (ceiling (* v sc))))] [hbitmap (if b&w? (CreateBitmap w h 1 1 #f) - (CreateCompatibleBitmap screen-hdc w h))] + (CreateCompatibleBitmap screen-hdc (scaled w) (scaled h)))] [old-hbitmap (SelectObject hdc hbitmap)]) (ReleaseDC #f screen-hdc) (let* ([s (cairo_win32_surface_create hdc)] [cr (cairo_create s)]) (cairo_surface_destroy s) + (unless (= sc 1) + (cairo_scale cr sc sc)) (cairo_set_source_rgba cr (to-frac (GetRValue bg)) (to-frac (GetGValue bg)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt index a227b47c..635e842c 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt @@ -371,8 +371,8 @@ (set! max-col-width mx)) (atomically (let ([col-desc (make-lvcolumn (bitwise-ior LVCF_WIDTH LVCF_MINWIDTH) #f)]) - (set-LVCOLUMN-cx! col-desc w) - (set-LVCOLUMN-cxMin! col-desc mn) + (set-LVCOLUMN-cx! col-desc (->screen w)) + (set-LVCOLUMN-cxMin! col-desc (->screen mn)) (SendMessageW/ptr hwnd LVM_SETCOLUMNW col col-desc) (set! min-col-width mn) (set! max-col-width mx))))) @@ -381,7 +381,7 @@ (atomically (let ([col-desc (make-lvcolumn (bitwise-ior LVCF_WIDTH LVCF_MINWIDTH) #f)]) (SendMessageW/ptr hwnd LVM_GETCOLUMNW col col-desc) - (let ([v (LVCOLUMN-cx col-desc)]) + (let ([v (->normal (LVCOLUMN-cx col-desc))]) (values (max v min-col-width) ; in XP, may have been sized too small min-col-width max-col-width))))) @@ -417,7 +417,7 @@ (define/public (number-of-visible-items) (if single-column? - (let ([ih (SendMessageW hwnd LB_GETITEMHEIGHT 0 0)]) + (let ([ih (->normal (SendMessageW hwnd LB_GETITEMHEIGHT 0 0))]) (let ([w (box 0)] [h (box 0)]) (get-client-size w h) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/menu.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/menu.rkt index 66205b4c..20923036 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/menu.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/menu.rkt @@ -67,7 +67,7 @@ TPM_RIGHTBUTTON TPM_NONOTIFY TPM_RETURNCMD) - gx gy + (->screen gx) (->screen gy) 0 hwnd #f)]) (let* ([e (new popup-event% [event-type 'menu-popdown])]) (unless (zero? cmd) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/panel.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/panel.rkt index 6d10c5cc..6f5385a8 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/panel.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/panel.rkt @@ -112,7 +112,7 @@ (if (memq 'border style) WS_BORDER 0)) - 0 0 w h + 0 0 (->screen w) (->screen h) (send parent get-content-hwnd) #f hInstance diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/printer-dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/printer-dc.rkt index 7d44c06b..486b26ee 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/printer-dc.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/printer-dc.rkt @@ -78,10 +78,6 @@ (define-gdi32 EndPage (_wfun _HDC -> (r : _int) -> (unless (positive? r) (failed 'EndPage)))) (define-gdi32 EndDoc (_wfun _HDC -> (r : _int) -> (unless (positive? r) (failed 'EndDoc)))) -(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int)) - -(define LOGPIXELSX 88) -(define LOGPIXELSY 90) (define PHYSICALOFFSETX 112) (define PHYSICALOFFSETY 113) @@ -124,13 +120,9 @@ ;; the hDevModes and hDevNames fields r))))) -;; Pango uses the resolution of the screen to make point<->pixel -;; decisions for all devices (by default). So, we make on drawing unit in -;; a printing context match the relative drawing unit for the screen. -(define SCREEN-DPI (let ([hdc (GetDC #f)]) - (begin0 - (exact->inexact (GetDeviceCaps hdc LOGPIXELSX)) - (ReleaseDC #f hdc)))) +;; Make on drawing unit in a printing context match the relative drawing +;; unit for the screen, where the conceptual drawing unit is always 96dpi +(define SCREEN-DPI 96) (define printer-dc% (class (record-dc-mixin (dc-mixin bitmap-dc-backend%)) 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 e557c403..8851fb8d 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 @@ -84,7 +84,7 @@ (define (get-double-click-time) 500) (define (get-control-font-face) (get-theme-font-face)) -(define (get-control-font-size) (get-theme-font-size)) +(define (get-control-font-size) (->normal (get-theme-font-size))) (define (get-control-font-size-in-pixels?) #t) (define-user32 MessageBeep (_wfun _UINT -> _BOOL)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/radio-box.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/radio-box.rkt index de972696..4d6ae04a 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/radio-box.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/radio-box.rkt @@ -53,7 +53,7 @@ (let loop ([y 0] [w 0] [labels labels]) (if (null? labels) (begin - (MoveWindow hwnd 0 0 w y #t) + (MoveWindow hwnd 0 0 (->screen w) (->screen y) #t) null) (let* ([label (car labels)] [bitmap? (label . is-a? . bitmap%)] @@ -83,8 +83,12 @@ (auto-size font label 0 0 20 4 (lambda (w1 h1) (if horiz? - (MoveWindow radio-hwnd (+ w SEP) 0 w1 h1 #t) - (MoveWindow radio-hwnd 0 (+ y SEP) w1 h1 #t)) + (MoveWindow radio-hwnd (->screen (+ w SEP)) 0 + (->screen w1) (->screen h1) + #t) + (MoveWindow radio-hwnd 0 (->screen (+ y SEP)) + (->screen w1) (->screen h1) + #t)) (values w1 h1)))]) (cons radio-hwnd (loop (if horiz? (max y h) (+ y SEP h)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt index 4321610a..ef20805c 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt @@ -134,11 +134,15 @@ (unless (or (= w -1) (= h -1)) (if vertical? (let ([dx (quotient (- w THICKNESS value-w) 2)]) - (MoveWindow slider-hwnd dx 0 THICKNESS h #T) - (MoveWindow value-hwnd (+ dx THICKNESS) (quotient (- h value-h) 2) value-w value-h #t)) + (MoveWindow slider-hwnd (->screen dx) 0 + (->screen THICKNESS) (->screen h) #t) + (MoveWindow value-hwnd (->screen (+ dx THICKNESS)) (->screen (quotient (- h value-h) 2)) + (->screen value-w) (->screen value-h) #t)) (let ([dy (quotient (- h THICKNESS value-h) 2)]) - (MoveWindow slider-hwnd 0 dy w THICKNESS #t) - (MoveWindow value-hwnd (quotient (- w value-w) 2) (+ dy THICKNESS) value-w value-h #t)))))) + (MoveWindow slider-hwnd 0 (->screen dy) + (->screen w) (->screen THICKNESS) #t) + (MoveWindow value-hwnd (->screen (quotient (- w value-w) 2)) (->screen (+ dy THICKNESS)) + (->screen value-w) (->screen value-h) #t)))))) (define/override (control-scrolled) (when value-hwnd diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt index df9e2514..6c345822 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/tab-panel.rkt @@ -65,7 +65,7 @@ "PLTTabPanel" #f (bitwise-ior WS_CHILD WS_VISIBLE) - 0 0 w h + 0 0 (->screen w) (->screen h) hwnd #f hInstance @@ -111,7 +111,9 @@ (define/override (set-size x y w h) (super set-size x y w h) (unless (or (= w -1) (= h -1)) - (MoveWindow client-hwnd 1 (+ tab-height 2) (- w 4) (- h tab-height 6) #t))) + (MoveWindow client-hwnd (->screen 1) (->screen (+ tab-height 2)) + (->screen (- w 4)) (->screen (- h tab-height 6)) + #t))) (define/override (is-command? cmd) (= cmd -551)) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt index 4b4b6060..5443f79d 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt @@ -3,7 +3,9 @@ ffi/unsafe/define ffi/unsafe/alloc "../common/utils.rkt" - "types.rkt") + "../../lock.rkt" + "types.rkt" + "const.rkt") (provide define-mz @@ -43,7 +45,10 @@ ModifyMenuW RemoveMenu SelectObject - WideCharToMultiByte)) + WideCharToMultiByte + GetDeviceCaps + ->screen + ->normal)) (define gdi32-lib (ffi-lib "gdi32.dll")) (define user32-lib (ffi-lib "user32.dll")) @@ -156,3 +161,31 @@ (define-kernel32 WideCharToMultiByte (_wfun _UINT _DWORD _pointer _int _pointer _int _pointer _pointer -> _int)) +;; ---------------------------------------- + +(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int)) + +(define screen-dpi + (atomically + (let ([hdc (GetDC #f)]) + (begin0 + (GetDeviceCaps hdc LOGPIXELSX) + (ReleaseDC #f hdc))))) + +;; Convert a normalized (conceptually 96-dpi) measure into a screen measure +(define (->screen x) + (and x + (if (= screen-dpi 96) + x + (if (exact? x) + (ceiling (/ (* x screen-dpi) 96)) + (/ (* x screen-dpi) 96))))) + +;; Convert a screen measure to a normalize (conceptually 96-dpi) measure +(define (->normal x) + (and x + (if (= screen-dpi 96) + x + (if (exact? x) + (floor (/ (* x 96) screen-dpi)) + (/ (* x 96) screen-dpi))))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt index 5326afe5..57f1ce18 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt @@ -307,18 +307,18 @@ (define/public (get-x) (let ([r (GetWindowRect hwnd)] [pr (GetWindowRect (send parent get-content-hwnd))]) - (- (RECT-left r) (RECT-left pr)))) + (->normal (- (RECT-left r) (RECT-left pr))))) (define/public (get-y) (let ([r (GetWindowRect hwnd)] [pr (GetWindowRect (send parent get-content-hwnd))]) - (- (RECT-top r) (RECT-top pr)))) + (->normal (- (RECT-top r) (RECT-top pr))))) (define/public (get-width) (let ([r (GetWindowRect hwnd)]) - (- (RECT-right r) (RECT-left r)))) + (->normal (- (RECT-right r) (RECT-left r))))) (define/public (get-height) (let ([r (GetWindowRect hwnd)]) - (- (RECT-bottom r) (RECT-top r)))) + (->normal (- (RECT-bottom r) (RECT-top r))))) (define/public (notify-child-extent x y) (void)) @@ -330,13 +330,13 @@ (= w -1) (= h -1)) (let ([r (GetWindowRect hwnd)]) - (values (or x (RECT-left r)) - (or y (RECT-top r)) - (if (= w -1) (- (RECT-right r) (RECT-left r)) w) - (if (= h -1) (- (RECT-bottom r) (RECT-top r)) h))) + (values (or x (->normal (RECT-left r))) + (or y (->normal (RECT-top r))) + (if (= w -1) (->normal (- (RECT-right r) (RECT-left r))) w) + (if (= h -1) (->normal (- (RECT-bottom r) (RECT-top r))) h))) (values x y w h))]) (when parent (send parent notify-child-extent (+ x w) (+ y h))) - (MoveWindow hwnd x y w h #t)) + (MoveWindow hwnd (->screen x) (->screen y) (->screen w) (->screen h) #t)) (unless (and (= w -1) (= h -1)) (on-resized)) (queue-on-size) @@ -433,23 +433,23 @@ (define/public (screen-to-client x y) (internal-screen-to-client x y)) (define/public (internal-screen-to-client x y) - (let ([p (make-POINT (unbox x) (unbox y))]) + (let ([p (make-POINT (->screen (unbox x)) (->screen (unbox y)))]) (ScreenToClient (get-client-hwnd) p) - (set-box! x (POINT-x p)) - (set-box! y (POINT-y p)))) + (set-box! x (->normal (POINT-x p))) + (set-box! y (->normal (POINT-y p))))) (define/public (client-to-screen x y) (internal-client-to-screen x y)) (define/public (internal-client-to-screen x y) - (let ([p (make-POINT (unbox x) (unbox y))]) + (let ([p (make-POINT (->screen (unbox x)) (->screen (unbox y)))]) (ClientToScreen (get-client-hwnd) p) - (set-box! x (POINT-x p)) - (set-box! y (POINT-y p)))) + (set-box! x (->normal (POINT-x p))) + (set-box! y (->normal (POINT-y p))))) (define/public (warp-pointer x y) (define xb (box x)) (define yb (box y)) (client-to-screen xb yb) - (void (SetCursorPos (unbox xb) (unbox yb)))) + (void (SetCursorPos (->screen (unbox xb)) (->screen (unbox yb))))) (define/public (in-content? p) (ScreenToClient (get-client-hwnd) p) @@ -477,13 +477,13 @@ (define/public (get-client-size w h) (let ([r (GetClientRect (get-client-hwnd))]) - (set-box! w (- (RECT-right r) (RECT-left r))) - (set-box! h (- (RECT-bottom r) (RECT-top r))))) + (set-box! w (->normal (- (RECT-right r) (RECT-left r)))) + (set-box! h (->normal (- (RECT-bottom r) (RECT-top r)))))) (define/public (get-size w h) (let ([r (GetWindowRect (get-client-hwnd))]) - (set-box! w (- (RECT-right r) (RECT-left r))) - (set-box! h (- (RECT-bottom r) (RECT-top r))))) + (set-box! w (->normal (- (RECT-right r) (RECT-left r)))) + (set-box! h (->normal (- (RECT-bottom r) (RECT-top r)))))) (define cursor-handle #f) (define/public (set-cursor c) @@ -586,7 +586,7 @@ [(= msg WM_MOUSELEAVE) (let ([p (make-POINT 0 0)]) (let ([f (and (GetCursorPos p) - (location->window (POINT-x p) (POINT-y p)))]) + (location->window* (POINT-x p) (POINT-y p)))]) (unless (and (eq? f (get-top-frame)) (send f in-content? p)) (do-mouse w msg #f 'leave wParam lParam)))) @@ -636,7 +636,7 @@ [bit? (lambda (v b) (not (zero? (bitwise-and v b))))]) (let ([make-e (lambda (type) - (define-values (mx my) (adjust-event-position x y)) + (define-values (mx my) (adjust-event-position (->normal x) (->normal y))) (new mouse-event% [event-type type] [left-down (case type @@ -836,7 +836,7 @@ (unless default-control-font (set! default-control-font (make-object font% - (get-theme-font-size) + (->normal (get-theme-font-size)) (logfont->pango-family (get-theme-logfont)) 'system @@ -850,7 +850,8 @@ (define (queue-window-refresh-event win thunk) (queue-refresh-event (send win get-eventspace) thunk)) -(define (location->window x y) +;; arguments in screen coordinates +(define (location->window* x y) (let ([hwnd (WindowFromPoint (make-POINT x y))]) (let loop ([hwnd hwnd]) (and hwnd @@ -858,6 +859,9 @@ (and wx (send wx get-top-frame))) (loop (GetParent hwnd))))))) +(define (location->window x y) + (location->window* (->screen x) (->screen y))) + (define (flush-display) (atomically (pre-event-sync #t))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt index ba907c20..c0a9b829 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wxtop.rkt @@ -104,8 +104,7 @@ (define already-trying? #f) (define was-bad? #f) ; hack around min-frame-size limitations - (define last-width -1) - (define last-height -1) + (define tried-sizes #hash()) ;; pointer to panel in the frame for use in on-size (define panel #f) @@ -352,19 +351,19 @@ [(and (= new-width correct-w) (= new-height correct-h)) ;; Good size; do panel (set! was-bad? #f) + (set! tried-sizes #hash()) (enforce-size min-w min-h (if sx? -1 min-w) (if sy? -1 min-h) 1 1) (set-panel-size)] - [(and (= last-width correct-w) (= last-height correct-h) + [(and (hash-ref tried-sizes (cons correct-w correct-h) #f) was-bad?) ;; We give up; do panel (set-panel-size)] [else ;; Too large/small; try to fix it, but give up after a while (set! was-bad? #t) - (set! last-width correct-w) - (set! last-height correct-h) + (set! tried-sizes (hash-set tried-sizes (cons correct-w correct-h) #t)) (set! already-trying? #t) (enforce-size -1 -1 -1 -1 1 1) (set-size #f #f correct-w correct-h)