diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/dc-intf.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/dc-intf.scrbl index bb9003816c..5c346c66ff 100644 --- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/dc-intf.scrbl +++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/dc-intf.scrbl @@ -630,12 +630,12 @@ Returns a rectangle that encloses the path’s points. The return values are the left, top, width, and, height of the rectangle. The numbers are in logical coordinates. -For the type @racket['stroke] the rectangle covers the area that would be affected ("inked") +For the type @racket['stroke] the rectangle covers the area that would be affected (``inked'') when drawn with the current pen by draw-path in the drawing context (with a transparent brush). If the pen width is zero, then an empty rectangle will be returned. The size and clipping of the drawing context is ignored. -For the type @racket['fill] the rectangle covers the area that would be affected ("inked") +For the type @racket['fill] the rectangle covers the area that would be affected (``inked'') by draw-path in the drawing context (with a non-transparent pen and brush). If the line width is zero, then an empty rectangle will be returned. The size and clipping of the drawing context are ignored. @@ -643,9 +643,9 @@ context are ignored. For the type @racket['path] the rectangle covers the path, but the pen and brush are ignored. The size and clipping of the drawing context are also ignored. More precisely: The result is defined as the limit of the bounding boxes returned -by the 'stroke type for line widths approaching 0 with a round pen cap. The "limit -process" stops when an empty rectangle is returned. This that zero-area segments contributes -the rectangle. +by the @racket['stroke] type for line widths approaching 0 with a round pen cap. The ``limit +process'' stops when an empty rectangle is returned. This implies that zero-area segments +contributes to the rectangle. For all types if the path is empty, then an empty rectangle @racket[(values 0 0 0 0)] will be returned. diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc-path.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc-path.rkt index 99564ee013..82818bf7e4 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc-path.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc-path.rkt @@ -191,7 +191,7 @@ (do-path cr align-x align-y) (define-values (x1 y1 x2 y2) (cairo_op cr)) (cairo_restore cr) - (values x1 y1 y2 y2)))) + (values x1 y1 (- x2 x1) (- y2 y1))))) (define/public (move-to x y) (when (or (pair? open-points) 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 624c1780b3..05a0f387ca 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt @@ -801,7 +801,7 @@ (cairo_pattern_destroy p)) ;; Stroke, fill, and flush the current path - (define/private (draw cr brush? pen?) + (define/private (draw cr brush? pen? [do? #t]) (define (install-stipple st col mode transformation get put) (let ([s (cond [(get) => (lambda (s) s)] @@ -987,10 +987,10 @@ [(miter) CAIRO_LINE_JOIN_MITER] [(round) CAIRO_LINE_JOIN_ROUND] [(bevel) CAIRO_LINE_JOIN_BEVEL])) - (cairo_stroke cr) + (and do? (cairo_stroke cr)) (unless (or (eq? s 'solid) (eq? s 'xor)) (cairo_set_dash cr #() 0))))) - (flush-cr)) + (and do? (flush-cr))) (define/private (do-draw-arc who x y @@ -1141,8 +1141,14 @@ (with-cr (values 0. 0. 0. 0.) cr - (send path do-get-path-bounding-box cr type - (lambda (x) (align-x x)) (lambda (y) (align-y y))))) + (let () + (cairo_save cr) + (draw cr #t #t #f) + (define-values (x y w h) + (send path do-get-path-bounding-box cr type + (lambda (x) (align-x x)) (lambda (y) (align-y y)))) + (cairo_restore cr) + (values x y w h)))) (def/public (draw-spline [real? x1] [real? y1] [real? x2] [real? y2] [real? x3] [real? y3]) (with-cr 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 7052c7ee48..9c4360098e 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt @@ -465,12 +465,7 @@ -> (values x1 y1 x2 y2)) ;; cairo_path_extents is in version 1.6 and later #:fail (lambda () - (let ([warned? #f]) - (lambda (cr) - (unless warned? - (log-warning "cairo_path_extents is unavailable; returning the empty rectangle") - (set! warned? #t)) - (values 0 0 0 0))))) + cairo_stroke_extents)) (define-enum 0 CAIRO_PATH_MOVE_TO diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl index 98a77456b3..af95da3fe3 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl @@ -1,4 +1,3 @@ - (load-relative "loadtest.rktl") (require racket/gui/base) @@ -704,6 +703,53 @@ (test #f 'no (send r in-region? 5 5)) (test #t 'yes (send r in-region? 105 105))) +;; ---------------------------------------- +;; Test get-path-bounding-box + +(define (test-square-bounding-boxes) + (define-syntax (box stx) + (syntax-case stx () + [(_ expr ...) + #'(let-values ([(left top width height) expr ...]) + (list left top width height))])) + (define dp ; a-square-path + (let ([dp (new dc-path%)]) + (send dp move-to 10 20) + (send dp line-to 30 20) + (send dp line-to 30 50) + (send dp line-to 10 50) + (send dp line-to 10 20) + (send dp close) + dp)) + + (define bm (make-object bitmap% 100 100)) + (define dc (new bitmap-dc% [bitmap bm])) + (send dc set-brush (send the-brush-list find-or-create-brush "red" 'solid)) + (send dc set-smoothing 'smoothed) + + (define (bbs pen-width) + (send dc set-pen (send the-pen-list find-or-create-pen "black" pen-width 'solid + 'projecting 'round)) + (define bb (box (send dp get-bounding-box))) + (define bb-path (box (send dc get-path-bounding-box dp 'path))) + (define bb-stroke (box (send dc get-path-bounding-box dp 'stroke))) + (define bb-fill (box (send dc get-path-bounding-box dp 'fill))) + (values bb bb-path bb-stroke bb-fill)) + (define (inside? b1 b2) ; is b2 inside b1? + (match-define (list x y w h) b1) + (match-define (list s t a b) b2) + (and (< x s) (< y t) (> w a) (> h a))) + (define (test w) + (define-values (n p s f) (bbs w)) + (when (= w 0) (set! w 1)) ; 1 is the hair line width + (and (inside? s p) ; p ignores pen width, s does not + (equal? n (list 10. 20. 20. 30.)) + (equal? p n); no control points outside the convex hull + (equal? s (list (- 10. (/ w 2)) (- 20. (/ w 2)) (+ 20. w) (+ 30. w))) + (equal? p f))) + (and (test 10) (test 1) (test 0))) + +(test #t 'get-path-bounding-box (test-square-bounding-boxes)) ;; ----------------------------------------