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

Merge to v5.3.4

collects/racket/draw/private/region.rkt

@@ -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)
+        (begin0
-            (begin
+         (if (null? paths)
-              (cairo_new_path cr)
+             (begin
-              (install cr init))
+               (cairo_new_path cr)
-            (for/fold ([v init]) ([pr (in-list paths)])
+               (install cr init))
-              (cairo_new_path cr)
+             (for/fold ([v init]) ([pr (in-list paths)])
-              (send (car pr) do-path cr values values)
+               (cairo_new_path cr)
-              (cairo_set_fill_rule cr
+               (send (car pr) do-path cr values values)
-                                   (case (cdr pr)
+               (cairo_set_fill_rule cr
-                                     [(odd-even) CAIRO_FILL_RULE_EVEN_ODD]
+                                    (case (cdr pr)
-                                     [(winding) CAIRO_FILL_RULE_WINDING]
+                                      [(odd-even) CAIRO_FILL_RULE_EVEN_ODD]
-                                     [else default-fill-rule]))
+                                      [(winding) CAIRO_FILL_RULE_WINDING]
-              (install cr v)))
+                                      [else default-fill-rule]))
-        (when old-matrix (cairo_set_matrix cr old-matrix))))
+               (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)

collects/tests/gracket/dc.rktl

@@ -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)