;; The first three lines of this file were inserted by DrRacket. 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 entry4) (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")))))


; Lab 3 - Cartoon

; Define Structures:

(define-struct head (center radius color))
;; A head is a structure (make-head center radius color) where center is a posn structure, radius is a number and color is a symbol

(define-struct eye (center radius color))
;; An eye is a structure (make-eye center radius color) where center is a posn structure, radius is a number and color is a symbol

(define-struct mouth (start end color))
;; A mouth is a structure (make-mouth start end color) where start and end are posn structures and color is a symbol

(define-struct limb (start end color))
;; A limb is a structure (make-limb start end color) where start and end are posn structures and color is a symbol

(define-struct person (head eye1 eye2 mouth1 mouth2 body rightleg leftleg armdown armup))
;; A person is a structure (make-person head eye1 eye2 mouth1 mouth2 body rightleg leftleg armdown armup) where head is a head structure, eye1 and eye2 are eye structures, mouth1 and mouth2 are mouth structures and body, rightleg, leftleg, armdown, and armup are limb structures

(define-struct ball (center radius color))
;; A ball is a structure (make-ball center radius color) where center is a posn structure, radius is a number and color is a symbol



;Person Functions

; Draw person
;; Contract: draw-person: person -> true
;; Purpose: to draw a stick person with a head, 2 eyes, mouth, body, two legs and two arms given a person structure
(define (draw-person a-person)
  (and
   (draw-circle (head-center (person-head a-person))
                (head-radius (person-head a-person))
                (head-color (person-head a-person)))
   (draw-solid-disk (eye-center (person-eye1 a-person))
                    (eye-radius (person-eye1 a-person))
                    (eye-color (person-eye1 a-person)))
   (draw-solid-disk (eye-center (person-eye2 a-person))
                    (eye-radius (person-eye2 a-person))
                    (eye-color (person-eye2 a-person)))
   (draw-solid-line (mouth-start (person-mouth1 a-person))
                    (mouth-end (person-mouth1 a-person))
                    (mouth-color (person-mouth1 a-person)))
   (draw-solid-line (mouth-start (person-mouth2 a-person))
                    (mouth-end (person-mouth2 a-person))
                    (mouth-color (person-mouth2 a-person)))
   (draw-solid-line (limb-start (person-body a-person))
                    (limb-end (person-body a-person))
                    (limb-color (person-body a-person)))
   (draw-solid-line (limb-start (person-rightleg a-person))
                    (limb-end (person-rightleg a-person))
                    (limb-color (person-rightleg a-person)))
   (draw-solid-line (limb-start (person-leftleg a-person))
                    (limb-end (person-leftleg a-person))
                    (limb-color (person-leftleg a-person)))
   (draw-solid-line (limb-start (person-armdown a-person))
                    (limb-end (person-armdown a-person))
                    (limb-color (person-armdown a-person)))
   (draw-solid-line (limb-start (person-armup a-person))
                    (limb-end (person-armup a-person))
                    (limb-color (person-armup a-person)))
   ))


; Ball Functions

; Draw ball
;; Contract: draw-a-ball: ball -> true
;; Purpose: to draw a solid-disk from a ball structure
(define (draw-a-ball a-ball)
  (draw-solid-disk
   (ball-center a-ball)
   (ball-radius a-ball)
   (ball-color a-ball)
   ))

; Clear ball
;; Contract: clear-a-ball: ball -> true
;; Purpose: to clear a solid-disk created froma a given ball structure
(define (clear-a-ball a-ball)
  (clear-solid-disk
   (ball-center a-ball)
   (ball-radius a-ball)
   ))

; Draw and clear ball
;; Contract: draw-and-clear-ball: ball -> true
;; Purpose: to draw a solid disk, pause for a brief period, then clear the same solid disk, given a ball structure
(define (draw-and-clear-ball a-ball)
  (and (draw-a-ball a-ball)
       (sleep-for-a-while 1)
       (clear-a-ball a-ball)
       ))

; Create translated ball structure
;; Contract: translate-ball: ball integer -> ball
;; Purpose: from an existing structure, to create a new ball structure in which the position of the center is moved down a number of pixels 
(define (translate-ball a-ball pixels)
  (make-ball (make-posn
              (posn-x (ball-center a-ball)) (+ (posn-y (ball-center a-ball))       pixels))
             (ball-radius a-ball)
             (ball-color a-ball)
             ))

; Move ball
;; Contract: move-ball: ball integer -> true
;; Purpose: to draw and clear the original ball, then redraw the ball in a new location based on a translation
(define (move-ball a-ball pixels)
  (cond
    [(draw-and-clear-ball a-ball) (translate-ball a-ball pixels)]
    [else a-ball]
    ))

; Change ball color
;; Contract: change-color: ball symbol -> ball
;; Purpose: to replace the color of a ball structure with a new color given a ball structure and a new color
(define (change-color a-ball new-color)
  (make-ball (ball-center a-ball)
             (ball-radius a-ball)
             (cond
               [(symbol? (ball-color a-ball)) new-color]
             )))

; Cycle ball color
;; Contract: cycle-color: ball -> ball
;; Purpose: to change the color of a ball structure in a patterned order based on the current color of the ball, given a ball structure 
(define (cycle-color a-ball)
  (cond
    [(symbol=? (ball-color a-ball) 'red) (change-color a-ball 'orange)]
    [(symbol=? (ball-color a-ball) 'orange) (change-color a-ball 'yellow)]
    [(symbol=? (ball-color a-ball) 'yellow) (change-color a-ball 'green)]
    [(symbol=? (ball-color a-ball) 'green) (change-color a-ball 'blue)]
    [(symbol=? (ball-color a-ball) 'blue) (change-color a-ball 'purple)]
    ))

; Draw new ball color
;; Contract: draw-new-color: ball -> true
;; Purpose: to use the draw-and-clear function on a ball structure which has had the cycle-color function applied to it, given a ball structure
(define (draw-new-color a-ball)
  (draw-and-clear-ball (cycle-color a-ball)))




; Animation:

; Define head-structure for Bob
(define headBob
  (make-head
   (make-posn 200 150) 50 'black))
; Define eye-structure for Bob
(define eye1Bob
  (make-eye
   (make-posn 180 130) 10 'blue))
; Define eye-structure for Bob
(define eye2Bob
  (make-eye
   (make-posn 220 130) 10 'blue))
; Define mouth structure for Bob
(define mouth1Bob
  (make-mouth
   (make-posn 170 165) (make-posn 180 175) 'red))
; Define mouth structure for Bob
(define mouth2Bob
  (make-mouth
   (make-posn 180 175) (make-posn 195 175) 'red))
; Define limb structure for body for Bob
(define bodyBob
  (make-limb
   (make-posn 200 200) (make-posn 200 300) 'black))
; Define limb structure for leg for Bob
(define rightlegBob
  (make-limb
   (make-posn 165 325) (make-posn 200 300) 'black))
; Define limb structure for leg for Bob
(define leftlegBob
   (make-limb
    (make-posn 235 325) (make-posn 200 300) 'black))
; Define limb structure for arm for Bob
(define armdownBob
  (make-limb
   (make-posn 200 235) (make-posn 165 260) 'black))
; Define limb structure for arm for Bob
(define armupBob
  (make-limb
   (make-posn 200 235) (make-posn 240 215) 'black))

; Define person structure for Bob
(define Bob
  (make-person
   headBob
   eye1Bob
   eye2Bob
   mouth1Bob
   mouth2Bob
   bodyBob
   rightlegBob
   leftlegBob
   armdownBob
   armupBob
 ))

; Define ball structure for starting position of ball
(define ball-start
  (make-ball
   (make-posn 250 210)
   10
   'red))

; Draw canvas
(start 400 400)

; Draw string for title of cartoon
(draw-solid-string (make-posn 100 50) "The Magical Expanding Ball (featuring Bob)")

; Draw Bob
(draw-person Bob)

; Draw Red ball in starting position
(draw-a-ball ball-start)
; Red ball falls/change to orange ball
(draw-new-color (move-ball ball-start 110))
; Draw orange ball at top of bounce
(draw-new-color ball-start)
; Orange ball falls/change to yellow ball
(draw-new-color (move-ball (cycle-color ball-start) 110))
; Draw yellow ball at top of bounce
(draw-new-color (cycle-color ball-start))
; Yellow ball falls/change to green ball
(draw-new-color (move-ball (cycle-color (cycle-color ball-start)) 110))
; Draw green ball at top of bounce
(draw-new-color (cycle-color (cycle-color ball-start)))
; Green ball falls/change to blue ball
(draw-new-color (move-ball (cycle-color (cycle-color (cycle-color ball-start))) 110))
; Draw blue at top of bounce
(draw-new-color (cycle-color (cycle-color (cycle-color ball-start))))
; Blue ball falls/change to purple ball
(draw-new-color (move-ball (cycle-color (cycle-color (cycle-color (cycle-color ball-start)))) 110))

; 1st ball expansion
(draw-solid-disk (make-posn 250 320) 70 'purple)
(sleep-for-a-while 2)
; 2nd ball expansion
(draw-solid-disk (make-posn 250 320) 150 'orange)
(sleep-for-a-while 2)
; 3rd ball expansion
(draw-solid-disk (make-posn 250 320) 230 'green)
(sleep-for-a-while 2)
; 4th ball expansion
(draw-solid-disk (make-posn 250 320) 310 'blue)
(sleep-for-a-while 2)
; 5th ball expansion
(draw-solid-disk (make-posn 250 320) 390 'yellow)
(sleep-for-a-while 2)

; Canvas blacked out
(draw-solid-disk (make-posn 250 320) 470 'black)
(sleep-for-a-while 2)

; Clear canvas
(stop)