#lang racket
(require gigls/unsafe)

;;; Procedure:
;;;   vase
;;; Parameters:
;;;   image, an existent image
;;;   width, a positive integer 
;;;   height, a positive integer
;;;   n, a positive integer
;;; Purpose:
;;;   create the shape of a vase on image
;;; Produces:
;;;   nothing, called for side-effect
;;; Preconditions: 
;;;   0 <= n <= 1000
;;; Postconditions:
;;;   shape of vase is an outline, filled from the bottom up to a line calculated from n where when n=1000 vase is totally full and when n=0 vase is empty.
;;;   width of shape of vase is equal to width
;;;   height of shape of vase is equal to height
;;;   center of vase in x direction is at (/ (image-width image) 2)
;;;   bottom of vase in y direction is (- (image-height image) (/ (image-height image) 8)) - read: one-eigth of image height above image bottom
(define vase
  (lambda (image width height n)
    (let* ([left (round (- (/ (image-width image) 2) (/ width 2)))]
           [bottom (round (- (image-height image) (/ (image-height image) 8)))]
           [top (- bottom height)])
      (context-set-fgcolor! "white")
      (context-set-brush! "2. Hardness 025" 5)
      (image-select-rectangle! image REPLACE left top width height)
      (image-select-ellipse! image SUBTRACT 
                             (- (+ left width) (round (/ width 4)))
                             top                             
                             (/ width 2)
                             height)
      (image-select-ellipse! image SUBTRACT
                             (- left (round (/ width 4)))
                             top
                             (/ width 2)
                             height)
      (repeat 20 image-stroke-selection! image)
      
      (image-select-rectangle! image SUBTRACT (- left 5) (- top 5) (+ width 5) (+ (- height (/ (* height n) 1000)) 1))
      (image-fill-selection! image)
      
      (image-select-nothing! image)
      (context-update-displays!)))) 

;;; Procedure:
;;;   turtle-set!
;;; Parameters:
;;;   turtle, an existent turtle
;;;   x, a positive integer
;;;   y, a positive integer
;;;   angle, an integer
;;; Purpose:
;;;   set a turtle at a position (x, y) with angle angle
;;; Produces:
;;;   nothing, called for side-effect
;;; Preconditions:
;;;   [no additional]
;;; Postconditiosn:
;;;   [no additioanl]
(define turtle-set!
  (lambda (turtle x y angle)
    (turtle-teleport! turtle x y)
    (turtle-face! turtle angle)))

;;; Procedure:
;;;   turtle-movement!
;;; Parameters:
;;;   turtle, an existent turtle
;;;   turtle-gait, a positive integer
;;;   delta-angle, an integer
;;; Purpose:
;;;   move turtle forward distance turtle-gait and turn turtle an angle of delta-angle
;;; Produces:
;;;   nothing, called for side-effect
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   [no additional]
(define turtle-movement!
  (lambda (turtle turtle-gait delta-angle)
    (turtle-forward! turtle turtle-gait)
    (turtle-turn! turtle delta-angle)))

;;; Procedure:
;;;   angel-list
;;;    (note - yes, that's on purpose)
;;; Parameters:
;;;   angel-list-length, desired length of produced list
;;;   delta-angle, an integer
;;; Purpose:
;;;   create of list of angles to be used by turtle-movement! in the drawing of a flower stem
;;; Produces:
;;;   angel-list, a list
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   if delta-angle is 0, 1, or -1, angel-list will consist of angel-list-length copies of delta-angle
;;;   otherwise, angel-list will consist of two parts (lists that are appended together): 
;;;      list-part-1, a list consisting of a calculated number of delta-angle so that the sum of all values in the list equals 150
;;;      list-part-2, either:
;;;         a null list, if list-part-1 is longer or equal in length to angel-list-length (the desired length of the final list)
;;;         a list of length (- angel-list-length (length list-part-1)) of 1 or -1, corresponding to the sign of delta-angle
(define angel-list
  (lambda (angel-list-length delta-angle)
    (cond  [(or (= (round delta-angle) 0)            
                (= (round delta-angle) 1)
                (= (round delta-angle) -1))
            (make-list angel-list-length delta-angle)]
           [else
            (let* ([list-part-1 (make-list (round (/ 150 (abs delta-angle))) delta-angle)]               
                   [list-part-2 (make-list (if (<= angel-list-length (length list-part-1))
                                               0
                                               (- angel-list-length (length list-part-1)))
                                           (if (< delta-angle 0)
                                               -1
                                               1))])
              (append list-part-1 list-part-2))])))

;;; Procedure:
;;;   turtle-flower!
;;; Parameters:
;;;   turtle, an existent turtle
;;;   turtle-gait, a positive integer
;;;   x, a positive integer
;;;   y, a positive integer
;;;   top, a positive integer
;;;   start-angle, an integer
;;;   wilt-angle, an integer
;;;   stem-length, an integer
;;;   direction, a string
;;; Purpose: 
;;;   draw a flower stem using an existent turtle 
;;; Produces:
;;;   nothing, called for side-effect
;;; Process:
;;;   turtle-flower! calls turtle-movement! for each angle in a list created using angel-list 
;;; Preconditions:
;;;   direction controls whether the stem wilts left or right, thus the string should be either "right" or "left"
;;; Postconditions:
;;;   flower stem wilt will default to left if not given direction "right"
;;;   turtle-flower! will begin by drawing a line in the direction of start-angle from the position: (x, y) of length (- y top)
;;;   then, turtle-flower! will apply turtle-movement! on turtle for each angle in a list it creates using angel-list
(define turtle-flower!
  (lambda (turtle turtle-gait x y top start-angle wilt-angle stem-length direction)
    (let* ([turtle-movement-kernel! (lambda (angle)
                                      (turtle-movement! turtle turtle-gait angle))])      
      (turtle-set! turtle x y start-angle)            
      (turtle-forward! turtle (- y top))
      
      (if (equal? direction "right")
          (for-each turtle-movement-kernel! (angel-list (round (/ stem-length turtle-gait))  wilt-angle))
          (for-each turtle-movement-kernel! (angel-list (round (/ stem-length turtle-gait)) (* -1 wilt-angle)))))))

;;; Procedure:
;;;   petals!
;;; Parameters:
;;;   turtle, an existent turtle
;;;   turtle-gait, a positive integer
;;;   number-petals, a positive integer
;;; Purpose:
;;;   draw a number of petal shapes using an existent turtle
;;; Produces:
;;;   nothing, called for side-effect
;;; Process:
;;;   petal shapes are produced by a turtle repeatedly drawing spirals of increasing length, allowing for spirals to start from the center of the previous spiral
;;;   and begin at an angle that changes from petal to petal
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   [no additioanl]
(define petals!
  (lambda (turtle turtle-gait number-petals)   
    (let ([spiral!  ; uses turtle to draw a spiral by moving turtle angle times at increasing angles from 0 to angle
           (lambda (turtle turtle-gait paces)
             (for-each (lambda (angle)
                         (turtle-movement! turtle turtle-gait angle))
                       (cdr (iota (+ 1 paces)))))])
      (for-each (lambda (paces)
                  (spiral! turtle turtle-gait paces))              
                (map (l-s * 30) (cdr (iota (+ 1 number-petals))))))))

;;; Procedure:
;;;   floreground
;;; Parameters:
;;;   turtle, an existent turtle
;;;   turtle-gait, a positive integer
;;;   image, an existent image
;;;   vase-width, a positive integer
;;;   vase-height, a positive integer
;;;   n, a positive integer
;;; Purpose:
;;;   draw three flowers
;;; Produces:
;;;   nothing, called for side-effect
;;; Preconditions:
;;;   (<= 0 n 1000)
;;; Postconditions:
;;;   will draw 3 flowers each consisting of a stem a set of 9 petals
;;;   the first flower will begin drawing at x-position (/ vase-width 3) from the left - which is the left side of the vase
;;;   the third flower will begin drawing at x-position (/ vase-width 3) from the right - which is the right side of the vase
;;;   the second flower will begin drawing at x-position midway between first and third flower
;;;   flowers will all begin drawing at y-position the same as the fill of the vase, dependent on n
(define floreground
  (lambda (turtle turtle-gait image vase-width vase-height n)
    (let* ([left (round (- (/ (image-width image) 2) (/ vase-width 2)))]
           [bottom (round (- (image-height image) (/ (image-height image) 8)))]
           [top (- bottom vase-height)]
           [right (+ left vase-width)]
                      
           [flower-start (+ top (+ (- vase-height (/ (* vase-height n) 1000)) 1))]
           [stem-length (* (/ (image-height image) 500) 200)]
           
           [wilt-angle (- 20 (* (/ n 1000) 19))] 
           
           [flower1-x (+ left (round (/ vase-width 3)))]
           [flower2-x (- right (round (/ vase-width 3)))]
           [flower3-x (round (/ (+ flower1-x flower2-x) 2))])
       
      (turtle-set-color! turtle "white")
      (turtle-flower! turtle turtle-gait flower1-x flower-start top -90 wilt-angle stem-length "left")
      (petals! turtle turtle-gait 9)   
      (turtle-flower! turtle turtle-gait flower2-x flower-start top -90 (* 2 wilt-angle) stem-length "right")      
      (turtle-turn! turtle 15)
      (petals! turtle turtle-gait 9)      
      (turtle-flower! turtle turtle-gait flower3-x flower-start top -90 (* 3 wilt-angle) stem-length "right")
      (petals! turtle turtle-gait 9))))

;;; Procedure:
;;;   center-color
;;; Parameters:
;;;   color, an rgb value
;;; Purpose:
;;;   create a new color from a given color by binding each rgb value between 25 and 210
;;; Produces:
;;;   color-new, an rgb value
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   if rgb-red, rgb-green, and rgb-blue are not all greater than 210 or all less than 25, color-new is identical to color
(define center-color
  (lambda (color)
    (cond [(and (> (rgb-red color) 210)
                (> (rgb-green color) 210)
                (> (rgb-blue color) 210))
           (rgb-new (+ 25 (- (rgb-red color) 210))
                    (+ 25 (- (rgb-green color) 210))
                    (+ 25 (- (rgb-blue color) 210)))]
          [(and (< (rgb-red color) 25)
                (< (rgb-green color) 25)
                (< (rgb-blue color) 25))
           (rgb-new (- 210 (rgb-red color))
                    (- 210 (rgb-green color))
                    (- 210 (rgb-blue color)))]
          [else color])))         

;;; Procedure
;;;   flatground
;;; Parameters
;;;   x, a positive integer
;;;   y, a positive integer
;;;   n, a positive integer
;;; Purpose
;;;   display the string representations of
;;;   the colors used in the final image
;;;   render the background of the image
;;; Produces
;;;   image, an image
;;;     (note: final image also contains a foreground component)
;;; Preconditions
;;;   x is width of image
;;;   y is height of image
;;;   <= 0 n 999
;;; Postconditions
;;;   the colors listed are the colors used in image
;;;   image background has a checkerboard pattern
;;;   with 4 fanning sections of different colors
;;;   the size of the checker squares is dependent on x and y
;;;   image will always be 10 checker squares high and 10 wide
;;;   colors and position of fanned sections is dependent on n
(define flatground
  (lambda (x y n)
    (let* ([closed-n (if (< n 50)
                         (- 1000 n)
                         n)]
           [c (/ (* x 250) closed-n)]
           [d (/ (* x 500) closed-n)]
           [e (/ (* x 750) closed-n)]
           
           [n-color-base (color->rgb (round (* (/ n 1000) 16777215)))]
           [n-color-1 (color->rgb (center-color n-color-base))]
           [n-color-2 (rgb-lighter (rgb-rotate n-color-1))]
           [n-color-3 (rgb-lighter (rgb-rotate n-color-2))]
           [n-color-4 (rgb-lighter (rgb-rotate n-color-3))]
           
           [check-w (/ x 10)]
           [check-h (/ y 10)])
      (display (rgb->string n-color-base))
      (newline)
      (display (rgb->string n-color-1))
      (newline)
      (display (rgb->string n-color-2))
      (newline)
      (display (rgb->string n-color-3))
      (newline)
      (display (rgb->string n-color-4))
      (newline)
      (image-show
       (image-compute (lambda (col row)
                        (let* ([mod-row (* 10 (ceiling (/ row check-h)))]
                               [mod-col (* 10 (ceiling (/ col check-w)))])
                          (cond [(<= (+ (/ row y) (/ col c)) 1)
                                 (if (even? (/ (+ mod-row mod-col) 10))
                                     n-color-1
                                     n-color-2)]
                                [(<= (+ (/ row y) (/ col d)) 1)
                                 (if (even? (/ (+ mod-row mod-col) 10))
                                     n-color-3
                                     n-color-4)]
                                [(<= (+ (/ row y) (/ col e)) 1)
                                 (if (even? (/ (+ mod-row mod-col) 10))
                                     n-color-1
                                     n-color-2)]
                                [else 
                                 (if (even? (/ (+ mod-row mod-col) 10))
                                     n-color-4
                                     n-color-3)]))) x y)))))
                           
;;; Procedure:
;;;   nyc-window
;;; Parameters:
;;;   x, a positive integer
;;;   y, a positive integer
;;;   n, a positive integer
;;; Purpose:
;;;   create an image of a vase of flowers set on a background with colored patterns
;;; Process:
;;;   nyc-window calls in succession: 
;;;      flatground, to create the background image
;;;      vase, to draw the vase
;;;      floreground, to draw the flowers
;;; Produces:
;;;   image, an image
;;;   donatelo, a turtle
;;; Preconditions:
;;;   <= 0 n 1000
;;; Postconditiosn:
;;;   image will have dimensios of width x and height y
(define nyc-window 
  (lambda (x y n)
    (let* ([image (flatground x y n)]
           [vase-width (round (/ (image-width image) 5))]
           [vase-height (round (* (/ (image-height image) 500) 200))]
           [donatelo (turtle-new image)]
           
           [turtle-gait (* (/ (image-width image) 500) 5)])      
      (vase image vase-width vase-height n)
      (floreground donatelo turtle-gait image vase-width vase-height n))))