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%
(label "Eye Inset")
(parent custom-left-panel)
(min-value 0)
(min-value -10)
(max-value 10)
(init-value 0)
(callback (lambda (s e)
(set! face-eye-inset (send s get-value))
(new-face-callback))))

32
collects/texpict/face.ss
View File

@ -40,6 +40,7 @@
in-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-dark-edge-color (scale-color #e0.6 face-color))
(define face-hard-edge-color (scale-color #e0.8 face-edge-color))
(let ([w 300]
[h 300])
@ -270,19 +271,24 @@
flip? 0))
(define (oh)
(series dc
(if mouth-shading? 5 0)
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))
(let ([do-draw
(λ (i)
(let ([sw (* w 7/20)]
[sh (* h 8/20)])
(send dc draw-ellipse
(+ x i (/ (- w sw) 2))
(+ y (* i .75) (* h 1/4) (* h -1/16) (/ (- h sh) 2))
(- sw (* i 2))
(- sh (* i 2)))))])
(series dc
(if mouth-shading? 5 0)
face-color
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)
;; Draw eyes