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

messed around with oh mouth

Browse Source 
svn: r2727
This commit is contained in:
Robby Findler 2006-04-20 17:32:42 +00:00
parent 00d7cf4966
commit 3ac9ac813c
2 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -99,8 +99,9 @@
(new slider% (new slider%
(label "Eye Inset") (label "Eye Inset")
(parent custom-left-panel) (parent custom-left-panel)
(min-value 0) (min-value -10)
(max-value 10) (max-value 10)
(init-value 0)
(callback (lambda (s e) (callback (lambda (s e)
(set! face-eye-inset (send s get-value)) (set! face-eye-inset (send s get-value))
(new-face-callback)))) (new-face-callback))))

32
collects/texpict/face.ss
View File

@ -40,6 +40,7 @@
in-face-color)) in-face-color))
(define face-bright-edge-color (scale-color #e1.6 face-color)) (define face-bright-edge-color (scale-color #e1.6 face-color))
(define face-edge-color (scale-color #e0.8 face-color)) (define face-edge-color (scale-color #e0.8 face-color))
(define face-dark-edge-color (scale-color #e0.6 face-color))
(define face-hard-edge-color (scale-color #e0.8 face-edge-color)) (define face-hard-edge-color (scale-color #e0.8 face-edge-color))
(let ([w 300] (let ([w 300]
[h 300]) [h 300])
@ -270,19 +271,24 @@
flip? 0)) flip? 0))
(define (oh) (define (oh)
(series dc (let ([do-draw
(if mouth-shading? 5 0) (λ (i)
face-edge-color (let ([sw (* w 7/20)]
(make-object color% "black") [sh (* h 8/20)])
(lambda (i) (send dc draw-ellipse
(let ([sw (* w 7/20)] (+ x i (/ (- w sw) 2))
[sh (* h 8/20)]) (+ y (* i .75) (* h 1/4) (* h -1/16) (/ (- h sh) 2))
(send dc draw-ellipse (- sw (* i 2))
(+ x i (/ (- w sw) 2)) (- sh (* i 2)))))])
(+ y i (* h 1/4) (* h -1/16) (/ (- h sh) 2)) (series dc
(- sw (* i 2)) (if mouth-shading? 5 0)
(- sh (* i 2))))) face-color
#t #t)) face-dark-edge-color
do-draw
#t #t)
(send dc set-brush (find-brush "black"))
(send dc set-pen no-pen)
(do-draw 9)))
(define (draw-eyes inset) (define (draw-eyes inset)
;; Draw eyes ;; Draw eyes