#lang racket
(require gigls/unsafe)

;;;Procedure
;;; polygon-pts-x
;;;Parameters
;;; sides - an integer
;;; xcenter - an integer
;;; radius - a real number
;;; tilt - a real number
;;; xscale - a real number
;;;Produces
;;; xlist - a list
;;;Purpose
;;; To find the x coordinates of a polygon with the given
;;;  center, radius, scale, rotation (tilt), and number of sides
;;;Preconditions
;;; All the parameters are positive
;;;Postconditions
;;; Each element of the list produced will be the x coordinate of a corner
;;;  of the polygon with all the given descriptions.

(define polygon-pts-x
  (λ (sides xcenter radius tilt xscale)
    (map + (make-list sides xcenter) 
           (map (o (r-s * (* xscale radius)) cos)
                (map (r-s + tilt)
                     (map * (iota sides) 
                            (make-list sides (/ (* 2 pi) sides))))))))

;;;Procedure
;;; polygon-pts-y
;;;Parameters
;;; sides - an integer
;;; ycenter - an integer
;;; radius - a real number
;;; tilt - a real number
;;; yscale - a real number
;;;Produces
;;; ylist - a list
;;;Purpose
;;; To find the y coordinates of a polygon with the given
;;;  center, radius, scale, rotation (tilt), and number of sides
;;;Preconditions
;;; All the parameters are positive
;;;Postconditions
;;; Each element of the list produced will be the y coordinate of a corner
;;;  of the polygon with all the given descriptions.
(define polygon-pts-y
  (λ (sides ycenter radius tilt yscale)
    (map +  (make-list sides ycenter) 
            (map (o (r-s * (* yscale radius)) sin) 
                 (map (r-s + tilt) 
                      (map * (iota sides) 
                             (make-list sides (/ (* 2 pi) sides))))))))
(define canvas (image-new 1000 2000))

;;;Procedure
;;; make-poly-points
;;;Parameters
;;; xlst - a list of real numbers
;;; ylst - a list of real numbers
;;;Produces
;;; positions - a list of real numbers
;;;Purpose
;;; To combine a list of x coordinates and a list of y coordinates
;;;  into a single list of coordinates.
;;;Preconditions
;;; xlst and ylst must be the same length for desired result
;;;Postconditions
;;; The list produced will have the pattern x1 y1 x2 y2 x(n) y(n)
;;; The list produced will be the length of xlst + the length of ylst

(define make-poly-points
  (λ (xlst ylst)
    (if (null? xlst)
        null
        (cons (position-new (car xlst) (car ylst)) (make-poly-points (cdr xlst) (cdr ylst))))))

;;;Procedure
;;; make-polygon!
;;;Parameters
;;; image - an image id
;;; points-list - a list of real numbers
;;;Produces
;;; Nothing - called for side effects
;;;Purpose
;;; To take a given list of coordinates, select and trace the region bound by those coordinates
;;;  on the given image
;;;Preconditions
;;; Points-list must be a list of numbers ordered in the pattern x1 y1 x2 y2 x(n) y(n) to
;;;  accurately reproduce intended coordinates
;;; Each element of points-list must be less than the width or height of the image
;;; image must be active
;;;Postconditions
;;; A polygon will be traced between the coordinates in point-list on the given image
(define make-polygon!
  (λ (image points-list)
    (image-select-polygon! image REPLACE points-list)
    (image-stroke-selection! image)))

;;;Procedure
;;; make-poly-poly!
;;;Parameters
;;; image - an image id
;;; sides - an integer
;;; num-of-polys - an integer
;;; xcenter - a real number
;;; ycenter - a real number
;;; radius - a real number
;;;Produces
;;; Nothing - called for side effects
;;;Purpose
;;; To create a given number of polygons with the given center, radius, and sides in image
;;;Preconditions
;;; xcenter, ycenter and the sum of radius and xcenter or ycenter must all be within the height and width of the image
;;; image must be active
;;;Postconditions
;;; Polygons with the given number of sides will be traced radius amount away from the point (xcenter, ycenter)
(define make-poly-poly!
  (λ (image sides num-of-polys xcenter ycenter radius)
    (let kernel ([n num-of-polys])
      (when (> n 0)
        (make-polygon! image (make-poly-points
                              (polygon-pts-x sides xcenter (calc-radius radius sides num-of-polys n)
                                                (calc-tilt sides num-of-polys n) 1)
                             ( polygon-pts-y sides ycenter (calc-radius radius sides num-of-polys n)
                                                (calc-tilt sides num-of-polys n) (/ (image-height image) (image-width image)))))
      (kernel (- n 1))))))

;;;Procedure
;;; calc-tilt
;;;Parameters
;;; sides - an integer
;;; num-of-polys - an integer
;;; n - an integer
;;;Produces
;;; tilt - a real number
;;;Purpose
;;; to calculate how much a polygon should be rotated to produce our image
;;;Preconditions
;;; [none additional]
;;;Postconditions
;;; The produced number will be the number a polygon needs to rotate n times to go in a full circle
(define calc-tilt
  (λ (sides num-of-polys n)
    (/ (* 2 pi n) (* sides num-of-polys))))

;;;Procedure
;;; calc-radius
;;;Parameters
;;; big-radious - an integer
;;; sides - an integer
;;; num-of-polys - an integer
;;; n - an integer
;;;Produces
;;; radius - a number
;;;Purpose
;;; The radius of each successive polygon is different, so this procedure calculates the radius of the individual polygons
;;;  that will be used in this render of the overall procedure
;;;Preconditions
;;; The parameters must be positive
;;;Postconditions
;;; The radius produced will match the number of polygons and sides
;;; The radius produced will be less than or equal too the biggest radius
(define calc-radius
  (λ (big-radius sides num-of-polys n)
    (/ (* big-radius (sin (/ (* pi (- sides 2)) (* 2 sides)))) (sin (- pi (calc-tilt sides num-of-polys n) (/ (* pi (- sides 2)) (* 2 sides)))))))

;;;Procedure
;;; make-bg
;;;Parameters
;;; n - an integer
;;; width - an integer
;;; height - an integer
;;;Produces
;;; bg - an image
;;;Purpose
;;; To create a canvas with an interestingly colored background and the given width and height
;;;Preconditions
;;; [none additional]
;;;Postconditions
;;; The new image will have background colors that vary by the position of each individual pixel
(define make-bg
  (λ (n width height)
    (let ([peak (* width 2/3)])
      (cond [(= n 0)
      (image-compute (λ (col row)
                       (irgb 0 (* 255 (/  row height))
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))))) width height)]
            [(= n 1)
             (image-compute (λ (col row)
                       (irgb (* 255 (/  row height)) 0
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))))) width height)]
            [(= n 2) (image-compute (λ (col row)
                       (irgb (* 255 (/  row height))
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))) 0)) width height)]
            
            [(= n 3) (image-compute (λ (col row)
                       (irgb 0 
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))) (* 255 (/  row height)))) width height)]
            [(= n 4) (image-compute (λ (col row)
                       (irgb 
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))) (* 255 (/  row height)) 0)) width height)]
            [else (image-compute (λ (col row)
                       (irgb 
                             (if (<= col peak)
                                 (* 255 (/ col peak))
                                 (* 255 (/ (- width col) (- width peak)))) 0 (* 255 (/  row height)))) width height)]))))

;;;Procedure
;;; set-fg-color!
;;;Parameters
;;; n - an integer
;;;Produces
;;; nothing - called for side effects
;;;Purpose
;;; to set the foreground, selected color arbitrarily based on the given n
;;;Preconditions
;;; [none additional]
;;;Postconditions
;;; The selected color in GIMP will be changed to red, green, or blue, based on what n is
(define set-fg-color!
  (λ (n)
    (cond [(or (= 0 n) (= 3 n)) (context-set-fgcolor! "red")]
          [(or (= 1 n) (= n 5)) (context-set-fgcolor! "green")]
          [else (context-set-fgcolor! "blue")])))

;;;Procedure
;;; image-series
;;;Parameters
;;; n - an integer
;;; width - an integer
;;; height - an integer
;;;Produces
;;; image - an image with many things on it
;;;Purpose
;;; To create an image series of many polygons surrounded by various colors
;;;Preconditions
;;; [none additional]
;;;Postconditions
;;; The new image has 4 large polygons on it, each surrounded by many polygons
;;; The background color of the image is a rainbow-esque gradient.
(define image-series
  (λ (n width height)
    (let ([bg (make-bg (mod n 6) width height)]
          [rad       (+ (/ width 9) (* (/ width 18) (mod n 5)))]
          [num-sides (+ 3 (mod n 7))]
          [num-poly  (+ 4 (* 2 (mod n 11)))])
      (set-fg-color! (mod n 6))
      (context-set-brush! "1. Pixel")
      (make-poly-poly! bg num-sides num-poly (/ width 3) (/ height 2) rad)
      (make-poly-poly! bg num-sides num-poly (* width 5/6) (/ height 4) (/ rad 5))
      (make-poly-poly! bg num-sides num-poly (* width 5/6) (/ height 2) (/ rad 5))
      (make-poly-poly! bg num-sides num-poly (* width 5/6) (* height 3/4) (/ rad 5))
      (image-select-nothing! bg)
      (image-show bg))))