suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added get-path-bounding-box take 2

Browse Source
This commit is contained in:
Jens Axel Søgaard 2013-08-10 23:09:15 +02:00
parent 61a4c85d0d
commit ac37ccb79c
5 changed files with 65 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/draw-pkgs/draw-doc/scribblings/draw/dc-intf.scrbl
View File

@ -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.

2
pkgs/draw-pkgs/draw-lib/racket/draw/private/dc-path.rkt
View File

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

14
pkgs/draw-pkgs/draw-lib/racket/draw/private/dc.rkt
View File

@ -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

7
pkgs/draw-pkgs/draw-lib/racket/draw/unsafe/cairo.rkt
View File

@ -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

48
pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
View File

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