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

use alignment when installing regions

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-29 15:11:29 -06:00
parent 50caefcb38
commit f74c0de6ad
2 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/racket/draw/private/dc.rkt
View File

@ -453,7 +453,8 @@
(set! desc-layoutss (make-vector (vector-length font-maps) #f)) (set! desc-layoutss (make-vector (vector-length font-maps) #f))
(do-reset-matrix cr) (do-reset-matrix cr)
(when clipping-region (when clipping-region
(send clipping-region install-region cr scroll-dx scroll-dy))) (send clipping-region install-region cr scroll-dx scroll-dy
(lambda (x) (align-x x)) (lambda (y) (align-y y)))))
(define smoothing 'unsmoothed) (define smoothing 'unsmoothed)
@ -601,7 +602,8 @@
(reset-clip cr) (reset-clip cr)
(when clipping-region (when clipping-region
(send clipping-region lock-region 1) (send clipping-region lock-region 1)
(send clipping-region install-region cr scroll-dx scroll-dy)))) (send clipping-region install-region cr scroll-dx scroll-dy
(lambda (x) (align-x x)) (lambda (y) (align-y y))))))
(define/public (get-clipping-matrix) (define/public (get-clipping-matrix)
(let* ([cm (make-cairo_matrix_t (cairo_matrix_t-xx matrix) (let* ([cm (make-cairo_matrix_t (cairo_matrix_t-xx matrix)

9
collects/racket/draw/private/region.rkt
View File

@ -108,7 +108,8 @@
(max r (+ l2 w2)) (max r (+ l2 w2))
(max b (+ t2 h2))))))))) (max b (+ t2 h2)))))))))
(define/public (install-region cr scroll-dx scroll-dy [init (void)] [install (lambda (cr v) (cairo_clip cr))]) (define/public (install-region cr scroll-dx scroll-dy align-x align-y
[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)
CAIRO_FILL_RULE_EVEN_ODD CAIRO_FILL_RULE_EVEN_ODD
CAIRO_FILL_RULE_WINDING)] CAIRO_FILL_RULE_WINDING)]
@ -121,7 +122,7 @@
(cairo_set_matrix cr (make-cairo_matrix_t 1 0 0 1 scroll-dx scroll-dy))) (cairo_set_matrix cr (make-cairo_matrix_t 1 0 0 1 scroll-dx scroll-dy)))
(for/fold ([v init]) ([pr (in-list paths)]) (for/fold ([v init]) ([pr (in-list paths)])
(cairo_new_path cr) (cairo_new_path cr)
(send (car pr) do-path cr values values) (send (car pr) do-path cr align-x align-y)
(cairo_set_fill_rule cr (cairo_set_fill_rule cr
(case (cdr pr) (case (cdr pr)
[(odd-even) CAIRO_FILL_RULE_EVEN_ODD] [(odd-even) CAIRO_FILL_RULE_EVEN_ODD]
@ -139,7 +140,7 @@
in-cairo-context in-cairo-context
(lambda (cr) (lambda (cr)
(cairo_save cr) (cairo_save cr)
(install-region cr 0 0) (install-region cr 0 0 values values)
(begin0 (begin0
(proc cr) (proc cr)
(cairo_restore cr))))) (cairo_restore cr)))))
@ -181,7 +182,7 @@
;; no transformation needed ;; no transformation needed
(values x y))]) (values x y))])
(begin0 (begin0
(install-region cr #t (lambda (cr v) (and v (cairo_in_fill cr x y)))) (install-region cr #t values values (lambda (cr v) (and v (cairo_in_fill cr x y))))
(call-as-atomic (call-as-atomic
(cond (cond
[temp-cr (cairo_destroy cr)] [temp-cr (cairo_destroy cr)]