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

fix region and dc-path bounding boxes

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-02 06:40:38 -06:00
parent e0a2a66dc8
commit 5d9b22be49
2 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/racket/draw/dc-path.rkt
View File

@ -128,21 +128,23 @@
(let ([p (car l)])
(values (car p) (cdr p)
(car p) (cdr p)))))])
(for*/fold ([l l]
[t t]
[r r]
[b b])
([pts (in-list (cons open-points closed-points))]
[p (in-list pts)])
(cond
[(pair? p) (values (min l (car p))
(min t (cdr p))
(max r (car p))
(max b (cdr p)))]
[else (values (min l (vector-ref p 0) (vector-ref p 2))
(min t (vector-ref p 1) (vector-ref p 3))
(max r (vector-ref p 0) (vector-ref p 2))
(max b (vector-ref p 1) (vector-ref p 3)))])))))
(let-values ([(l t r b)
(for*/fold ([l l]
[t t]
[r r]
[b b])
([pts (in-list (cons open-points closed-points))]
[p (in-list pts)])
(cond
[(pair? p) (values (min l (car p))
(min t (cdr p))
(max r (car p))
(max b (cdr p)))]
[else (values (min l (vector-ref p 0) (vector-ref p 2))
(min t (vector-ref p 1) (vector-ref p 3))
(max r (vector-ref p 0) (vector-ref p 2))
(max b (vector-ref p 1) (vector-ref p 3)))]))])
(values l t (- r l) (- b t))))))
(def/public (move-to [real? x] [real? y])
(when (or (pair? open-points)

22
collects/racket/draw/region.rkt
View File

@ -55,12 +55,12 @@
(def/public (get-bounding-box)
(if (null? paths)
(values 0.0 0.0 0.0 0.0)
(let-values ([(l t r b) (send (caar paths) get-bounding-box)])
(let-values ([(l t w h) (send (caar paths) get-bounding-box)])
(let loop ([paths (cdr paths)]
[l l]
[t t]
[r r]
[b b])
[r (+ l w)]
[b (+ t h)])
(if (null? paths)
(if matrix
;; Convert absolute coordinates back to the DC's
@ -88,16 +88,19 @@
[y (- y dy)])
(/ (- (* ma y) (* mc x)) det)))])
;; unwind bound-box points to pre-transformed
(values (tx l t) (ty l t)
(tx r b) (ty r b)))))))
(let ([l (tx l t)]
[t (ty l t)]
[r (tx r b)]
[b (ty r b)])
(values l t (- r l) (- b t))))))))
;; no dc un-transformation needed
(values l t r b))
(let-values ([(l2 t2 r2 b2) (send (caar paths) get-bounding-box)])
(values l t (- r l) (- b t)))
(let-values ([(l2 t2 w2 h2) (send (caar paths) get-bounding-box)])
(loop (cdr paths)
(min l l2)
(min t t2)
(max r r2)
(max b b2))))))))
(max r (+ l2 w2))
(max b (+ t2 h2)))))))))
(define/public (install-region cr [init (void)] [install (lambda (cr v) (cairo_clip cr))])
(let ([default-fill-rule (if (ormap (lambda (pr) (eq? (cdr pr) 'odd-even)) paths)
@ -200,6 +203,7 @@
(modifying 'set-path)
(let ([p (new dc-path%)])
(send p append path)
(send p translate x y)
(when matrix (send p transform matrix))
(set! paths (list (cons p fill-style)))))