#lang racket
(require gigls/unsafe)

;;; Procedure:
;;;   image-series
;;; Parameters:
;;;   n, an exact integer
;;;   width, a positive integer
;;;   height, a positive integer
;;; Purpose:
;;;   Produce an image that is artistically appealing with
;;;   width and height. Thie image is different for all values of n
;;;   from 0 to 999, inclusive. The only significant variation in the image
;;;   is based upon the value of n. all images with a different n
;;;   value are different. The image has a curvy line moving down it
;;;   and several snowflakes, there is also a gradient background.
;;; Produces:
;;;   img, an image
;;; Preconditions:
;;;   width>=50
;;;   height>=50
;;; Postconditions:
;;;   (image? img) is true
;;;   (image-width img) = width
;;;   (image-height img) = height
;;;   (context-get-fgcolor) is "white" (the result of (- (expt 256 3) 1))
;;;   nothing is selected on img
;;;   img contains a grey curve that travels generally vertically
;;;   with left to right variation.
;;;   there are 11 white snowflakes along the curve
;;;   (drawn with calls to image-draw-snowflake!) 
;;;   The background is a gradient drawn by the gradient procedure.
(define image-series
  (lambda (n width height)
    (let ([image (image-new width height)]
          [path (modulo (+ 1 (quotient n 10)) 5)]
          [clength (+ 11 (* 2 (modulo (+ 1 (quotient n 50)) 4)))]
          [size (/ (+ 1 (quotient n 200)) 50)])
      (gradient image (car (colors n))
                (cadr (colors n)) clength)
      (context-set-fgcolor! (rgb-new 192 192 192))
      (context-set-brush! "1. Pixel")
      (draw-func image (vector-ref (positions width height) path)
                 0 3 height)
      ;draws all of the snowflakes at the heights in the list spaces
      (for-each
       (lambda (y)
         (image-draw-snowflake!
          image ((vector-ref (positions width height) path) y)
          y (* size width) (* size height) "white"))
       (map (r-s * height) (spaces n)))
      (image-show image))))

;;; Procedure:
;;;   in-image?
;;; Parameters:
;;;   image, an image
;;;   top, a real number
;;;   left, a real number
;;;   bottom, a real number
;;;   right, a real number
;;; Purpose:
;;;   determines if the selection bounded by top, left, bottom, and right
;;;   is a valid selection on image.
;;; Produces:
;;;   valid, a boolean value
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   If no subset of the selection's bounding box is contained
;;;   within the image, #f is returned, else #t is returned.
(define in-image?
  (lambda (image left top right bottom)
    (and
     (<= top (image-height image))
     (<= left (image-width image))
     (>= bottom 0)
     (>= right 0))))

;;; Procedure:
;;;   image-draw-snowflake
;;; Parameters:
;;;   image, an image
;;;   x, a real number
;;;   y, a real number
;;;   w, a real number
;;;   h, a real number
;;;   color, a color
;;; Purpose:
;;;   Draw a snowflake on image at x, y
;;; Produces:
;;;   [nothing, affects the image]
;;; Preconditions:
;;;   x and y must be within the bounds of the image
;;; Postconditions:
;;;   A snowflake has been drawn on image.
(define image-draw-snowflake!
  (let* ([x1 -.5]
         [x2 0]
         [x3 .5]
         [y1 (/ 1/2 (tan (/ pi 3)))]
         [y2 (/ -1/2 (sin (/ pi 3)))]
         [y3 (/ 1/2 (tan (/ pi 3)))]
         [y4 (- 0 y1)]
         [y5 (- 0 y2)]
         [y6 (- 0 y3)])
    (lambda (image x y w h color)
      (let ([x1 (round (+ (* x1 w) x))]
            [x2 (round (+ (* x2 w) x))]
            [x3 (round (+ (* x3 w) x))]
            [y1 (round (+ (* y1 h) y))]
            [y2 (round (+ (* y2 h) y))]
            [y3 (round (+ (* y3 h) y))]
            [y4 (round (+ (* y4 h) y))]
            [y5 (round (+ (* y5 h) y))]
            [y6 (round (+ (* y6 h) y))])
        (context-set-fgcolor! color)
        (image-select-polygon!
         image REPLACE
         (position-new x1 y1)
         (position-new x2 y2)
         (position-new x3 y3))
        (image-select-polygon!
         image ADD
         (position-new x1 y4)
         (position-new x2 y5)
         (position-new x3 y6))
        (image-fill-selection! image)
        (image-select-nothing! image)))))


;;; Procedure:
;;;   shift-scale-func
;;; Parameters:
;;;   x-shift, a real number
;;;   y-shift, a real number
;;;   x-scale, a real number
;;;   y-scale, a real number
;;;   func, a function
;;; Purpose:
;;;   shifts and scales the given function where x is the output
;;;   variable is x, and the input variable is y.
;;; Produces:
;;;   mod-func, a single argument procedure.
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   (mod-func a) = (+ (* (func (- (/ a y-scale) y-shift)) x-scale) x-shift)
(define shift-scale-func
  (lambda (x-shift y-shift x-scale y-scale func)
    (lambda (y)
      (+
       (*
        (func
         (-
          (/ y y-scale)
          y-shift))
        x-scale)
       x-shift))))


;;; Procedure:
;;;   shift-scale-sin
;;; Parameters:
;;;   x-shift, a real number
;;;   y-shift, a real number
;;;   x-scale, a real number
;;;   y-scale, a real number
;;; Purpose:
;;;   return a function that a shifted and scaled version of a sin
;;;   function, the x and y associations are base upon an inverted
;;;   y axis, and assume that the sine function is drawn from top
;;;   to bottom as the curve cycles from right to left.
;;; Produces:
;;;   mod-sin, a single argument procedure.
;;; Preconditions:
;;;   y-scale <> 0
;;; Postconditions:
;;;   (mod-sin 0) = x-shift
;;;   (mod-sin pi) = x-shift

(define shift-scale-sin
  (lambda (x-shift y-shift x-scale y-scale)
    (shift-scale-func x-shift y-shift x-scale y-scale sin)))

;;; Procedure:
;;;   shift-scale-sin
;;; Parameters:
;;;   x-shift, a real number
;;;   y-shift, a real number
;;;   x-scale, a real number
;;;   y-scale, a real number
;;; Purpose:
;;;   return a function that a shifted and scaled version of a cos
;;;   function, the x and y associations are base upon an inverted
;;;   y axis, and assume that the sine function is drawn from top
;;;   to bottom as the curve cycles from right to left.
;;; Produces:
;;;   mod-cos, a single argument procedure.
;;; Preconditions:
;;;   y-scale <> 0
;;; Postconditions:
;;;   (mod-cos (/ pi 2) = x-shift
;;;   (mod-cos (/ pi 2/3) = x-shift
(define shift-scale-cos
  (lambda (x-shift y-shift x-scale y-scale)
    (shift-scale-func x-shift y-shift x-scale y-scale cos)))

;;; Procedure:
;;;   positions
;;; Parameters:
;;;   width, a positive real number
;;;   height, a positive real number
;;; Purpose:
;;;   Return a vector of 5 functions that are each a modified
;;;   trignometeric function, to bes used to define the curvees for
;;;   the snowflakes to follow.
;;; Produces:
;;;   vec, a vector
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   (vector-length vec) = 5
;;;   (map procedure? (vector->list vector)) = '(#t #t #t #t #t)
;;;   all procedures in vec have the same preconditions and
;;;   postconditions as shift-scale-func
(define positions
  (lambda (width height)
    (vector
     (lambda (y)
       ((shift-scale-cos (/ width 3) 0 (/ width 5)
                         (* height -.12)) y))
     (lambda (y)
       ((shift-scale-cos (/ width 2) 0 (/ width -4)
                         (* height .1)) y))
     (lambda (y)
       ((shift-scale-cos (/ width 5) 0 (/ width -5)
                         (* height .08)) y))
     (lambda (y)
       ((shift-scale-cos (/ width 2) 0 (/ width 5)
                         (* height .08)) y))
     (lambda (y)
       ((shift-scale-sin (/ width 3/2) 0 (/ width 4)
                         (/ height 9)) y)))))

;;; Procedure:
;;;   spaces
;;; Parameters:
;;;   n, a positive integer
;;; Purpose:
;;;   Get a list of random numbers beginning with random-seed
;;;   set to n
;;; Produces:
;;;   lst, a list
;;; Preconditions:
;;;   1<n<(expt 2 31)
;;; Postconditions:
;;;   (length lst) = 11
;;;   all items in lst are real numbers between 0 and 1.
(define spaces
  (lambda (n)
    (random-seed n)
    (list (random) (random) (random) (random) (random) (random)
          (random) (random) (random) (random) (random))))

;;; Procedure:
;;;   colors
;;; Parameters:
;;;   n, a positive integer
;;; Purpose:
;;;   Produce two random colors to be used as the gradient
;;; Produces:
;;;   colors, a list
;;; Preconditions:
;;;   1<n<(expt 2 31)
;;; Postconditions:
;;;   (length colors) = 2
;;;   rgb? (car colors) -> #t
;;;   rgb? (cadr colors) -> #t
(define colors
  (lambda (n)
    (random-seed n)
    (let ([red (random 256)]
          [green (random 256)]
          [blue (random 256)])
      (list
       (rgb-new red green blue)
       (rgb-new (- red (random 150)) (- green (random 150)) (- blue (random 150)))))))

;;; Procedure:
;;;   draw-func
;;; Parameters:
;;;   image, an image
;;;   func, a function of y to draw
;;;   y, a real number
;;;   y-step, a real number
;;;   y-max, the maximum value of y
;;; Purpose:
;;;   draw the shape that is given when f(y) is graphed as the x value.
;;; Produces:
;;;   [side-affects the image]
;;; Preconditions:
;;;   func must be mathematicaly defined for all values from y to y-max
;;;   (- y-max y-step) must be less than the image hieght.
;;; Postconditions:
;;;   the function has been drawn on image
(define draw-func
  (lambda (image func y y-step y-max)
    (let ([y1 (+ y y-step)])
      (and (< y y-max)
           (image-draw-line! image (func y) y
                             (func y1) y1)
           (draw-func image func y1 y-step y-max)))))

;;; From Homework #4 (James Talbert)
;;; Procedure:
;;;   rgb-blend
;;; Parameters:
;;;   weight, a real number
;;;   rgb1, a rgb color value
;;;   rgb2, a rgb color value
;;; Purpose
;;;   Blend two colors, with a specific mix.
;;; Pruduces:
;;;   color, a color
;;; Preconditions
;;;   0<=weight<=1
;;; Postconditions
;;;   (rgb-red color) = (round (+ (* weight (rgb-red rgb1)) 
;;;                       (* (- 1 weight) (rgb-red rgb2))))
;;;   (rgb-green color) = (round (+ (* weight (rgb-green rgb1)) 
;;;                       (* (- 1 weight) (rgb-green rgb2))))
;;;   (rgb-blue color) = (round (+ (* weight (rgb-blue rgb1)) 
;;;                       (* (- 1 weight) (rgb-blue rgb2))))

(define rgb-blend 
  (lambda (weight rgb1 rgb2)
    (let* ([inv (- 1 weight)]
           [comp (lambda (comp1 comp2)
                   (inexact->exact
                    (round
                     (+
                      (* weight comp1)
                      (* inv comp2)))))])
      (rgb-new (comp (rgb-red rgb1)
                     (rgb-red rgb2))
               (comp (rgb-green rgb1)
                     (rgb-green rgb2))
               (comp (rgb-blue rgb1)
                     (rgb-blue rgb2))))))

;;; Procedure:
;;;   blend
;;; Parameters:
;;;   c1, a rgb value
;;;   c2, a rgb value
;;;   n, a positive integer
;;; Purpose:
;;;   Return a list of the colors blending from
;;; Produces:
;;;   blnd, a list
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   (length blnd) = (+ n 1)
;;;   (car blnd) = c2
;;;   (cadr blnd) = c1

(define blend
  (lambda (c1 c2 n)
    (map (lambda (n)
           (rgb-blend n c1 c2))
         (map (r-s / n) (map increment (iota n))))))

;;; Procedure:
;;;   gradient
;;; Parameters:
;;;   image, an image
;;;   c1, a rgb value
;;;   c2, a rgb color
;;;   steps, a natural number
;;; Purpose:
;;;   Draw a gradient from c1 to c2 on image.
;;; Produces:
;;;   [this is a side-affecting procedure, returns image]
;;; Preconditions:
;;;   [no additional]
;;; Postconditions:
;;;   a gradient from c1 to c2 is drawn on image.
(define gradient
  (lambda (image c1 c2 steps)
    (let* ([colors (blend c1 c2 steps)]
           [height (image-height image)]
           [width (image-width image)]
           [step (/ height steps)])
      ;kernel draws a circle for each color in colors moving down the image.
      (letrec ([kernel
                (lambda (x y colors)
                  (and (not (null? (cdr colors)))
                       (in-image? image x y (+ x (* 2 width))
                                  (+ y height))
                       (image-select-ellipse!
                        image REPLACE x y
                        (* 2 width) height)
                       (context-set-fgcolor! (car colors))
                       (image-fill-selection! image)
                       (kernel x (+ y step)
                               (cdr colors))))])
        (image-select-all! image)
        (context-set-fgcolor! (car colors))
        (image-fill-selection! image)
        (kernel (/ width -2) step colors)))
    (image-select-nothing! image)))