From ab6afa4e96079d88f4d7c1bfa9b8103804c7f6ff Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 23 Aug 2012 09:42:34 -0600 Subject: [PATCH] racket/draw: fix `set-clipping-rect' in `record-dc%' original commit: edd2035f88b571afc9ed85ba0f7c6167332fb5b3 --- collects/tests/gracket/dc.rktl | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl index b04cf8ca..21da9ad3 100644 --- a/collects/tests/gracket/dc.rktl +++ b/collects/tests/gracket/dc.rktl @@ -596,6 +596,28 @@ (send gl1 call-as-current (lambda () (error "fail")))) (test 12 'post-exn (send gl1 call-as-current (lambda () 12))))) + +;; ---------------------------------------- +;; check clipping + +(let () + (define rdc (new record-dc%)) + (send rdc set-brush "green" 'solid) + (send rdc set-clipping-rect 2 2 5 5) + (send rdc draw-rectangle 0 0 9 9) + + (define bm (make-bitmap 25 25)) + (define bm-dc (make-object bitmap-dc% bm)) + + (send bm-dc set-clipping-rect 10 10 5 5) + + ((send rdc get-recorded-procedure) bm-dc) + + (define s (make-bytes (* 20 20 4))) + (send bm get-argb-pixels 0 0 20 20 s) + (for ([i (in-range 0 (* 20 20 4) 4)]) + (test 0 'record-dc-clipping-byte (bytes-ref s i)))) + ;; ---------------------------------------- (report-errs)