added surprised faces, 'oh mouths, and cleaned up a few things

svn: r2696
This commit is contained in:
Robby Findler 2006-04-17 21:13:59 +00:00
parent a847101855
commit 2f3cdfa302
3 changed files with 156 additions and 136 deletions

View File

@ -1027,13 +1027,14 @@ implements an interactive browser for face configurations.
'unhappiest - (face* 'normal 'huge #t default-face-color 0 -3) 'unhappiest - (face* 'normal 'huge #t default-face-color 0 -3)
'mad - (face* 'angry 'grimace #t default-face-color 0) 'mad - (face* 'angry 'grimace #t default-face-color 0)
'mean - (face* 'angry 'narrow #f default-face-color 0) 'mean - (face* 'angry 'narrow #f default-face-color 0)
'surprised - (face* 'worried 'oh #t default-face-color -4 -3 2)
> (face* eyebrow-kind mouth-kind frown? [color eye-inset eyebrow-dy pupil-dx pupil-dy]) > (face* eyebrow-kind mouth-kind frown? [color eye-inset eyebrow-dy pupil-dx pupil-dy])
- returns a pict for a configured face: - returns a pict for a configured face:
- eyebrow-kind is one of 'none, 'normal, 'worried, or 'angry - eyebrow-kind is one of 'none, 'normal, 'worried, or 'angry
- mouth-kind is one of 'plain, 'narrow, 'medium, 'large, 'huge, - mouth-kind is one of 'plain, 'narrow, 'medium, 'large, 'huge,
'grimace, or 'tongue 'grimace, 'oh, or 'tongue
- frown? determines whether the mouth is up or down - frown? determines whether the mouth is up or down
- color is either a color string or a color% object - color is either a color string or a color% object
- eye-inset adjusts the eye size; recommend values: between 0 and 10 - eye-inset adjusts the eye size; recommend values: between 0 and 10

View File

@ -29,7 +29,8 @@
embarassed embarassed
badly-embarassed badly-embarassed
mad mad
mean)) mean
surprised))
(new button% (new button%
(label "Face Color...") (label "Face Color...")
@ -58,7 +59,7 @@
(callback (lambda (c e) (callback (lambda (c e)
(set! face-eyebrow-kind (list-ref choices (send c get-selection))) (set! face-eyebrow-kind (list-ref choices (send c get-selection)))
(new-face-callback))))) (new-face-callback)))))
(let ([choices '(plain narrow medium large huge grimace)]) (let ([choices '(plain narrow medium large huge absurd grimace oh tongue)])
(new choice% (new choice%
(label "Mouth") (label "Mouth")
(choices (map symbol->string choices)) (choices (map symbol->string choices))
@ -131,6 +132,8 @@
face-pupils-dx face-pupils-dy))) face-pupils-dx face-pupils-dy)))
(send c on-paint)) (send c on-paint))
(send (send c get-dc) set-smoothing 'aligned)
(define (cb dc) (draw-pict the-pict dc 0 0)) (define (cb dc) (draw-pict the-pict dc 0 0))
(send c min-width (inexact->exact (floor (* canvas-scale (pict-width the-pict))))) (send c min-width (inexact->exact (floor (* canvas-scale (pict-width the-pict)))))

View File

@ -247,6 +247,19 @@
(* 1.0 w) (* h 0.75) (- (* 0.01 pi)) (* 1.0 w) (* h 0.75) (- (* 0.01 pi))
flip? 0)) flip? 0))
(define (oh)
(series dc 5
face-edge-color
(make-object color% "black")
(lambda (i)
(let ([sw (* w 7/20)]
[sh (* h 8/20)])
(send dc draw-ellipse
(+ x i (/ (- w sw) 2))
(+ y i (* h 1/4) (* h -1/16) (/ (- h sh) 2))
(- sw (* i 2))
(- sh (* i 2)))))
#t #t))
(define (draw-eyes inset) (define (draw-eyes inset)
;; Draw eyes ;; Draw eyes
@ -290,6 +303,7 @@
[(large) (large-smile frown?)] [(large) (large-smile frown?)]
[(huge) (largest-smile frown?)] [(huge) (largest-smile frown?)]
[(grimace) (medium-grimace frown?)] [(grimace) (medium-grimace frown?)]
[(oh) (oh)]
[(tongue) (plain-smile frown? #t)]) [(tongue) (plain-smile frown? #t)])
(send dc set-brush old-brush) (send dc set-brush old-brush)
@ -323,4 +337,6 @@
(face* 'angry 'grimace #t face-color 0)] (face* 'angry 'grimace #t face-color 0)]
[(mean) [(mean)
(face* 'angry 'narrow #f face-color 0)] (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 (error 'face "unknown mood: ~e" mood)]))))