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

removed #:teeth-shading and just let people disable the teeth entirely

Browse Source 
svn: r2726
This commit is contained in:
Robby Findler 2006-04-20 17:12:23 +00:00
parent f5d5caddbf
commit 00d7cf4966
3 changed files with 39 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/texpict/doc.txt
View File

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

2
collects/texpict/face-demo.ss
View File

@ -24,7 +24,7 @@
#:eyebrow-shading?
#:tongue-shading?
#:face-background-shading?
#:teeth-shading?))
#:teeth?))
(define moods
'(unhappiest

45
collects/texpict/face.ss
View File

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