#lang racket
(require gigls/unsafe)

;;; Necessary Helpers:

; Color lists
(define all-colors
  (context-list-colors))

(define colds
  (list "aliceblue"
        "antiquewhite"
        "aqua"
        "aquamarine"
        "azure"
        "bisque"
        "blue"
        "blueviolet"
        "cadetblue"
        "cornflowerblue"
        "cornsilk"
        "cyan"
        "darkblue"
        "darkcyan"
        "darkgray"
        "darkgreen"
        "darkgrey"
        "darkolivegreen"
        "darkseagreen"
        "darkslateblue"
        "darkslategray"
        "darkslategrey"
        "darkturquoise"
        "deepskyblue"
        "darkviolet"
        "dimgray"
        "dimgrey"
        "dodgerblue"
        "forestgreen"
        "green"
        "greenyellow"
        "grey"
        "indigo"
        "ivory"
        "khaki"
        "lavender"
        "lavenderblush"
        "lawngreen"
        "lemonchiffon"
        "lightblue"
        "lightcyan"
        "lightgray"
        "lightgreen"
        "lightgrey"
        "lightseagreen"
        "lightskyblue"
        "lightslategray"
        "lightslategrey"
        "lightsteelblue"
        "lime"
        "limegreen"
        "linen"
        "mediumaquamarine"
        "mediumblue"
        "mediumorchid"
        "mediumpurple"
        "mediumseagreen"
        "mediumslateblue"
        "mediumspringgreen"
        "mediumturquoise"
        "midnightblue"
        "mintcream"
        "navy"
        "oldlace"
        "olive"
        "olivedrab"
        "palegreen"
        "paleturquoise"
        "powderblue"
        "purple"
        "royalblue"
        "saddlebrown"
        "seagreen"
        "seashell"
        "sienna"
        "silver"
        "skyblue"
        "slateblue"
        "slategray"
        "slategrey"
        "snow"
        "springgreen"
        "steelblue"
        "teal"
        "thistle"
        "turquoise"
        "violet"
        "wheat"
        "white"
        "whitesmoke"
        "yellowgreen"
        ))

(define warms
  (list "beige"
        "blanchedalmond"
        "brown"
        "burlywood"
        "chartreuse"
        "chocolate"
        "coral"
        "crimson"
        "darkgoldenrod"
        "darkkhaki"
        "darkmagenta"
        "darkorange"
        "darkorchid"
        "darkred"
        "darksalmon"
        "deeppink"
        "firebrick"
        "floralwhite"
        "fuchsia"
        "gainsboro"
        "gold"
        "goldenrod"
        "honeydew"
        "hotpink"
        "indianred"
        "lightcoral"
        "lightgoldenrodyellow"
        "lightpink"
        "lightsalmon"
        "lightyellow"
        "magenta"
        "maroon"
        "mediumvioletred"
        "mistyrose"
        "moccasin"
        "navajowhite"
        "orange"
        "orangered"
        "orchid"
        "palegoldenrod"
        "palevioletred"
        "papayawhip"
        "peachpuff"
        "peru"
        "pink"
        "plum"
        "red"
        "rosybrown"
        "salmon"
        "sandybrown"
        "tan"
        "tomato"
        "yellow"
        ))

; List of brushes
(define brushes
  (list "2. Hardness 100" "waves" "1. Pixel" "Bristles 01" "2. Block 02"
        "Oils 01" "qbert"))

;; Algorithm Helpers

; The following procedure, euclidean-distance was taken with permission from URL: http://www.cs.grinnell.edu
; /~weinman/courses/CSC151/2014F/readings/iterate-positions-reading.html
;;; Procedure:
;;;   euclidean-distance
;;; Parameters:
;;;   col1, a real number
;;;   row1, a real number
;;;   col2, a real number
;;;   row2, a real number
;;; Purpose:
;;;   Computes the euclidean distance between (col1,row1) and
;;;   (col2,row).
;;; Produces:
;;;   distance, a real number
(define euclidean-distance
  (lambda (col1 row1 col2 row2)
    (sqrt (+ (square (- col2 col1)) (square (- row2 row1))))))

; The following definition for alg-ellipse is based largely on an example given in the reading
; at URL: http://www.cs.grinnell.edu/~weinman/courses/CSC151/2014F/readings/iterate-positions-reading.html

;;; Procedure:
;;;   alg-ellipse
;;; Parameters:
;;;   n, a non-negative integer
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero
;;; Purpose:
;;;   renders an image of determined width and height, a colored circle on a black background
;;; Produces:
;;;;  img, an image
;;; Preconditions:
;;;   none additional  
;;; Postconditions:
;;;   img is an image, with a black background and a purple-ish circle.  the circle's
;;;    diameter will vary between 10 and 210px.
(define alg-ellipse
  (lambda (n width height)
    (image-show
     (image-compute
      (lambda (col row)
        (cond
          [(> width height)
           (if (<= (euclidean-distance (/ width 2)
                                       (/ height 2)
                                       (+ col (/ (- width height) 2))
                                       row)
                   (+ 10 (mod n 200)))
               (irgb (* col (/ 255 width)) 0 (* row (/ 255 height)))
               (irgb 128 128 128))]
          [(< width height)
           (if (<= (euclidean-distance (/ width 2)
                                       (/ height 2)
                                       col
                                       (+ row (/ (- height width) 2)))
                  (+ 10 (mod n 200)))
               (irgb (* col (/ 255 width)) 0 (* row (/ 255 height)))
               (irgb 128 128 128))]
          [else
           (if (<= (euclidean-distance (/ width 2) (/ height 2) col row)
                   (+ 10 (mod n 200)))
               (irgb (* col (/ 255 width)) 0 (* row (/ 255 height)))
               (irgb 128 128 128))])) width height))))


;; Turtle Helpers

;;; Procedure:
;;;   turtle-polygon!
;;; Parameters:
;;;   turtle, a turtle
;;;   sides, an integer
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero integer
;;; Purpose:
;;;   creates an interesting mandala-type shape based on a given value of sides
;;; Produces:
;;;   a side effect
;;; Preconditions:
;;;   for ideal images, width and height should be just about equal
;;; Postconditions:
;;;   turtle-polygon! creates 8 polygons with sides number of sides, each 100px long
;;;    the polygons are arranged around the center of the image.
(define turtle-polygon!
   (lambda (turtle sides width height)
      (let* ([msides (mod sides 15)]
             [help! 
              (lambda (turtle msides)
                      ; Procedure: help!
                      ; Purpose: creates the basic shape of the polygon, with however many sides
                           (turtle-forward! turtle 100)
                           (turtle-turn! turtle (/ 360 msides)))]
             [help2! (lambda (turtle msides)
                       ; Procedure: help2!
                       ; Purpose: this makes the turtle repeat help! in 8 different positions,
                       ;   45 degrees rotated from the previous one
                       (repeat sides help! turtle msides)
                       (turtle-turn! turtle 45))])
        (turtle-prep! turtle msides width height)
        (repeat 8 help2! turtle msides))))

;;; Procedure:
;;;   turtle-spiral!
;;; Parameters:
;;;   turtle, a turtle
;;;   steps, a non-negative integer
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero integer
;;; Purpose:
;;;   creates an image with a spiral pattern in which the angle of spiralling
;;;     is based on the value of n
;;; Produces:
;;;;  a side effect
;;; Preconditions:
;;;   none additional
;;; Postconditions:
;;;   6 turtles are created, 6 spirals are created, the size varies based on n
(define turtle-spiral!
   (lambda (turtle steps width height)
     (turtle-prep! turtle steps width height)
      (let* ([spiral-help! (lambda (turtle angle)
                             ;; Procedure: spiral-help!
                             ;; Purpose: the very basic step of the spiral which needs to be
                             ;;   repeated in order to appear as an actual spiral
                             (turtle-forward! turtle 5)
                             (turtle-turn! turtle angle))]
             [turtles (map turtle-clone (make-list 6 turtle))]
             [turn! (lambda (turtles)
                      ;; Procedure: turn!
                      ;; Purpose: turns each of the turtles created above to their proper
                      ;;   directions in order to prepare them for the actual spiral
                      (for-each turtle-turn! turtles
                                  (map (l-s * 60) (iota 6))))]
             [help2! (lambda (turtle steps)
                       ;; Procedure: help2!
                       ;; Purpose: implements spiral-help! with a diminishing list on one
                       ;;   turtle
                       (for-each (l-s spiral-help! turtle)
                                 (list-drop (iota (+ 1 steps)) 1)))])
        (turn! turtles)
        (for-each (r-s help2! 50) turtles))))

;;; Procedure:
;;;   turtle-rect!
;;; Parameters:
;;;   turtle, a turtle
;;;   side, a non-negative integer
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero integer
;;; Purpose:
;;;   creates a rectangle-based image with size and shape varying based on the value of n
;;; Produces:
;;;   a side effect
;;; Preconditions:
;;;   side must be greater than or equal to 3
;;; Postconditions:
;;;   side length of each small square is equal to side
(define turtle-rect!
   (lambda (turtle side width height)
     (turtle-prep! turtle side width height)
     (let* ([help3! (lambda (turtle side)
                      ;; Procedure: help3!
                      ;; Purpose: this process, when repeated, creates the last 3 sides
                      ;;   of each small square
                      (turtle-turn! turtle 90)
                      (turtle-forward! turtle side))]
            [help2! (lambda (turtle side)
                      ;; Procedure: help2!
                      ;; Purpose: this creates each side (including small squares)of the
                      ;;   eight large squares which are produced
                      (turtle-forward! turtle (* 4 side))
                      (repeat 3 help3! turtle side))]
            [help! (lambda (turtle side)
                     ;; Procedure: help!
                     ;; Purpose: repositions each of the eight large squares produced
                     (repeat 4 help2! turtle side)
                     (turtle-turn! turtle 45))])
      (repeat 8 help! turtle side))))

;;; Procedure:
;;;   turtle-prep!
;;; Parameters:
;;;   turtle, a turtle
;;;   n, a non-negative integer
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero integer
;;; Purpose:
;;;   readies the turtle for use in other procedures
;;; Produces:
;;;   side effects
;;; Preconditions:
;;;   none additional
;;; Postconditions:
;;;   turtle's brush is set, is centered, facing right, and pen down
(define turtle-prep!
  (lambda (turtle n width height)
    (turtle-set-brush! turtle (list-ref brushes (mod n 7)))
    (turtle-up! turtle)
    (turtle-forward! turtle (/ width 2))
    (turtle-turn! turtle 90)
    (turtle-forward! turtle (/ height 2))
    (turtle-turn! turtle 270)
    (turtle-down! turtle)))


;;; Procedure:
;;;   image-series
;;; Parameters:
;;;   n, an integer between 0-999
;;;   width, a non-negative, non-zero integer
;;;   height, a non-negative, non-zero integer
;;; Purpose:
;;;   Given any value of n, image-series will produce a colorful, interesting image
;;;    using varying methods of drawing, based on varying shapes.
;;; Produces:
;;;   img, an image
;;; Preconditions:
;;;   none additional
;;; Postconditions:
;;;   The color scheme is determined by n's placement in the number line. For values of n less than
;;;    200 (but greater than 0), warm complementary colors will be used.  For values of n between
;;;    200 and 400, cold complementary.  For values of n between 400 and 600, warm analogous,
;;;    between 600 and 800 cold analogous, and between 800 and 1000, monotone with varying values.
;;;   The brush is selected from a predetermined list of seven options.
;;;   When (mod n 3) = 0, the basic shape utilized will be an ellipse
;;;   When (mod n 3) = 1, the basic shape utilized will be a rectangle
;;;   When (mod n 3) = 2, the basic shape utilized will be a polygon
;;;   When (mod n 5) = 0, the drawing style will be pixel-based
;;;   When (mod n 5) = 1, the drawing style will be fractals
;;;   When (mod n 5) = 2, the drawing style will be turtles
;;;   When (mod n 5) = 3, the drawing style will be algorithmic
;;;   When (mod n 5) = 4, the drawing style will be GIMP tools
(define image-series
  (lambda (n width height)
    (let* ([img (image-show (image-new width height))]
           [tommy (turtle-new img)]
           [mod3 (r-s mod 3)]
           [mod5 (r-s mod 5)]
           [bg-color-wc (list-ref warms (mod n (length warms)))]
           [fg-color-wc (irgb->color-name
                         (irgb-true-complement
                          (color->irgb bg-color-wc)))]
           [bg-color-cc (list-ref colds (mod n (length colds)))]
           [fg-color-cc (irgb->color-name
                         (irgb-true-complement
                          (color->irgb bg-color-cc)))]
           [bg-color-wa (list-ref warms (mod n (length warms)))]
           [fg-color-wa (irgb->color-name
                          (irgb-rotate-hue
                           (color->irgb bg-color-wa) 60))]
           [bg-color-ca (list-ref colds (mod n (length colds)))]
           [fg-color-ca (irgb->color-name
                         (irgb-rotate-hue
                          (color->irgb bg-color-ca) 60))]
           [bg-color-all (list-ref all-colors (mod n (length all-colors)))]
           [fg-color-all (irgb->color-name
                          (irgb-rotate-hue
                           (color->irgb 
                            (list-ref all-colors 
                                      (mod n (length all-colors)))) 180))])
      (cond
        [(> 0 n) (error "image-series: expects non-negative integer for first argument, given" n)]
        [(> 200 n) (context-set-bgcolor! bg-color-wc)   ;; Warm Complementary
                   (context-set-fgcolor! fg-color-wc)]
        [(> 400 n) (context-set-bgcolor! bg-color-cc)   ;; Cold Complementary
                   (context-set-fgcolor! fg-color-cc)]
        [(> 600 n) (context-set-bgcolor! bg-color-wa)   ;; Warm Analogous
                   (context-set-fgcolor! fg-color-wa)]
        [(> 800 n) (context-set-bgcolor! bg-color-ca)   ;; Cold Analogous
                   (context-set-fgcolor! fg-color-ca)]
        [(> 1000 n) (context-set-bgcolor! bg-color-all)  ;; All colors, complementary
                    (context-set-fgcolor! fg-color-all)]
        [else
         (context-set-bgcolor! (color->irgb "black"))
         (context-set-fgcolor! (color->irgb "white"))])
      (context-set-brush! (list-ref brushes (mod n 7)))
      (cond
        [(= 0 (mod3 n) (mod5 n)) ]; pixel-based ellipse
        [(and (= 1 (mod3 n))
              (= 0 (mod5 n))) ]; pixel-based rectangle
        [(and (= 2 (mod3 n))
              (= 0 (mod5 n))) ]; pixel-based polygon
        [(and (= 0 (mod3 n))
              (= 1 (mod5 n))) ]; fractal ellipse
        [(= 1 (mod3 n) (mod5 n)) (fractal-rectangle! img
                                                     fg-color-wa
                                                     0
                                                     0
                                                     (image-width img)
                                                     (image-height img)
                                                     (mod n 3))]; fractal rectangle
        [(and (= 2 (mod3 n))
              (= 1 (mod5 n))) ]; fractal polygon
        [(and (= 0 (mod3 n))
              (= 2 (mod5 n)))
         (turtle-spiral! tommy n width height)]; turtle ellipse * can't be scaled
        [(and (= 1 (mod3 n))
              (= 2 (mod5 n)))
         (turtle-rect! tommy n width height)]; turtle rectangle * can't be scaled
        [(= 2 (mod3 n) (mod5 n))
         (turtle-polygon! tommy n width height)]; turtle polygon * can't be scaled
        [(and (= 0 (mod3 n))
              (= 3 (mod5 n))) (alg-ellipse n width height)]; algorithm ellipse
        [(and (= 1 (mod3 n))
              (= 3 (mod5 n))) ]; algorithm rectangle
        [(and (= 2 (mod3 n))
              (= 3 (mod5 n))) ]; algorithm polygon
        [(and (= 0 (mod3 n))
              (= 4 (mod5 n))) ]; GIMP ellipse
        [(and (= 1 (mod3 n))
              (= 4 (mod5 n))) ]; GIMP rectangle
        [(and (= 2 (mod3 n))
              (= 4 (mod5 n))) ]; GIMP polygon
        [else splat!]))))

;; Procedure and documentation for fractal-rectangle! taken with permission from the reading provided at URL:
;; http://www.cs.grinnell.edu/~weinman/courses/CSC151/2014F/readings/project-fractals-reading.html
;;   The color transforms are not working as expected.
;;; Procedure:
;;;   fractal-rectangle!
;;; Parameters:
;;;   image, an image
;;;   color, the desired color of the rectangle
;;;   left, the left edge of the rectangle
;;;   top, the top edge of the rectangle
;;;   right, the right edge of the rectangle
;;;   bottom, the bottom edge of the rectangle
;;;   level, the level of recursion
;;; Purpose:
;;;   Draw a "fractal" version of the rectangle by
;;;   breaking the rectangle up into subrectangles,
;;;   and recursively drawing some of those rectangles
;;;   (potentially in different colors).  When does
;;;   recursion stop?  When the level of recursion is 0.
;;; Produces:
;;;   [Nothing; Called for the side effect]
(define fractal-rectangle!
  (lambda (image color left top right bottom level)
    (cond
      ; Base case: We're at a level in which we just draw the rectangle.
      [(= level 0)
       (context-set-fgcolor! color)
       (image-select-rectangle! image REPLACE
                                left top 
                                (- right left)
                                (- bottom top))
       (image-fill-selection! image)
       (image-select-nothing! image)
       (context-update-displays!)]
      ; Recursive case: Break the rectangle into a few parts and recur
      ; on each.
      [else
       (let ([midcol1 (round (+ left (/ (- right left) 3)))]
             [midcol2 (round (- right (/ (- right left) 3)))]
             [midrow1 (round (+ top (/ (- bottom top) 3)))]
             [midrow2 (round (- bottom (/ (- bottom top) 3)))])
         ; First row of squares
         (fractal-rectangle! image 
                             color
                             left top 
                             midcol1 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (col-darker color)
                             midcol1 top 
                             midcol2 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 top 
                             right midrow1
                             (- level 1))
         ; Second row of squares
         (fractal-rectangle! image 
                             color
                             left midrow1
                             midcol1 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (col-darker color)
                             midcol1 midrow1
                             midcol2 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow1
                             right midrow2
                             (- level 1))
         ; Third row of squares
         (fractal-rectangle! image 
                             color
                             left midrow2
                             midcol1 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (col-darker color)
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )])))

; This procedure is essentially irgb-darker, but to be used with color
;  names rather than irgb values.
(define col-darker
  (lambda (color)
    (irgb->color-name
     (irgb-darker
      (color-name->irgb color)))))


;;; Other potentially useful procedures


;; irgb-rotate-hue, irgb-true-complement, chroma, reddish-hue-raw, reddish-hue, 
;;  irgb->hue-angle and rotate-hue-30 are both taken from solutions to
;;   assignment 5, completed by Leila Elshamy and Andrew Mack.
(define irgb-true-complement
  (lambda (color)
    (hsv->irgb (list
                (round (if (> (irgb->hue-angle color) 180)
                           (- (irgb->hue-angle color) 180)
                           (+ (irgb->hue-angle color) 180)))
                (irgb->saturation color)
                (irgb->value color)))))

(define irgb-rotate-hue
  (lambda (color angle)
    (hsv->irgb (list
                (modulo (round (+ angle (irgb->hue-angle color))) 360)
                (irgb->saturation color)
                (irgb->value color)))))

(define rotate-hue-30
  (lambda (image)
    (image-transform! image
                      (lambda (color) 
                        (irgb-rotate-hue color 30)))))

(define irgb->hue-angle
  (lambda (color)
    (* 60 (reddish-hue color))))

(define chroma
  (lambda (color)
    (-
     (max (irgb-red color) (irgb-blue color) (irgb-green color))
     (min (irgb-red color) (irgb-blue color) (irgb-green color)))))

(define reddish-hue-raw
  (lambda (color)
    (cond
      [(= 0 (chroma color)) 0]
      [(and (>= (irgb-red color) (irgb-blue color))
            (>= (irgb-red color) (irgb-green color)))
       (/ (- (irgb-green color) (irgb-blue color)) (chroma color))]
      [(and (>= (irgb-green color) (irgb-blue color))
            (>= (irgb-green color) (irgb-red color)))
       (+ (/ (- (irgb-blue color) (irgb-red color)) (chroma color)) 2)]
      [(and (>= (irgb-blue color) (irgb-green color))
            (>= (irgb-blue color) (irgb-red color)))
       (+ (/ (- (irgb-red color) (irgb-green color)) (chroma color)) 4)])))

(define reddish-hue
  (lambda (color)
    (if (< (reddish-hue-raw color) 0)
        (+ (reddish-hue-raw color) 6)
        (reddish-hue-raw color))))



;; random-color, select-random-brush, draw-random-line, and splat!
;;  procedures taken from the reading on randomized drawing

;;; Procedure:
;;;   random-color
;;; Parameters:
;;;   [none]
;;; Purpose:
;;;   Selects and returns a random color.
;;; Produces:
;;;   color, a color.
;;; Postconditions:
;;;   color is difficult to predict.
(define random-color
  (lambda ()
    (irgb (random 256) (random 256) (random 256))))

;;; Procedure
;;;   select-random-brush!
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Select one of the brushes.
;;; Produces:
;;;   (nothing)
;;; Postconditions:
;;;   It is difficult to predict the brush.
(define select-random-brush!
  (lambda ()
    (context-set-brush! (list-ref (context-list-brushes) (random (length (context-list-brushes)))))))

;;; Procedure:
;;;   draw-random-line!
;;; Parameters:
;;;   image, an image
;;; Purpose:
;;;   Draw a random line in the image, assuming that its width
;;;   and height are as specified.
;;; Produces:
;;;   (nothing)
;;; Postconditions:
;;;   A new line has been added to image, using the current color
;;;   and brush.
(define draw-random-line!
  (lambda (image)
    (image-draw-line! image 
                      (random (image-width image)) (random (image-height image))
                      (random (image-width image)) (random (image-height image)))))

;;; Procedure:
;;;   splat!
;;; Parameters:
;;;   image, an image
;;; Purpose:
;;;   Draw a line between random points, using a random color and
;;;   a random brush.
;;; Produces:
;;;   (nothing)
;;; Postconditions:
;;;   The foreground color may have changed.
;;;   The brush may have changed.
;;;   The image now contains another line.
;;;   It should be difficult to predict what that line will look like.
(define splat!
  (lambda (image)
    (context-set-fgcolor! (random-color))
    (select-random-brush!)
    (draw-random-line! image)
    (context-update-displays!)
    image))