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 7484c58a64..f010381611 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 @@ -14,7 +14,8 @@ (define bitmap-dc-backend% (class default-dc-backend% (init [(_bm bitmap) #f]) - (inherit reset-cr) + (inherit reset-cr + set-effective-backing-scale) (define c #f) (define bm #f) @@ -24,7 +25,7 @@ (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)) @@ -40,6 +41,8 @@ (set! c #f)) (set! bm v) (when (and bm (send bm ok?)) + (when reset? + (set-effective-backing-scale (send bm get-cairo-device-scale))) (set! c (cairo_create (send bm get-cairo-target-surface))) (set! b&w? (not (send bm is-color?))))) @@ -97,6 +100,11 @@ CAIRO_OPERATOR_CLEAR CAIRO_OPERATOR_OVER)) + (define/override (get-init-effective-backing-scale) + (if bm + (send bm get-cairo-device-scale) + 1.0)) + (super-new))) (define black (send the-color-database find-color "black")) 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 edb836ab71..83017fbd13 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt @@ -81,6 +81,16 @@ ;; Initializes/resets the transformation matrix init-cr-matrix + ;; method set-effective-backing-scale : real -> void + ;; + ;; Sets the backing scale for use in alignment, etc. + set-effective-backing-scale + + ;; init-effective-backing-scale : -> real + ;; + ;; Sets the initial effective backing scale + get-init-effective-backing-scale + ;; method reset-clip : cr -> void ;; ;; Resets the clipping region @@ -170,6 +180,8 @@ (define/public (flush-cr) (void)) (define/public (init-cr-matrix cr) (void)) + (define/public (set-effective-backing-scale v) (void)) + (define/public (get-init-effective-backing-scale) 1.0) (define/public (reset-clip cr) (cairo_reset_clip cr)) @@ -242,7 +254,7 @@ (inherit flush-cr get-cr release-cr end-cr init-cr-matrix get-pango install-color dc-adjust-smoothing get-hairline-width dc-adjust-cap-shape - reset-clip + reset-clip get-init-effective-backing-scale collapse-bitmap-b&w? ok? can-mask-bitmap? get-clear-operator) @@ -296,6 +308,14 @@ (define pen-stipple-s #f) (define brush-stipple-s #f) + (define effective-backing-scale (get-init-effective-backing-scale)) + (define/override (set-effective-backing-scale v) + (unless (= v effective-backing-scale) + (set! effective-backing-scale v) + (reset-font-cache!) + (reset-effective!) + (reset-align!))) + (define x-align-delta 0.5) (define y-align-delta 0.5) (define/private (reset-align!) @@ -332,8 +352,8 @@ (define scroll-dx 0.0) (define scroll-dy 0.0) - (define effective-scale-x 1.0) - (define effective-scale-y 1.0) + (define effective-scale-x effective-backing-scale) + (define effective-scale-y effective-backing-scale) (define effective-origin-x 0.0) (define effective-origin-y 0.0) @@ -347,8 +367,9 @@ (set! scale-x 1.0) (set! scale-y 1.0) (set! rotation 0.0) - (set! effective-scale-x 1.0) - (set! effective-scale-y 1.0) + (set! effective-scale-x effective-backing-scale) + (set! effective-scale-y effective-backing-scale) + (set-effective-scale-font-cached?!) (set! effective-origin-x 0.0) (set! effective-origin-y 0.0) (set! current-xform (vector 1.0 0.0 0.0 1.0 0.0 0.0)) @@ -361,8 +382,8 @@ (set! bg (send the-color-database find-color "white")) (set! pen-stipple-s #f) (set! brush-stipple-s #f) - (set! x-align-delta 0.5) - (set! y-align-delta 0.5) + (set! x-align-delta (/ effective-backing-scale 2.0)) + (set! y-align-delta (/ effective-backing-scale 2.0)) (set! smoothing 'unsmoothed) (set! current-smoothing #f) (set! alpha 1.0) @@ -376,10 +397,13 @@ (cairo_matrix_scale mx scale-x scale-y) (cairo_matrix_rotate mx (- rotation)) (let ([ssq (lambda (a b) (sqrt (+ (* a a) (* b b))))]) - (set! effective-scale-x (ssq (cairo_matrix_t-xx mx) - (cairo_matrix_t-xy mx))) - (set! effective-scale-y (ssq (cairo_matrix_t-yy mx) - (cairo_matrix_t-yx mx)))) + (set! effective-scale-x (* effective-backing-scale + (ssq (cairo_matrix_t-xx mx) + (cairo_matrix_t-xy mx)))) + (set! effective-scale-y (* effective-backing-scale + (ssq (cairo_matrix_t-yy mx) + (cairo_matrix_t-yx mx))))) + (set-effective-scale-font-cached?!) (set! effective-origin-x (cairo_matrix_t-x0 mx)) (set! effective-origin-y (cairo_matrix_t-y0 mx)) (let ([v (vector (cairo_matrix_t-xx mx) @@ -1216,6 +1240,7 @@ (cairo_copy_path cr))) (define size-cache (make-weak-hasheq)) + (define effective-scale-font-cached? #t) (define/private (get-size-cache desc) (or (hash-ref size-cache desc #f) @@ -1223,6 +1248,15 @@ (hash-set! size-cache desc h) h))) + (define/private (reset-font-cache!) + (when (positive? (hash-count size-cache)) + (set! size-cache (make-weak-hasheq)))) + + (define/private (set-effective-scale-font-cached?!) + (set! effective-scale-font-cached? + (and (= effective-scale-x effective-backing-scale) + (= effective-scale-y effective-backing-scale)))) + (def/public (get-text-extent [string? s] [(make-or-false font%) [use-font font]] [any? [combine? #f]] @@ -1232,8 +1266,7 @@ ;; Try to used cached size info, first: (let-values ([(w h d a) (if (or combine? - (not (= 1.0 effective-scale-x)) - (not (= 1.0 effective-scale-y))) + (not effective-scale-font-cached?)) (values #f #f #f #f) (let ([cache (get-size-cache (get-pango use-font))]) (if (= offset (string-length s)) @@ -1415,8 +1448,7 @@ ;; This is character-by-character mode. It uses a cached per-character+font layout ;; object. (let ([cache (if (or combine? - (not (fl= 1.0 effective-scale-x)) - (not (fl= 1.0 effective-scale-y))) + (not effective-scale-font-cached?)) #f (get-size-cache desc))] [layouts (let ([attr-layouts (or (hash-ref (let ([t (vector-ref desc-layoutss smoothing-index)]) 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 99146cfa8a..b48b4eb6b3 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/local.rkt @@ -55,4 +55,6 @@ can-combine-text? can-mask-bitmap? reset-clip - get-clear-operator) + get-clear-operator + get-init-effective-backing-scale + set-effective-backing-scale) diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt index 880c35b345..5c2ceb3ea2 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt @@ -224,6 +224,7 @@ [do-clock #f] [use-bitmap? #f] [platform-bitmap? #f] + [screen-bitmap? #f] [compat-bitmap? #f] [scaled-bitmap? #f] [use-record? #f] @@ -308,6 +309,8 @@ (cond [platform-bitmap? (make-platform-bitmap w h)] + [screen-bitmap? + (make-screen-bitmap w h)] [compat-bitmap? (send this make-bitmap w h)] [scaled-bitmap? @@ -1313,16 +1316,17 @@ (super-new [parent parent][style '(hscroll vscroll)]) (init-auto-scrollbars (* 2 DRAW-WIDTH) (* 2 DRAW-HEIGHT) 0 0)) vp)]) - (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Backing x3" "Record" "Serialize" "Bad") hp0 + (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Screen" "Compatible" "Backing x3" "Record" "Serialize" "Bad") hp0 (lambda (self event) (set! use-bitmap? (< 0 (send self get-selection))) (set! depth-one? (= 2 (send self get-selection))) (set! platform-bitmap? (= 3 (send self get-selection))) - (set! compat-bitmap? (= 4 (send self get-selection))) - (set! scaled-bitmap? (= 5 (send self get-selection))) - (set! use-record? (<= 6 (send self get-selection) 6)) - (set! serialize-record? (= 7 (send self get-selection))) - (set! use-bad? (< 8 (send self get-selection))) + (set! screen-bitmap? (= 4 (send self get-selection))) + (set! compat-bitmap? (= 5 (send self get-selection))) + (set! scaled-bitmap? (= 6 (send self get-selection))) + (set! use-record? (<= 7 (send self get-selection) 6)) + (set! serialize-record? (= 8 (send self get-selection))) + (set! use-bad? (< 9 (send self get-selection))) (send canvas refresh))) (make-object button% "PS" hp (lambda (self event)