;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-reader.ss" "lang")((modname entry3_non_contest) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp")))))
(start 240 240)
;;robot construction
(define-struct part (upper-left-corner width height color))
(define arm1 (make-part (make-posn 42 130) 115 15 'gray))
(define arm2 (make-part (make-posn 142 112) 15 30 'gray))
(define head (make-part (make-posn 30 30) 60 60 'gray))
(define left-eye (make-part (make-posn 72 57) 9 9 'black))
(define right-eye (make-part (make-posn 42 57) 9 9 'black))
(define neck (make-part (make-posn 51 90) 19 20 'gray))
(define torso (make-part (make-posn 20 110) 80 60 'gray))
(define right-leg (make-part (make-posn 37 170) 15 130 'gray))
(define left-leg (make-part (make-posn 70 170) 15 130 'gray))
(define-struct mouth (begin end color))
(define straight-mouth (make-mouth (make-posn 45 75) (make-posn 75 75) 'black))
(define slight-smile (make-mouth (make-posn 45 75) (make-posn 45 72) 'black))
(define frown (make-mouth (make-posn 45 75) (make-posn 45 78) 'black))
(define (draw-robot-head head left-eye right-eye straight-mouth)
  (and
   (draw-solid-rect
    (part-upper-left-corner head)
    (part-width head)
    (part-height head)
    (part-color head))
   (draw-solid-rect
    (part-upper-left-corner left-eye)
    (part-width left-eye)
    (part-height left-eye)
    (part-color left-eye))
   (draw-solid-rect
    (part-upper-left-corner right-eye)
    (part-width right-eye)
    (part-height right-eye)
    (part-color right-eye))
   (draw-solid-line
    (mouth-begin straight-mouth)
    (mouth-end straight-mouth)
    (mouth-color straight-mouth))))
(define (draw-robot-body neck torso left-leg right-leg)
  (and
   (draw-solid-rect
    (part-upper-left-corner neck)
    (part-width neck)
    (part-height neck)
    (part-color neck))
   (draw-solid-rect
    (part-upper-left-corner torso)
    (part-width torso)
    (part-height torso)
    (part-color torso))
   (draw-solid-rect
    (part-upper-left-corner left-leg)
    (part-width left-leg)
    (part-height left-leg)
    (part-color left-leg))
   (draw-solid-rect
    (part-upper-left-corner right-leg)
    (part-width right-leg)
    (part-height right-leg)
    (part-color right-leg))))
(define (draw-robot-arm arm1 arm2)
  (and
   (draw-solid-rect
    (part-upper-left-corner arm1)
    (part-width arm1)
    (part-height arm1)
    (part-color arm1))
   (draw-solid-rect
    (part-upper-left-corner arm2)
    (part-width arm2)
    (part-height arm2)
    (part-color arm2))))
(define (draw-robot head left-eye right-eye straight-mouth slight-smile neck torso left-leg right-leg arm1 arm2)
  (and
   (draw-robot-head head left-eye right-eye straight-mouth)
   (draw-robot-body neck torso left-leg right-leg)
   (draw-robot-arm arm1 arm2)))
(draw-robot head left-eye right-eye straight-mouth straight-mouth neck torso left-leg right-leg arm1 arm2)
;;flower construction defintions
(define-struct petal (center radius color))
(define-struct stem (begin end color))
(define stamen (make-petal (make-posn 148 57) 7 'yellow))
(define a-petal (make-petal (make-posn 148 46) 4 'purple))
(define b-petal (make-petal (make-posn 148 68) 4 'purple))
(define c-petal (make-petal (make-posn 159 57) 4 'purple))
(define d-petal (make-petal (make-posn 137 57) 4 'purple))
(define e-petal (make-petal (make-posn 140 49) 4 'purple))
(define f-petal (make-petal (make-posn 156 49) 4 'purple))
(define g-petal (make-petal (make-posn 140 65) 4 'purple))
(define h-petal (make-petal (make-posn 156 65) 4 'purple))
(define leaf-1 (make-petal (make-posn 152 85) 4 'green))
(define leaf-2 (make-petal (make-posn 144 85) 4 'green))
(define a-stem (make-stem (make-posn 148 64) (make-posn 148 112) 'green))
(define tear (make-petal (make-posn 42 66) 3 'blue))

(define (draw-petal petal)
  (draw-solid-disk (petal-center petal)
                   (petal-radius petal)
                   (petal-color petal)))
(define (draw-stem stem leaf-1 leaf-2)
  (and 
   (draw-solid-line
    (stem-begin stem)
    (stem-end stem)
    (stem-color stem))
   (draw-petal leaf-1)
   (draw-petal leaf-2)))

(define flower
  (and
   (draw-petal stamen)
   (draw-stem a-stem leaf-1 leaf-2)
   (draw-petal a-petal)
   (draw-petal b-petal)
   (draw-petal c-petal)
   (draw-petal d-petal)
   (draw-petal e-petal)
   (draw-petal f-petal)
   (draw-petal g-petal)
   (draw-petal h-petal)))
   
;;petal translation - petal falling
(define (clear-petal petal)
  (clear-solid-disk 
   (petal-center petal)
   (petal-radius petal)
   (petal-color petal)))
(define (translated-fall petal delta power)
  (draw-solid-disk
   (make-posn
    (posn-x (petal-center petal))
    (+ (posn-y (petal-center petal)) (* delta power)))
   (petal-radius petal)
   (petal-color petal)))
(define (clear-falling-petal petal delta power)
  (clear-solid-disk
   (make-posn
    (posn-x (petal-center petal))
    (+ (posn-y (petal-center petal)) (* delta power)))
   (petal-radius petal)
   (petal-color petal)))
(define (falling-petal petal delta power s)
  (and
   (translated-fall petal delta power)
   (sleep-for-a-while s)
   (clear-falling-petal petal delta power)))

;;a-petal descent
(define a-petal-descent
  (and
   (falling-petal a-petal 12 0 .25)
   (draw-solid-line
     (mouth-begin slight-smile)
     (mouth-end slight-smile)
     (mouth-color slight-smile))
   (falling-petal a-petal 12 1 .25)
   (draw-petal stamen)
   (falling-petal a-petal 12 2 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (draw-petal b-petal)
   (falling-petal a-petal 12 3 .25)
   (draw-petal b-petal)
   (draw-stem a-stem leaf-1 leaf-2)
   (draw-petal b-petal)
   (falling-petal a-petal 12 4 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (draw-petal b-petal)
   (falling-petal a-petal 12 6 .25)   
   (draw-robot-arm arm1 arm2)
   (falling-petal a-petal 12 7 .25) 
   (draw-robot-arm arm1 arm2)
   (falling-petal a-petal 12 8 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal a-petal 12 9 .25)
   (falling-petal a-petal 12 10 .25)
   (falling-petal a-petal 12 11 .25)
   (falling-petal a-petal 12 12 .25)
   (falling-petal a-petal 12 13 .25)
   (falling-petal a-petal 12 14 .25)
   (falling-petal a-petal 12 15 .25)
   (falling-petal a-petal 12 16 .25)
   (draw-solid-rect (make-posn 144 238) 8 2 'purple)))
;;b-petal descent
(define b-petal-descent
  (and
   (falling-petal b-petal 12 0 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (clear-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'gray)
   (falling-petal b-petal 12 1 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal b-petal 12 2 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal b-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal b-petal 12 4 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal b-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal b-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal b-petal 12 7 .25)
   (falling-petal b-petal 12 8 .25)
   (falling-petal b-petal 12 9 .25)
   (falling-petal b-petal 12 10 .25)
   (falling-petal b-petal 12 11 .25)
   (falling-petal b-petal 12 12 .25)
   (falling-petal b-petal 12 13 .25)
   (falling-petal b-petal 12 14 .25)
   (draw-solid-rect (make-posn 144 238) 8 2 'purple)))
;;c-petal descent
(define c-petal-descent
  (and
   (falling-petal c-petal 12 0 .25)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (falling-petal c-petal 12 1 .25)
   (draw-petal h-petal)
   (falling-petal c-petal 12 2 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal c-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal c-petal 12 4 .25)
   (falling-petal c-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal c-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal c-petal 12 7 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal c-petal 12 8 .25)
   (falling-petal c-petal 12 9 .25)
   (falling-petal c-petal 12 10 .25)
   (falling-petal c-petal 12 11 .25)
   (falling-petal c-petal 12 12 .25)
   (falling-petal c-petal 12 13 .25)
   (falling-petal c-petal 12 14 .25)
   (falling-petal c-petal 12 15 .25)
   (draw-solid-rect (make-posn 155 238) 8 2 'purple)))
;;d-petal descent
(define d-petal-descent
  (and
   (falling-petal d-petal 12 0 .25)
   (clear-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'gray)
   (falling-petal d-petal 12 1 .25)
   (draw-petal g-petal)
   (falling-petal d-petal 12 2 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal d-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal d-petal 12 4 .25)
   (falling-petal d-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal d-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal d-petal 12 7 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal d-petal 12 8 .25)
   (falling-petal d-petal 12 9 .25)
   (falling-petal d-petal 12 10 .25)
   (falling-petal d-petal 12 11 .25)
   (falling-petal d-petal 12 12 .25)
   (falling-petal d-petal 12 13 .25)
   (falling-petal d-petal 12 14 .25)
   (falling-petal d-petal 12 15 .25)
   (draw-solid-rect (make-posn 133 238) 8 2 'purple)))
;;e-petal descent
(define e-petal-descent
  (and
   (falling-petal e-petal 12 0 .25)
   (draw-petal stamen)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (falling-petal e-petal 12 1 .25)
   (draw-petal stamen)
   (draw-petal g-petal)
   (falling-petal e-petal 12 2 .25)
   (draw-petal g-petal)
   (falling-petal e-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal e-petal 12 4 .25)
   (falling-petal e-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal e-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal e-petal 12 7 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal e-petal 12 8 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal e-petal 12 9 .25)
   (falling-petal e-petal 12 10 .25)
   (falling-petal e-petal 12 11 .25)
   (falling-petal e-petal 12 12 .25)
   (falling-petal e-petal 12 13 .25)
   (falling-petal e-petal 12 14 .25)
   (falling-petal e-petal 12 15 .25)))
;;f-petal descent
(define f-petal-descent
  (and
   (falling-petal f-petal 12 0 .25)
   (draw-petal stamen)
   (clear-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'gray)
   (falling-petal f-petal 12 1 .25)
   (draw-petal stamen)
   (draw-petal h-petal)
   (falling-petal f-petal 12 2 .25)
   (draw-petal h-petal)
   (falling-petal f-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal f-petal 12 4 .25)
   (falling-petal f-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal f-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal f-petal 12 7 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal f-petal 12 8 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal f-petal 12 9 .25)
   (falling-petal f-petal 12 10 .25)
   (falling-petal f-petal 12 11 .25)
   (falling-petal f-petal 12 12 .25)
   (falling-petal f-petal 12 13 .25)
   (falling-petal f-petal 12 14 .25)
   (falling-petal f-petal 12 15 .25)))
;;g-petal descent
(define g-petal-descent
  (and
   (falling-petal g-petal 12 0 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (falling-petal g-petal 12 1 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal g-petal 12 2 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal g-petal 12 3 .25)
   (draw-stem a-stem leaf-1 leaf-2)
   (falling-petal g-petal 12 4 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal g-petal 12 5 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal g-petal 12 6 .25)
   (draw-robot-arm arm1 arm2)
   (falling-petal g-petal 12 7 .25)
   (falling-petal g-petal 12 8 .25)
   (falling-petal g-petal 12 9 .25)
   (falling-petal g-petal 12 10 .25)
   (falling-petal g-petal 12 11 .25)
   (falling-petal g-petal 12 12 .25)
   (falling-petal g-petal 12 13 .25)
   (falling-petal g-petal 12 14 .25)
   (clear-solid-line (make-posn 45 75) (make-posn 45 72) 'black)
   (draw-solid-line (make-posn 45 75) (make-posn 45 72) 'gray)
   (draw-solid-line (make-posn 45 75) (make-posn 45 78) 'black)))
;;falling tear
(define crying
  (and
   (falling-petal tear 12 0 .25)
   (draw-robot-head head left-eye right-eye straight-mouth)
   (draw-solid-line
    (mouth-begin frown)
    (mouth-end frown)
    (mouth-color frown))
   (falling-petal tear 12 1 .25)
   (draw-robot-head head left-eye right-eye straight-mouth)
   (draw-solid-line
    (mouth-begin frown)
    (mouth-end frown)
    (mouth-color frown))
   (falling-petal tear 12 2 .25)
   (draw-robot-head head left-eye right-eye straight-mouth)
   (draw-solid-line
    (mouth-begin frown)
    (mouth-end frown)
    (mouth-color frown))
   (falling-petal tear 12 3 .25)
   (falling-petal tear 12 4 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 5 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 6 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 7 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 8 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 9 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 10 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 11 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 12 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 13 .25)
   (draw-robot-body neck torso left-leg right-leg)
   (falling-petal tear 12 14 .25)
   (draw-robot-body neck torso left-leg right-leg)))