From 28a245ea0d0a99614090d5dcb25e910e6cebd5be Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 3 Jan 2005 18:08:28 +0000 Subject: [PATCH] . original commit: b7e43f3d7290c2332d47fc9f86044467da5cd396 --- collects/tests/mred/draw.ss | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss index bf727fca..96766792 100644 --- a/collects/tests/mred/draw.ss +++ b/collects/tests/mred/draw.ss @@ -949,6 +949,8 @@ [(roundrect) (let ([r (make-object region% dc)]) (send r set-rounded-rectangle 80 200 125 40 -0.25) (send dc set-clipping-region r))] + [(empty) (let ([r (make-object region% dc)]) + (send dc set-clipping-region r))] [(polka) (let ([c (send dc get-background)]) (send dc set-background (send the-color-database find-color "PURPLE")) @@ -1012,7 +1014,8 @@ [(rect+poly rect+circle poly^rect) '(0. -25. 180. 400.)] [(poly&rect) '(100. 60. 10. 180.)] [(roundrect) '(80. 200. 125. 40.)] - [(polka) '(0. 0. 310. 510.)])]) + [(polka) '(0. 0. 310. 510.)] + [(empty) '(0. 0. 0. 0.)])]) (if clip-pre-scale? (list (- (/ (car l) xscale) offset) (- (/ (cadr l) yscale) offset) @@ -1117,11 +1120,14 @@ (make-object choice% "Clip" '("None" "Rectangle" "Rectangle2" "Octagon" "Circle" "Round Rectangle" "Lambda" "Rectangle + Octagon" "Rectangle + Circle" - "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka") + "Octagon - Rectangle" "Rectangle & Octagon" "Rectangle ^ Octagon" "Polka" + "Empty") hp3 (lambda (self event) (set! clip (list-ref - '(none rect rect2 poly circle roundrect lam rect+poly rect+circle poly-rect poly&rect poly^rect polka) + '(none rect rect2 poly circle roundrect lam + rect+poly rect+circle poly-rect poly&rect poly^rect + polka empty) (send self get-selection))) (send canvas refresh))) (make-object check-box% "Clip Pre-Scale" hp3