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

racket/draw: fix in-region?' method of region%'

Browse Source 
Merge to v5.3.4
This commit is contained in:
Matthew Flatt 2013-04-26 16:17:27 -06:00
parent 1ef1d256f7
commit 917ec51eee
2 changed files with 59 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -125,20 +125,21 @@
(cairo_identity_matrix cr)
(init-matrix cr)
(cairo_transform cr (make-cairo_matrix_t 1 0 0 1 scroll-dx scroll-dy)))
(if (null? paths)
(begin
(cairo_new_path cr)
(install cr init))
(for/fold ([v init]) ([pr (in-list paths)])
(cairo_new_path cr)
(send (car pr) do-path cr values values)
(cairo_set_fill_rule cr
(case (cdr pr)
[(odd-even) CAIRO_FILL_RULE_EVEN_ODD]
[(winding) CAIRO_FILL_RULE_WINDING]
[else default-fill-rule]))
(install cr v)))
(when old-matrix (cairo_set_matrix cr old-matrix))))
(begin0
(if (null? paths)
(begin
(cairo_new_path cr)
(install cr init))
(for/fold ([v init]) ([pr (in-list paths)])
(cairo_new_path cr)
(send (car pr) do-path cr values values)
(cairo_set_fill_rule cr
(case (cdr pr)
[(odd-even) CAIRO_FILL_RULE_EVEN_ODD]
[(winding) CAIRO_FILL_RULE_WINDING]
[else default-fill-rule]))
(install cr v)))
(when old-matrix (cairo_set_matrix cr old-matrix)))))
(def/public (is-empty?)
(really-is-empty?))
@ -203,7 +204,9 @@
(vector-ref m 5))))
;; no transformation needed
(values x y))])
(install-region cr #t values values (lambda (cr v) (and v (cairo_in_fill cr x y))))))))
(install-region cr 0 0 values values
#t
(lambda (cr v) (and v (cairo_in_fill cr x y))))))))
(define/public (set-arc x y width height start-radians end-radians)
(modifying 'set-arc)

41
collects/tests/gracket/dc.rktl
View File

@ -664,6 +664,47 @@
(test #f 'no-alpha (send bm2 has-alpha-channel?))
(test #f 'no-alpha (send bm3 has-alpha-channel?)))
;; ----------------------------------------
;; Check `in-region?'
(let ()
(define r (new region%))
(send r set-rectangle 0 0 100 100)
(test #t 'yes/r (send r in-region? 10 10))
(test #f 'no/r (send r in-region? 110 110))
(test #f 'no/r (send r in-region? 10 110))
(define r2 (new region%))
(send r2 set-rectangle 120 120 10 10)
(send r2 union r)
(test #t 'yes/r (send r in-region? 10 10))
(test #t 'yes/r2 (send r2 in-region? 10 10))
(test #f 'no/r (send r in-region? 125 125))
(test #t 'yes/r2 (send r2 in-region? 125 125))
(test #f 'no/r2 (send r2 in-region? 110 110)))
(let ()
(define bm (make-bitmap 50 50))
(define dc (send bm make-dc))
(send dc translate 10 10)
(define r (make-object region% dc))
(send r set-rectangle 0 0 100 100)
(test #t 'yes (send r in-region? 5 5))
(test #f 'no (send r in-region? 110 110)))
(let ()
(define bm (make-bitmap 50 50))
(define dc (send bm make-dc))
(send dc translate 10 10)
;; dc's translation at creation of region sticks:
(define r (make-object region% dc))
(send r set-rectangle 0 0 100 100)
(send dc translate -10 -10)
(test #f 'no (send r in-region? 5 5))
(test #t 'yes (send r in-region? 105 105)))
;; ----------------------------------------
(report-errs)