Added get-path-bounding-box take 2

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
+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 that zero-area segments contributes
+process'' stops when an empty rectangle is returned. This implies that zero-area segments 
-the rectangle.
+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.

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)

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
+        (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)))))
+                  (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

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])
+           cairo_stroke_extents))
-             (lambda (cr) 
-               (unless warned?
-                 (log-warning "cairo_path_extents is unavailable; returning the empty rectangle")
-                 (set! warned? #t))
-               (values 0 0 0 0)))))
 
 (define-enum 0
   CAIRO_PATH_MOVE_TO

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))
 
 ;; ----------------------------------------