;;; File:
;;;   face.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;;   Jennifer Karam, Yvonne Palm, Sarah Fullmer
;;;   and Dave Wylie
;;; Summary:
;;;   A simple example of parameterized face drawing
;;; Version:
;;;   1.0 of April 2003
;;; Procedures:
;;;   (face alpha beta gamma)
;;;     Draw a parameterized face.  The higher alpha, beta, and
;;;     gamma are (limit of 100), the more stressed the face seems.
;;;   (numeric-face num)
;;;     Draw a simpler parameterized face.  Once again, higher numbers
;;;     should look more stressed.  0 <= num <= 10000.
;;;   (saveface num)
;;;     Creates the given face and saves to a file.
;;;   (showface num)
;;;     Creates the given face and displays it.
;;; History:
;;;   At end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Libraries ;
;;;;;;;;;;;;;

(load "/home/rebelsky/Web/Glimmer/ScriptFu/Code/gsfu.scm")
; (load "randomcircles.ss")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Library Procedures ;
;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   face
;;; Parameters:
;;;   alpha, a number between 0 and 100, inclusive
;;;   beta, a number between 0 and 100, inclusive
;;;   gamma, a number between 0 and 100, inclusive
;;;   delta, a number between 0 and 100, inclusive
;;;   epsilon, a number between 0 and 100, inclusive
;;; Purpose:
;;;   Builds a new image containing a simple "smiley" face
;;; Produces:
;;;   image-layer, a two element list containing the id of the
;;;     image and layer
;;; Preconditions:
;;;   Types are met
;;; Postconditions:
;;;   image-layer contains ids of a new image and a layer on that
;;;     image
;;;   The given image contains a smiley face (or some approximation
;;;     thereof).
(define face
  (lambda (alpha beta gamma delta epsilon)
    (let* ((image-layer (gsfu-new-image 128 128))
           (image (car image-layer))
           (layer (cadr image-layer))
           (color-offset (* alpha 0.64))
           (halfwidth (- 64 (* beta 0.16))) ; More stressed - narrower
           (quarterwidth (/ halfwidth 2)) 
           (smileheight (- 64 (* gamma 0.63)))
           (background (* delta 5))
           (hair (* epsilon 0.2))
          )
      ; Faces move from yellow (happy) to grey (stressed)
      (gimp-palette-set-foreground (list (- 255 color-offset)
                                         (- 255 color-offset)
                                         (* 3 color-offset)))
      ;background color: color changes based on level of stress
      ;will vary between happy and stressed colors, however these
      ;colors have not yet been determined
      (gimp-palette-set-background (list (- 255 background)
                                         (* 3 background)
                                         (- 255 background)))
      ; Draw the oval for the face
      (gimp-ellipse-select image 
                           (- 64 halfwidth) 0          ; x y
                           (+ halfwidth halfwidth) 128 ; width height
                           REPLACE 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ; Draw the eyes
      (gimp-palette-set-foreground (list 0 0 128))
      (gimp-ellipse-select image
                           40 40
                           16 16
                           REPLACE 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-ellipse-select image
                           72 40
                           16 16
                           REPLACE 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ;Draw eyebrows: eyebrows become larger as the
      ;stress level increases
      (gimp-palette-set-foreground BLACK)
      (gimp-ellipse-select image
                           34 (- 35 (/ hair 2))
                           quarterwidth 35
                           REPLACE 0 0 0)
      (gimp-ellipse-select image
                           34 35
                           quarterwidth 35
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-ellipse-select image
                           64 (- 35 (/ hair 2))
                           quarterwidth 35
                           REPLACE 0 0 0)
      (gimp-ellipse-select image
                           64 35
                           quarterwidth 35
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ;Draw circles under the eyes
      (gimp-palette-set-foreground PURPLE)
      (gimp-ellipse-select image
                           34 (- 40 (/ hair 2))
                           quarterwidth 35
                           REPLACE  0 0 0)
      (gimp-ellipse-select image
                           34 27
                           quarterwidth 35
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-ellipse-select image
                           64 (- 40 (/ hair 2))
                           quarterwidth 35
                           REPLACE 0 0 0)
      (gimp-ellipse-select image
                           64 27
                           quarterwidth 35
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ; Draw a simple mouth
      (gimp-palette-set-foreground (list 255 0 0))
      (gimp-ellipse-select image
                           (- 64 quarterwidth) (- 100 smileheight)    ; x y
                           halfwidth smileheight ; width height
                           REPLACE 0 0 0)
      (gimp-ellipse-select image
                           (- 64 quarterwidth) (- 92 smileheight)     ; x y
                           halfwidth smileheight ; width height
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ;Draw hair: the smiley face has less hair as the stress level 
      ;increases
      (gimp-palette-set-foreground BLACK)
      (gimp-ellipse-select image
                           (- 64 halfwidth) 0                  ; x y
                           (+ halfwidth halfwidth) 40 ; width height
                           REPLACE 0 0 0)
      (gimp-ellipse-select image
                           (- 64 halfwidth) hair      ; x y
                           (+ halfwidth halfwidth) 128 ; width height
                           SUB 0 0 0)
      (gimp-edit-fill layer 0)
      (gimp-selection-none image)
      ;(random-circles image layer hair)
      ; Code to add smudge marks and a fly as the stress
      ; increases will also be added.
      ; Pimples will be added as the stress level increases.
      ; Return the list of image and layer
      ; (print image-layer)
      image-layer
      )))
;;; Procedure:
;;;   numeric-face
;;; Parameters:
;;;   num, the number of the face
;;; Parameters:
;;;   num, the number of the face
;;; Purpose:
;;;   Generates a new face and shows the face
;;; Produces:
;;;   image-layer, a list of the ids of image and layer
;;; Preconditions:
;;;   0 <= num <= 10000
;;; Postconditions:
;;;   image-layer contains ids of a new image and a layer on that
;;;     image
;;;   The given image contains a smiley face (or some approximation
;;;     thereof).
;;; Note:
;;;   We convert num to five numbers between 0 and 100 for calling
;;;   face.  The formulae for doing so are currently somewhat simplistic.
;;;   A good designer could come up with better ones.
(define numeric-face
  (lambda (num)
    (face (/ num 100)
          (mod num 100)
          (/ (mod num 501) 5)
          (/ num 100)
          (mod  num 100))))

;;; Procedure:
;;;   saveface
;;; Parameters:
;;;   num, the nmber of the face
;;; Purpose:
;;;   Generates a new face and saves the face in a file
;;; Produces:
;;;   image-layer, a list of the ids of image and layer
;;; Preconditions:
;;;   0 <= num <= 10000
;;; Postconditions:
;;;   image-layer contains ids of a new image and a layer on that
;;;     image
;;;   The current directory contains a file named face-####.png,
;;;     where #### is the value of num.
;;;   That file contains a smiley face of the appropriate form.
(define saveface
  (lambda (num)
    (let ((image-layer (numeric-face num)))
      (gsfu-save-png (string-append "face-" (number->string num) ".png")
                     (car image-layer)
                     (cadr image-layer)))))

;;; NEEDS DOCUMENTATION

;;; Procedure:
;;;   combinations
;;; Parameters:
;;;   options, a list of lists of strings
;;; Purpose:
;;;   Generate all reasonable combinations of the
;;;     strings, choosing one from each list and
;;;     joining them in order.
;;; Practica:
;;;   > (combinations (list (list "a" "b" "c") (list "" "a" "b")))
;;;   ???
(define combinations
  (lambda (options)
    ; Base case: Only one member list.  Just return that member list
    (if (null? (cdr options))
        (map list (car options))
        (let ((partial-combinations (combinations (cdr options)))
              (missing-options (car options)))
          (combinations-helper missing-options partial-combinations)))))

(define combinations-helper
  (lambda (missing-options partial-combinations)
    (if (null? missing-options)
        ()
        (append
         (map (lambda (lst) (cons (car missing-options) lst))
               partial-combinations)
         (combinations-helper (cdr missing-options) partial-combinations)))))

(define stress-face
  (lambda (s1 s2 s3 s4 s5 s6 s7)
    (face (* 1.33 (stressor->number s1))
          (/ (+ (stressor->number s2) (stressor->number s6)) 2)
          (/ (+ (stressor->number s3)
                (stressor->number s2)
                (stressor->number s7))
             3)
          (stressor->number s4)
          (- 100 (stressor->number s5)))))

(define stressor->number
  (lambda (stressor)
    (cond
      ((equal? stressor "a") 25)
      ((equal? stressor "b") 50)
      ((equal? stressor "c") 75)
      ((equal? stressor "d") 100)
      (#t 0))))

(define saveface2
  (lambda (stress1 stress2 stress3 stress4 stress5 stress6 stress7)
    (let ((image-layer (stress-face stress1 stress2 stress3 stress4
                                    stress5 stress6 stress7)))
      (gsfu-save-png (string-append "face-" stress1 stress2 stress3
                                    stress4 stress5 stress6 stress7
                                    ".png")
                     (car image-layer)
                     (cadr image-layer)))))

(define showface2
  (lambda (stress1 stress2 stress3 stress4 stress5 stress6 stress7)
    (let ((image-layer (stress-face stress1 stress2 stress3 stress4
                                    stress5 stress6 stress7)))
      (gimp-display-new (car image-layer))
      image-layer)))


;;; Procedure:
;;;   showface
;;; Parameters:
;;;   num, the number of the face
;;; Purpose:
;;;   Generates a new face and shows the face
;;; Produces:
;;;   image-layer, a list of the ids of image and layer
;;; Preconditions:
;;;   0 <= num <= 10000
;;; Postconditions:
;;;   image-layer contains ids of a new image and a layer on that
;;;     image
;;;   The given image contains a smiley face (or some approximation
(define showface
  (lambda (num)
    (let ((image-layer (numeric-face num)))
      (gimp-display-new (car image-layer))
      image-layer)))

; Note:
;  (apply saveface2 (list "b" "c" "d" "" "" "" ""))
; is just a funny way of saying
;  (saveface2 "b" "c" "d" "" "" "" "")

(define save-all-faces
  (lambda ()
    (map (lambda (stressors) (apply saveface2 stressors))
         (combinations (list (list "a" "b")
                             (list "a" "b" "")
                             (list "a" "b" "c" "")
                             (list "a" "b" "c" "d" "")
                             (list "")
                             (list "")
                             (list ""))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; History ;
;;;;;;;;;;;

;;; Tuesday, 15 April 2003 [Version 1.0]
;;;    Created.
;;; Wednesday, 16 April 2003
;;;    Face  and numeric-face changed to include a background color.
;;; Thursday, 17 April 2003
;;;    Face and numeric-face changed to include eyebrows and
;;;    hair. 
;;; Saturday, 19 April 2003
;;;    Dark circles under the eyes added.
;;; Thursday, 23 April 2003
;;;    Added the stress-face procedure and its friends.
;;;    Added the combinations procedure so that we can automatically
;;;      generate lots and lots of image files.