removed #:teeth-shading and just let people disable the teeth entirely
svn: r2726
This commit is contained in:
parent
f5d5caddbf
commit
00d7cf4966
|
@ -1042,16 +1042,18 @@ implements an interactive browser for face configurations.
|
||||||
- pupil-dx adjusts the pupil; recommend values: between -10 and 10
|
- pupil-dx adjusts the pupil; recommend values: between -10 and 10
|
||||||
- pupil-dy adjusts the pupil; recommend values: between -15 and 15
|
- pupil-dy adjusts the pupil; recommend values: between -15 and 15
|
||||||
|
|
||||||
> eyebrow-shading : (parameter boolean)
|
In addition to the above, the function also accepts these keywords,
|
||||||
> mouth-shading : (parameter boolean)
|
each of which is a boolean. With the exception of the last one, they
|
||||||
> eye-shading : (parameter boolean)
|
control if there is a shading on a particular feature in the face
|
||||||
> tongue-shading : (parameter boolean)
|
(shading tends to look worse than just anti-aliasing when the face is
|
||||||
> face-background-shading : (parameter boolean)
|
small). The last one controls the visibility of the teeth.
|
||||||
> teeth-shading : (parameter boolean)
|
|
||||||
|
|
||||||
The above parameters control the shading of features on the
|
#:eyebrow-shading?
|
||||||
face. At small sizes, the shading tends to make the face
|
#:mouth-shading?
|
||||||
look worse, so can be disabled, as necessary.
|
#:eye-shading?
|
||||||
|
#:tongue-shading?
|
||||||
|
#:face-background-shading?
|
||||||
|
#:teeth?
|
||||||
|
|
||||||
------------------------------------------------------------
|
------------------------------------------------------------
|
||||||
_flash.ss_
|
_flash.ss_
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
#:eyebrow-shading?
|
#:eyebrow-shading?
|
||||||
#:tongue-shading?
|
#:tongue-shading?
|
||||||
#:face-background-shading?
|
#:face-background-shading?
|
||||||
#:teeth-shading?))
|
#:teeth?))
|
||||||
|
|
||||||
(define moods
|
(define moods
|
||||||
'(unhappiest
|
'(unhappiest
|
||||||
|
|
|
@ -33,7 +33,7 @@
|
||||||
(eyebrow-shading? #t)
|
(eyebrow-shading? #t)
|
||||||
(tongue-shading? #t)
|
(tongue-shading? #t)
|
||||||
(face-background-shading? #t)
|
(face-background-shading? #t)
|
||||||
(teeth-shading? #t))
|
(teeth? #t))
|
||||||
|
|
||||||
(define face-color (if (string? in-face-color)
|
(define face-color (if (string? in-face-color)
|
||||||
(make-object color% in-face-color)
|
(make-object color% in-face-color)
|
||||||
|
@ -153,8 +153,9 @@
|
||||||
;; Assumes clipping region is set
|
;; Assumes clipping region is set
|
||||||
(send dc set-brush (find-brush "white"))
|
(send dc set-brush (find-brush "white"))
|
||||||
(send dc draw-ellipse x y w h)
|
(send dc draw-ellipse x y w h)
|
||||||
|
(when teeth?
|
||||||
(series dc
|
(series dc
|
||||||
(if teeth-shading? 5 0)
|
5
|
||||||
(make-object color% "darkgray")
|
(make-object color% "darkgray")
|
||||||
(make-object color% "lightgray")
|
(make-object color% "lightgray")
|
||||||
(lambda (i)
|
(lambda (i)
|
||||||
|
@ -167,7 +168,7 @@
|
||||||
(+ x (* w 1/2) (- delta) (- tw) 1) y
|
(+ x (* w 1/2) (- delta) (- tw) 1) y
|
||||||
(- tw i 1) h)
|
(- tw i 1) h)
|
||||||
(loop (add1 j) (+ delta tw) (* 8/10 tw)))))
|
(loop (add1 j) (+ delta tw) (* 8/10 tw)))))
|
||||||
#f #t))
|
#f #t)))
|
||||||
|
|
||||||
(define (toothy-smile tw th ta bw bh ba flip? ddy)
|
(define (toothy-smile tw th ta bw bh ba flip? ddy)
|
||||||
(let-values ([(path) (make-object dc-path%)]
|
(let-values ([(path) (make-object dc-path%)]
|
||||||
|
@ -333,9 +334,17 @@
|
||||||
(send dc set-pen old-pen))
|
(send dc set-pen old-pen))
|
||||||
w h 0 0))))
|
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
|
(define face
|
||||||
(opt-lambda (mood [face-color default-face-color])
|
(opt-lambda (mood [face-color default-face-color])
|
||||||
(case mood
|
(case/good-error-message mood
|
||||||
[(unhappy)
|
[(unhappy)
|
||||||
(face* 'none 'plain #t face-color 6)]
|
(face* 'none 'plain #t face-color 6)]
|
||||||
[(sortof-happy)
|
[(sortof-happy)
|
||||||
|
@ -362,4 +371,4 @@
|
||||||
(face* 'angry 'narrow #f face-color 0)]
|
(face* 'angry 'narrow #f face-color 0)]
|
||||||
[(surprised)
|
[(surprised)
|
||||||
(face* 'worried 'oh #t face-color -4 -3 2)]
|
(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)]))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user