;;; File:
;;;   hw11.scm
;;; Authors:
;;;   Samuel A. Rebelsky
;;;   Various members of CSC151.01 2006F (see below)
;;; Summary:
;;;   Some of the interesting solutions to HW11, collected and
;;;   modified slightly by SamR.
;;; Procedures:
;;;   house
;;;   flower1
;;;   flower2
;;;   baby-face
;;;   stick-man

;;; Procedure:
;;;   house
;;; Authors:
;;;   Christy Cloninger and Maggie Potthoff
(define house 
  (lambda (val1 val2 val3) 
    (let* ((image (create-image 256 256)) 
           (house-colors 
            (list COOL_COPPER CORAL OREGON_SALMON MUSTARD NECTARINE NEON_AVOCADO SPICY_PINK WHEAT VERY_DARK_BROWN YELLOW))
           (house-color (list-ref house-colors val2))
           
           (sun-brushes 
            (list "Circle (07)" "Manju's Flower" "Nova" "ripped hole" "Sparks"))
           
           (door 
            (lambda (image) 
              (set-fgcolor BAKERS_CHOCOLATE) 
              (set-brush "square (10x10) blur") 
              (select-rectangle image REPLACE 130 200 45 56) 
              (stroke image) 
              (fill-fgcolor image) 
              (select-nothing image)))
           
           (window 
            (lambda (image) 
              (set-fgcolor WHITE) 
              (set-brush "square (10x10) blur") 
              (select-rectangle image REPLACE 120 130 20 20) 
              (stroke image) 
              (fill-fgcolor image) 
              (select-nothing image))))
      (set-bgcolor SKY_BLUE) 
      (set-fgcolor BLACK) 
      (set-brush "Circle (07)") 
      (select-rectangle image REPLACE 100 100 100 156) 
      (stroke image) 
      (set-fgcolor house-color) 
      (fill-fgcolor image) 
      (select-nothing image) 
      (set-fgcolor BLACK) 
      (set-brush "Circle (07)") 
      (line image 100 100 150 0) 
      (line image 150 0 200 100) 
      (line image 200 100 100 100) 
      (if (< val3 5) 
          (door image) 
          (window image)) 
      (set-fgcolor GREEN) 
      (set-brush "Circle Fuzzy (05)") 
      (select-ellipse image REPLACE (* 25 val1) 220 36 36) 
      (stroke image) 
      (fill-fgcolor image) 
      (select-nothing image) 
      (set-fgcolor YELLOW) 
      (set-brush (list-ref sun-brushes (modulo val3 5))) 
      (select-ellipse image REPLACE 25 25 30 30) 
      (stroke image) 
      (fill-fgcolor image) 
      (select-nothing image) 
      (set-fgcolor WHITE) 
      (set-brush "square (10x10) blur") 
      (select-rectangle image REPLACE 160 160 20 20) 
      (stroke image) 
      (fill-fgcolor image) 
      (select-nothing image) 
      (show-image image))))

;;; Procedure:
;;;   flower1
;;; Author:
;;;   Kyung Eun An
(define flower1
  (lambda (val1 val2 val3) 
    (set-bgcolor WHITE) 
    (let* ((image (create-image 256 256))
           (flowercolors 
            (list LAVENDER INDIGO NEON_PINK NEON_BLUE PERIWINKLE 
                  DUSTY_ROSE FUCHSIA BLOOD_ORANGE DARK_TURQUOISE FELDSPAR))
           (petalcolors 
            (list BLUE GREEN COPPER GREY BROWN 
                  DIM_GREY STEEL_BLUE PALE_BLUE DARK_BROWN VERY_DARK_BROWN)) 
           (brushes 
            (list "Calligraphic Brush" "Circle (03)" "Circle (05)" 
                  "Circle Fuzzy (03)" "Sparks" "Pencil Sketch" "Felt Pen" 
                  "Galaxy, Small (AP)" "Confetti" "Vine"))
           (petalcolor (list-ref petalcolors val1))
           (brush (list-ref brushes val2))
           (flowercolor (list-ref flowercolors val3)))
      
      ; Draw the stem 
      (set-fgcolor GREEN) 
      (set-brush brush) 
      (line image 120 120 120 240) 
      
      ; Draw one of the petals1 
      (select-nothing image) 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 135 40 40 40) 
      (fill-fgcolor image) 
      
      ; Draw one of the petals2 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 100 22 40 40) 
      (fill-fgcolor image) 
      
      ; Draw one of the petals3 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 67 40 40 40) 
      (fill-fgcolor image) 
      
      ; Draw one of the petals4 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 67 80 40 40) 
      (fill-fgcolor image) 
      
      ; Draw one of the petals5 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 132 78 40 40) 
      (fill-fgcolor image) 
      
      ; Draw one of the petals6 
      (set-fgcolor petalcolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 100 95 40 40) 
      (fill-fgcolor image) 
      
      ; Draw the main flower 
      (set-fgcolor flowercolor) 
      (set-brush brush) 
      (select-ellipse image REPLACE 80 40 80 80) 
      (fill-fgcolor image) 
      
      ; Draw another leaf 
      (set-fgcolor DARK_GREEN) 
      (set-brush "Circle (05)") 
      ; (select-ellipse image REPLACE 128 190 90 30) 
      (select-ellipse image REPLACE 120 120 90 90) 
      (select-ellipse image INTERSECT 75 75 90 90) 
      (fill-fgcolor image) 
      
      ; Draw another leaf 
      (set-fgcolor DARK_GREEN) 
      (set-brush "Circle (05)") 
      ; (select-ellipse image REPLACE 128 190 90 30) 
      (select-ellipse image REPLACE 40 160 80 80) 
      (select-ellipse image INTERSECT 75 120 80 80) 
      (fill-fgcolor image) 
      
      (select-nothing image) 
      (show-image image) 
      image)))

;;; Procedure:
;;;   flower2
;;; Authors:
;;;   Alexi Brooks and Patrick Rich
;;; Drawing a flower
;;; Parameters: Three random numbers generated by (random 10)
; Some notes:
; #1:  Defines brush type and the "handedness" of the flower 
; #2:  Defines the position of petals on the flower and the type of background 
;        One of the options creates a flower with no petals. 
; #3:  Defines the colors of the flower
; Color sets (Stem, Heart, Petals): 
;  Black Black Black 
;  Green Black Yellow 
;  Green Yellow Black 
;  Green Red Red 
;  Green Red Purple 
;  Green Gray Pink 
;  Brown Yellow Black 
;  Brown Green Brown 
;  Gray Olive Green 
;  Purple Purple Purple

(define flower2
  (lambda (num1 num2 num3) 
    (let* ((image (create-image 200 200))
           (brushes (list "Circle (05)" "Circle (11)" "Circle Fuzzy (05)" 
                          "Circle Fuzzy (11)" "Calligraphic Brush#1"))
           (pattern0 ; 4 petal UDLR
            (lambda (position color-set) 
              (select-ellipse image REPLACE (+ 50 (* 50 position)) 25 50 50) 
              (select-ellipse image ADD (+ 50 (* 50 position)) 75 50 50) 
              (select-ellipse image ADD (+ 25 (* 50 position)) 50 50 50) 
              (select-ellipse image ADD (+ 75 (* 50 position)) 50 50 50) 
              (set-fgcolor (caddr color-set)) 
              (stroke image)
              (fill-fgcolor image)))
           (pattern1  ; 4 petal diagonal
            (lambda (position color-set) 
              (select-ellipse image REPLACE (+ 25 (* 50 position)) 25 50 50) 
              (select-ellipse image ADD (+ 75 (* 50 position)) 25 50 50) 
              (select-ellipse image ADD (+ 25 (* 50 position)) 75 50 50) 
              (select-ellipse image ADD (+ 75 (* 50 position)) 75 50 50) 
              (set-fgcolor (caddr color-set)) 
              (stroke image) 
              (fill-fgcolor image)))
           (bg1  ; sun background
            (lambda (position) 
              (set-fgcolor YELLOW) 
              (select-ellipse image REPLACE (- 150 (* 140 position)) 10 40 40) 
              (fill-fgcolor image)))
           (bg2  ; sun and sky background
            (lambda (position color-set) 
              ; because the stem is generally drawn first, bg2 needs to redraw it 
              ; (since it over-writes the first one) 
              ; we realize that this is not the best way of solving this problem, but 
              ; it was efficient in terms of writing effort (if not in terms of code length) 
              (set-bgcolor PALE_BLUE) 
              (set-fgcolor YELLOW) 
              (select-all image) 
              (fill-bgcolor image) 
              (select-ellipse image REPLACE (- 150 (* 140 position)) 10 40 40) 
              (fill-fgcolor image) 
              (if (< position 1) 
                  (begin (select-ellipse image REPLACE 50 100 50 100) 
                         (select-ellipse image SUBTRACT 50 100 49 100)) 
                  (begin (select-ellipse image REPLACE 100 100 50 100) 
                         (select-ellipse image SUBTRACT 101 100 49 100))) 
              (set-fgcolor (car color-set)) 
              (stroke image)))
           (something  ; smiley sun
            (lambda (position color-set) 
              (bg2 position color-set) 
              (select-all image) 
              (set-brush "Circle (05)") 
              (set-fgcolor BLACK) 
              (line image (- 160 (* 140 position)) 20 (- 160 (* 140 position)) 20) 
              (line image (- 180 (* 140 position)) 20 (- 180 (* 140 position)) 20) 
              (select-ellipse image REPLACE (- 155 (* 140 position)) 30 30 15) 
              (select-ellipse image SUBTRACT (- 155 (* 140 position)) 20 30 20) 
              (fill-fgcolor image)))
           (position (modulo num1 2)) 
           (stem-color (cond 
                         ((< num3 1) BLACK) 
                         ((< num3 6) GREEN) 
                         ((< num3 8) BROWN) 
                         ((< num3 9) (list 100 100 100)) 
                         (else PURPLE)))
           (heart-color (cond 
                          ((< num3 1) WHITE) 
                          ((< num3 2) BLACK) 
                          ((< num3 3) YELLOW) 
                          ((< num3 5) RED) 
                          ((< num3 6) (list 100 100 100)) 
                          ((< num3 7) YELLOW) 
                          ((< num3 8) GREEN) 
                          ((< num3 9) PALE_GREEN) 
                          (else PURPLE)))
           (petal-color (cond 
                          ((< num3 1) BLACK) 
                          ((< num3 2) YELLOW) 
                          ((< num3 3) BLACK) 
                          ((< num3 4) RED) 
                          ((< num3 5) PURPLE) 
                          ((< num3 6) (list 255 80 120)) 
                          ((< num3 7) BLACK) 
                          ((< num3 8) BROWN) 
                          ((< num3 9) GREEN) 
                          (else PURPLE)))
           (color-set (list stem-color heart-color petal-color)))
      (set-bgcolor WHITE) 
      (select-all image) 
      (fill-bgcolor image) 
      (set-brush (list-ref brushes (modulo num1 5))) 
      
      ; making the stem 
      (if (< position 1) 
          (begin (select-ellipse image REPLACE 50 100 50 100) 
                 (select-ellipse image SUBTRACT 50 100 49 100)) 
          (begin (select-ellipse image REPLACE 100 100 50 100) 
                 (select-ellipse image SUBTRACT 101 100 49 100))) 
      (set-fgcolor (car color-set)) 
      (stroke image) 
      
      ; Making the Petals 
      (cond 
        ((< num2 1) (pattern0 position color-set)) 
        ((< num2 2) (pattern1 position color-set)) 
        ((< num2 3)) 
        ((< num2 4) (begin (bg1 position) (pattern0 position color-set))) 
        ((< num2 5) (begin (bg1 position) (pattern1 position color-set))) 
        ((< num2 6) (begin (bg1 position))) 
        ((< num2 7) (begin (bg2 position color-set) 
                           (pattern0 position color-set))) 
        ((< num2 8) (begin (bg2 position color-set) 
                           (pattern1 position color-set))) 
        ((< num2 9) (begin (bg2 position color-set))) 
        (else (begin (something position color-set) 
                     (set-brush (list-ref brushes (modulo num1 5))) 
                     (pattern1 position color-set)))) 
      
      ; making the heart 
      (select-ellipse image REPLACE (+ 50 (* 50 position)) 50 50 50) 
      (set-fgcolor (cadr color-set)) 
      (fill-fgcolor image) 
      (select-nothing image) 
      
      (show-image image))))

;;; Procedure:
;;;   baby-face
;;; Author:
;;;   Tamar Harrington
(define baby-face 
  (lambda (val1 val2 val3) 
    (let ((image (create-image 268 256))) 
      (set-bgcolor WHITE) 
      (set-fgcolor BLACK) 
      (set-brush "Circle (03)") 
      (select-ellipse image REPLACE 8 8  (+ val1 240) (+ val2 240)) 
      (stroke image) 
      (set-bgcolor (list-ref (list BAKERS_CHOCOLATE BRONZE BROWN DARK_BROWN DARK_TAN GOLDENROD SIENNA FELDSPAR LIGHT_WOOD GREY) val3))
      (fill-bgcolor image) 
      (select-nothing image) 
      (select-ellipse image REPLACE 328 178 (- 30 val1) (- 80 val2)) 
      (select-ellipse image REPLACE 88 178 80 50) 
      (select-ellipse image SUBTRACT 88 178 80 (+ 30 val1)) 
      (stroke image) 
      (set-bgcolor WHITE) 
      (fill-bgcolor image) 
      (select-nothing image) 
      (select-ellipse image REPLACE 153 53 32 25) 
      (stroke image) 
      (fill-bgcolor image) 
      (select-nothing image) 
      (select-ellipse image REPLACE 71 53 32 25) 
      (stroke image) 
      (fill-bgcolor image) 
      (select-nothing image) 
      (set-brush "Circle (19)") 
      (set-fgcolor (list-ref (list BAKERS_CHOCOLATE DARK_WOOD BROWN VERY_DARK_BROWN BAKERS_CHOCOLATE DARK_WOOD BROWN VERY_DARK_BROWN CADET_BLUE COBALT_BLUE CORN_FLOWER_BLUE AQUAMARINE DARK_GREEN DARK_FOREST_GREEN DARK_SLATE_GREY DARK_OLIVE_GREEN ALGAE_GREEN) (modulo val1 10)))
      
      (set-brush "Circle (19)") 
      (line image 87 65 87 65) 
      (line image 169 65 169 65) 
      (set-brush "Circle (09)") 
      (set-fgcolor BLACK) 
      (line image 87 65 87 65) 
      (line image 169 65 169 65) 
      
      (set-brush "Circle (01)") 
      (set-fgcolor BLACK) 
      (select-ellipse image REPLACE 110 130 25 8) 
      (stroke image) 
      (select-ellipse image REPLACE 106 130 8 8) 
      (stroke image) 
      (select-ellipse image REPLACE 131 130 8 8) 
      (stroke image) 
      (select-nothing image) 
      (set-fgcolor (list-ref (list BAKERS_CHOCOLATE BRONZE BROWN DARK_BROWN DARK_TAN GOLDENROD SIENNA FELDSPAR LIGHT_WOOD) (modulo val2 9)))
      
      (set-brush "Circle (03)") 
      (line image 110 134 135 134) 
      (line image 110 131 135 131) 
      (show-image image))))

;;; Procedure:
;;;   stick-man
;;; Author: 
;;;   Rico Howard

;;; Procedure:
;;;   stick-man
;;; Parameters:
;;;   none
;;; Purpose:
;;;   Creates a new image with the stick figure.
;;; Produces:
;;;   Nothing. You call this only for the side effect of
;;;   drawing a new image.
;;; Preconditions:
;;;   Must be called from within Script-Fu.
;;;   val1, val2 must be between 0 and 9
;;; Postconditions:
;;;   A new image appears on the screen based upon val 1 parameter.
(define stick-man
  (lambda (width height val1 val2 val3)
    ; Draw everything on white
    (set-bgcolor WHITE)
    (let ((stick (create-image width height))
          (colors (list GOLD FELDSPAR DEEP_MIDNIGHT_BLUE DARK_GREEN_COPPER CYAN
                        CERULEAN PERIWINKLE RED BLACK GREEN))
          (brushes (list "animated Confetti" "Nova" "Circle Fuzzy (03)" 
                         "Calligraphic Brush#3" "Guitar" "cone 50x50"
                         "Calligraphic Brush" "Sparks" "qbert" "Circle (17)")))
      ; Set color or stick-man to say..some preset color
      (set-fgcolor (list-ref colors val1))
      ; Set brush type some preset brush
      (set-brush (list-ref brushes val2))
      ; Draw head of stick man
      (select-ellipse stick REPLACE (/ width 3) 0 (/ width 3) (/ height 3))
      (stroke stick)
      (select-nothing stick)
      ; Draw body of stick man
      (line stick (/ width 2) (/ height 3)
            (/ width 2) (* height (/ 2 3)))
      ; Draw right leg of stick man
      (line stick (/ width 2) (* height (/ 2 3))
            (- (* width (/ 3 4)) (* val3 10)) height)
      ; Draw left leg of stick man
      (line stick (/ width 2) (* height (/ 2 3))
            (* width (/ 1 4)) height)        
      ; Draw right arm of stick man
      (line stick (/ width 2) (* height .4)
            (* width (/ 5 6))
            (- (/ height 3) (* val3 3)))
      ; Draw left arm of stick man
      (line stick (/ width 2) (* height .4)
            (* width (/ 1 6))
            (+ (/ height 3) (* val3 8)))
      ; Now bring that stick to life!!
      (show-image stick))))