From 00d7cf496616009bbf18b5561c8bf20d7df21707 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 20 Apr 2006 17:12:23 +0000
Subject: [PATCH] removed #:teeth-shading and just let people disable the teeth
 entirely

svn: r2726
---
 collects/texpict/doc.txt      | 20 +++++++++-------
 collects/texpict/face-demo.ss |  2 +-
 collects/texpict/face.ss      | 45 +++++++++++++++++++++--------------
 3 files changed, 39 insertions(+), 28 deletions(-)

diff --git a/collects/texpict/doc.txt b/collects/texpict/doc.txt
index 0c8187ad20..13903834c8 100644
--- a/collects/texpict/doc.txt
+++ b/collects/texpict/doc.txt
@@ -1042,16 +1042,18 @@ implements an interactive browser for face configurations.
       - pupil-dx adjusts the pupil; recommend values: between -10 and 10
       - pupil-dy adjusts the pupil; recommend values: between -15 and 15
 
-> eyebrow-shading : (parameter boolean)
-> mouth-shading : (parameter boolean)
-> eye-shading  : (parameter boolean)
-> tongue-shading : (parameter boolean)
-> face-background-shading : (parameter boolean)
-> teeth-shading : (parameter boolean)
+In addition to the above, the function also accepts these keywords,
+each of which is a boolean. With the exception of the last one, they
+control if there is a shading on a particular feature in the face
+(shading tends to look worse than just anti-aliasing when the face is
+small). The last one controls the visibility of the teeth.
 
-The above parameters control the shading of features on the
-face. At small sizes, the shading tends to make the face
-look worse, so can be disabled, as necessary.
+ #:eyebrow-shading?
+ #:mouth-shading?
+ #:eye-shading?
+ #:tongue-shading?
+ #:face-background-shading?
+ #:teeth?
 
 ------------------------------------------------------------
 _flash.ss_
diff --git a/collects/texpict/face-demo.ss b/collects/texpict/face-demo.ss
index 7ad5625a8e..edd61c4fd6 100644
--- a/collects/texpict/face-demo.ss
+++ b/collects/texpict/face-demo.ss
@@ -24,7 +24,7 @@
           #:eyebrow-shading?
           #:tongue-shading?
           #:face-background-shading?
-          #:teeth-shading?))
+          #:teeth?))
   
   (define moods
     '(unhappiest
diff --git a/collects/texpict/face.ss b/collects/texpict/face.ss
index 4ba9899edb..e0045b9914 100644
--- a/collects/texpict/face.ss
+++ b/collects/texpict/face.ss
@@ -33,7 +33,7 @@
                 (eyebrow-shading? #t)
                 (tongue-shading? #t)
                 (face-background-shading? #t)
-                (teeth-shading? #t))
+                (teeth? #t))
                
       (define face-color (if (string? in-face-color)
                              (make-object color% in-face-color)
@@ -153,21 +153,22 @@
                   ;; Assumes clipping region is set
                   (send dc set-brush (find-brush "white"))
                   (send dc draw-ellipse x y w h)
-                  (series dc 
-                          (if teeth-shading? 5 0)
-                          (make-object color% "darkgray")
-                          (make-object color% "lightgray")
-                          (lambda (i)
-                            (let loop ([j 0][delta 0][tw (* w 1/10)])
-                              (unless (= j 5)
-                                (send dc draw-rectangle
-                                      (+ x (* w 1/2) delta 1) y
-                                      (- tw i 1) h)
-                                (send dc draw-rectangle
-                                      (+ x (* w 1/2) (- delta) (- tw) 1) y
-                                      (- tw i 1) h)
-                                (loop (add1 j) (+ delta tw) (* 8/10 tw)))))
-                          #f #t))
+                  (when teeth?
+                    (series dc 
+                            5
+                            (make-object color% "darkgray")
+                            (make-object color% "lightgray")
+                            (lambda (i)
+                              (let loop ([j 0][delta 0][tw (* w 1/10)])
+                                (unless (= j 5)
+                                  (send dc draw-rectangle
+                                        (+ x (* w 1/2) delta 1) y
+                                        (- tw i 1) h)
+                                  (send dc draw-rectangle
+                                        (+ x (* w 1/2) (- delta) (- tw) 1) y
+                                        (- tw i 1) h)
+                                  (loop (add1 j) (+ delta tw) (* 8/10 tw)))))
+                            #f #t)))
                 
                 (define (toothy-smile tw th ta bw bh ba flip? ddy)
                   (let-values ([(path) (make-object dc-path%)]
@@ -333,9 +334,17 @@
                 (send dc set-pen old-pen))
               w h 0 0))))
 
+  (define-syntax (case/good-error-message stx)
+    (syntax-case stx (else)
+      [(_ test [(sym ...) e] ... [else x last-e])
+       (syntax
+        (case test 
+          [(sym ...) e]  ...
+          [else (let ([x (apply append '((sym ...) ...))]) last-e)]))]))
+      
   (define face
     (opt-lambda (mood [face-color default-face-color])
-      (case mood
+      (case/good-error-message mood
 	[(unhappy)
 	 (face* 'none 'plain #t face-color 6)]
 	[(sortof-happy)
@@ -362,4 +371,4 @@
          (face* 'angry 'narrow #f face-color 0)]
         [(surprised)
          (face* 'worried 'oh #t face-color -4 -3 2)]
-	[else (error 'face "unknown mood: ~e" mood)]))))
+	[else all-ids (error 'face "unknown mood: ~e, expected one of ~s" mood all-ids)]))))