From ed92e271e848513fc0d2e9b54a89d86947fdb465 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 23 Sep 2014 13:36:55 -0600 Subject: [PATCH] racket/draw: compensate for roundoff in Windows GUI scaling Roundoff can place a child of a container so that it's position plus width extend beyond the container's width. For some controls, that looks especially bad. Approximate precise scaling by having those control sizes round down, instead of up, while leaving other kinds of controls alone. --- pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt | 2 ++ .../gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt | 1 + pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/list-box.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/slider.rkt | 2 ++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/utils.rkt | 6 ++++++ pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/window.rkt | 9 ++++++++- 8 files changed, 25 insertions(+), 1 deletion(-) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt index dc753eeeb3..04d568388c 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/button.rkt @@ -133,6 +133,8 @@ (auto-size font label 60 20 12 0 #:scale-w 1.1 #:scale-h 1.1)])) (auto-size-button font label) + (define/override (size->screen v) (->screen* v)) + ;; XP doesn't show both bitmap and string labels, ;; so we synthesize a bitmap label when we have both (define xp-label-bitmap (and xp? orientation (car label))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt index 3106b45031..e4548b7db1 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/check-box.rkt @@ -26,6 +26,8 @@ (define/override (auto-size-button font label) (auto-size font label 0 0 20 0)) + (define/override (size->screen v) (->screen v)) + (define/public (set-value v) (void (SendMessageW (get-hwnd) BM_SETCHECK (if v 1 0) 0))) diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt index f3373a5b02..568d3eeaba 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/choice.rkt @@ -62,6 +62,7 @@ (lambda (w h) (set-size #f #f w (* h 8)))) + (define/override (size->screen v) (->screen* v)) (define/override (ctlproc w msg wParam lParam default) (cond diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt index 09c8e95d18..86479fc09c 100644 --- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt +++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/gauge.rkt @@ -55,6 +55,8 @@ (set-size #f #f 100 24) (set-size #f #f 24 100)) + (define/override (size->screen v) (->screen* v)) + (define/public (get-value) (SendMessageW hwnd PBM_GETPOS 0 0)) (define/public (set-value v) 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 635e842ce2..797c41b54b 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 @@ -268,6 +268,8 @@ (set-control-font font) (set-size #f #f 40 60) + (define/override (size->screen v) (->screen* v)) + (define callback cb) (define/override (is-command? cmd) 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 ef20805c1d..946c14d465 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 @@ -144,6 +144,8 @@ (MoveWindow value-hwnd (->screen (quotient (- w value-w) 2)) (->screen (+ dy THICKNESS)) (->screen value-w) (->screen value-h) #t)))))) + (define/override (size->screen v) (->screen* v)) + (define/override (control-scrolled) (when value-hwnd (set-text (get-value))) 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 ac7efc08a9..0b176eaf5d 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 @@ -49,6 +49,7 @@ GetDeviceCaps strip-& ->screen + ->screen* ->normal)) (define gdi32-lib (ffi-lib "gdi32.dll")) @@ -188,6 +189,11 @@ (if (exact? x) (ceiling (/ (* x screen-dpi) 96)) (/ (* x screen-dpi) 96))))) +(define (->screen* x) + (if (and (not (= screen-dpi 96)) + (exact? x)) + (floor (/ (* x screen-dpi) 96)) + (->screen x))) ;; Convert a screen measure to a normalize (conceptually 96-dpi) measure (define (->normal x) 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 57f1ce18fe..0982520b60 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 @@ -323,6 +323,13 @@ (define/public (notify-child-extent x y) (void)) + ;; Converting from normalized to screen coordinates + ;; with just `->screen` can cause a child's right edge + ;; to extend beyond the parent's right edge, due to + ;; rounding via `ceiling`. Allow controls that would + ;; look bad to round down, instead. + (define/public (size->screen v) (->screen v)) + (define/public (set-size x y w h) (let-values ([(x y w h) (if (or (not x) @@ -336,7 +343,7 @@ (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 (->screen x) (->screen y) (->screen w) (->screen h) #t)) + (MoveWindow hwnd (->screen x) (->screen y) (size->screen w) (size->screen h) #t)) (unless (and (= w -1) (= h -1)) (on-resized)) (queue-on-size)