From 5d9b22be494ccfb690ffaa049d84c97992ccd54a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Aug 2010 06:40:38 -0600 Subject: [PATCH] fix region and dc-path bounding boxes --- collects/racket/draw/dc-path.rkt | 32 +++++++++++++++++--------------- collects/racket/draw/region.rkt | 22 +++++++++++++--------- 2 files changed, 30 insertions(+), 24 deletions(-) diff --git a/collects/racket/draw/dc-path.rkt b/collects/racket/draw/dc-path.rkt index d480391f1d..314433b34a 100644 --- a/collects/racket/draw/dc-path.rkt +++ b/collects/racket/draw/dc-path.rkt @@ -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) diff --git a/collects/racket/draw/region.rkt b/collects/racket/draw/region.rkt index c1e763cfc6..7be9d1dad8 100644 --- a/collects/racket/draw/region.rkt +++ b/collects/racket/draw/region.rkt @@ -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)))))