;;; File:
;;;   face.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   An experiment in parameterized face drawing.

(define face
  (lambda (val1 val2 val3)
    (set-fgcolor BLACK)
    (set-bgcolor WHITE)
    (let* (
          ; The center of the image is fixed
          (xcenter 50)
          (ycenter 50)
          ; The width and height of the face depend on val1
          (width (+ 70 (* 2 val1)))
          (height (- 90 (* 2 val1)))
          (qwidth (/ width 4)) ; One quarter of each
          (qheight (/ height 4))
          ; The eye color is a shade of blue that depends on val 2
          (eyecolor (list 32 32 (+ 32 (* val2 20))))
          ; The eyebrow will depend on val 3
          (brow-brush (list-ref (list "Circle Fuzzy (03)" "Circle Fuzzy (05)" "Circle Fuzzy (07)")
                                (trunc (/ val3 3.3))))
          (brow-delta (- val3 5))
          ; Eye width is fixed
          (eye-width 20)
          ; As is eye spacing
          (eye-spacing 5)
          ; The image is 100 x 100
          (img (create-image 100 100)))
      ; Draw the oval filled with yellow
      (set-brush "Circle (03)")
      (set-bgcolor YELLOW)
      (select-ellipse img REPLACE
                      (- xcenter (/ width 2)) (- ycenter (/ height 2))
                      width height)
      (fill-bgcolor img)
      (stroke img)
      ; Draw the eyes
      (set-brush "Circle (01)")
      (set-bgcolor eyecolor)
      (select-ellipse img REPLACE (- xcenter eye-spacing eye-width) (- ycenter qheight) eye-width 10)
      (select-ellipse img INTERSECT (- xcenter eye-spacing eye-width) (- ycenter qheight 2) eye-width 10)
      (fill-bgcolor img)
      (stroke img)
      (select-ellipse img REPLACE (+ xcenter eye-spacing) (- ycenter qheight) eye-width 10)
      (select-ellipse img INTERSECT (+ xcenter eye-spacing) (- ycenter qheight 2) eye-width 10)
      (fill-bgcolor img)
      (stroke img)
      ; Draw the brows
      (set-brush brow-brush)
      (select-nothing img)
      (line img (- xcenter eye-spacing eye-width)        (+ (- ycenter qheight 5) brow-delta)
                (+ 20 (- xcenter eye-spacing eye-width)) (- (- ycenter qheight 5) brow-delta))
      (line img (+ xcenter eye-spacing)        (- (- ycenter qheight 5) brow-delta)
                (+ 20 (+ xcenter eye-spacing)) (+ (- ycenter qheight 5) brow-delta))
      ; Draw the smile
      (set-brush "Circle (03)")
      (set-bgcolor WHITE)
      (cond
        ((< val2 2) 
         (select-ellipse img REPLACE (- xcenter qwidth) (+ ycenter 5) (/ width 2) 30)
         (select-ellipse img SUBTRACT (- xcenter qwidth) (- ycenter 5) (/ width 2) 30))
        ((< val2 4) 
         (select-ellipse img REPLACE (- xcenter qwidth) (+ ycenter 5) (/ width 2) 20)
         (select-ellipse img SUBTRACT (- xcenter qwidth) (+ ycenter 0) (/ width 2) 20))
        ((< val2 6)
         (select-ellipse img REPLACE (- xcenter qwidth) (+ xcenter 10) (/ width 2) 10))
        ((< val2 8) 
         (select-ellipse img REPLACE (- xcenter qwidth) (+ ycenter 15) (/ width 2) 20)
         (select-ellipse img SUBTRACT (- xcenter qwidth) (+ ycenter 20) (/ width 2) 20))
        (else 
         (select-ellipse img REPLACE (- xcenter qwidth) (+ ycenter 10) (/ width 2) 30)
         (select-ellipse img SUBTRACT (- xcenter qwidth) (+ ycenter 20) (/ width 2) 30)))
      (fill-bgcolor img)
      (stroke img)
      ; Clean up and show the image
      (select-nothing img)
      (show-image img))))

(define load-face
  (lambda ()
    (load "/home/rebelsky/Web/Courses/CS151/2006F/Examples/face.scm")))