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)]) (let ([p (car l)])
(values (car p) (cdr p) (values (car p) (cdr p)
(car p) (cdr p)))))]) (car p) (cdr p)))))])
(for*/fold ([l l] (let-values ([(l t r b)
[t t] (for*/fold ([l l]
[r r] [t t]
[b b]) [r r]
([pts (in-list (cons open-points closed-points))] [b b])
[p (in-list pts)]) ([pts (in-list (cons open-points closed-points))]
(cond [p (in-list pts)])
[(pair? p) (values (min l (car p)) (cond
(min t (cdr p)) [(pair? p) (values (min l (car p))
(max r (car p)) (min t (cdr p))
(max b (cdr p)))] (max r (car p))
[else (values (min l (vector-ref p 0) (vector-ref p 2)) (max b (cdr p)))]
(min t (vector-ref p 1) (vector-ref p 3)) [else (values (min l (vector-ref p 0) (vector-ref p 2))
(max r (vector-ref p 0) (vector-ref p 2)) (min t (vector-ref p 1) (vector-ref p 3))
(max b (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]) (def/public (move-to [real? x] [real? y])
(when (or (pair? open-points) (when (or (pair? open-points)

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

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