#lang racket
(require gigls/unsafe)
(provide all-defined-out)

;;; Procedure
;;;  gen-image-data
;;; Purpose
;;;  generate a vector containing image data for gen-image
;;; Parameters
;;;  n, an integer
;;; Produces
;;;  image-data, a vector
;;; Preconditions
;;;  the use of an n greater than 2309 will result in an identical image-data to the vector produced by a value in the range [0,2309]
;;; Postconditions
;;;  (vector-length image-data) = 5
;;;  (gen-image-data i) != (gen-image-data j) where i and j are distinct integers in [0,2309]

(define gen-image-data
  (lambda (n)
    (vector
     (vector-ref (vector 'ellipse 'rectangle) (mod n 2))
     (vector-ref (vector 30 60 120) (mod n 3))
     (vector-ref (vector (r-s expt 2)
                         (lambda (x) (if (zero? x) (log 0.001) (log x))) ;The if allows the funtion to be graphed at column 0, which otherwise results in a log 0 error
                         (l-s expt 2)
                         sqrt
                         abs) (mod n 5))
     (mod n 7)
     (vector-ref (vector (irgb 170 57 57)
                         (irgb 170 108 57)
                         (irgb 34 102 102)
                         (irgb 45 136 45)
                         (irgb 170 170 57)
                         (irgb 96 151 32)
                         (irgb 88 42 114)
                         (irgb 152 51 82)
                         (irgb 46 65 114)
                         (irgb 75 45 115)
                         (irgb 170 132 57)) (mod n 11)))))

;;; Procedure
;;;  gen-color-scheme
;;; Purpose
;;;  produce a vector containing a color scheme for gen-image
;;; Parameters
;;;  base, a color
;;;  shift, an integer
;;; Produces
;;;  color-vec, a vector of irgbs
;;; Preconditions
;;;  [no additional]
;;; Postconditions
;;;  (vector-length color-vec) = 4
;;;  (vector-ref color-vec 0) = base
;;;  (vector-ref color-vec 1) a color whose hue is shifted from base by shifted
;;;  (vector-ref color-vec 2) a color whose value is half of base's value
;;;  (vector-ref color-vec 3) the true complement of base

(define gen-color-scheme
  (lambda (base shift)
    (let* ([hsv        (irgb->hsv base)]
           [hue        (round (car hsv))]
           [value      (cadr hsv)]
           [saturation (caddr hsv)])
      (vector
       base
       (hsv->irgb (list (mod (+ shift hue) 360) value saturation))
       (hsv->irgb (list hue (/ value 2) saturation))
       (hsv->irgb (list (mod (+ 180 hue) 360) value saturation))))))

;;; Procedure
;;;  background!
;;; Purpose
;;;  color the background of an image
;;; Parameters
;;;  image, an image
;;;  base, a color
;;;  prim, a color
;;;  modbase, a color
;;;  width, the width of image
;;;  height, the height of image
;;; Produces
;;;  [nothing; called for side effect]
;;; Preconditions
;;;  no additional
;;; Postconditions
;;;  the left half of image will be of the color base
;;;  widths from 1/2 to 5/6 will be of the color prim
;;;  widths beyond 5/6 will be of the color modbase
;;;  nothing on image will be selected

(define background!
  (lambda (image base prim modbase width height)
    (image-select-rectangle! image REPLACE 0 0 (/ width 2) height)
    (context-set-fgcolor! base)
    (image-fill-selection! image)
    (image-select-rectangle! image REPLACE (/ width 2) 0 (* 5/6 width) height)
    (context-set-fgcolor! prim)
    (image-fill-selection! image)
    (image-select-rectangle! image REPLACE (* 5/6 width) 0 width height)
    (context-set-fgcolor! modbase)
    (image-fill-selection! image)
    (image-select-nothing! image)))

;;; Procedure
;;;  radial-lines!
;;; Purpose
;;;  draw a series of radial lines from the bottom left corner of an image
;;; Parameters
;;;  image, an image
;;;  number, a whole number
;;;  color, an irgb
;;;  width, the width of image
;;;  height, the height of image
;;; Produces
;;;  [nothing; called for side effect]
;;; Preconditions
;;;  [no additional]
;;; Postconditions
;;;  if number != 0, there is a line from the bottom left corner to the top right corner of image
;;;  the additional lines evenly subdivide the angle made by the line from bottom-left to top-right
;;;  all radial lines are of color color

; there's really no way to make the trig pretty, but it works
(define radial-lines!
  (lambda (image number color width height)
    (when (not (zero? number))
      (let ([reduction (/ (atan (/ height width)) number)]) ; this bit is calculating the step by which to reduce the angle for each iteration
        (context-set-brush! "1. Pixel")
        (context-set-fgcolor! color)
        (let makeline ([hline 0]
                       [count number])
          (when (> count 0)
            (image-draw-line! image 0 height width hline)
            (makeline (- height (* width (tan (- (atan (/ (- height hline) width)) reduction)))) ; This is calculating the reduced hline
                      (- count 1))))))))

;;; Procedure
;;;  graph-function!
;;; Purpose
;;;  display a graph of a given function on an image
;;; Parameters
;;;  image, an image
;;;  func, a function taking 1 numerical parameter
;;;  width, the width of image
;;;  height, the height of image
;;; Produces
;;;  [nothing; called for side effects]
;;; Preconditions
;;;  [no additional]
;;; Postconditions
;;;  the image contains a curve corresponding to func
;;;  the curve is black

(define graph-function!
  (lambda (image func width height)
    (let ([newfunc (lambda (x) (* (/ height (func width)) (func x)))]
          [bound (ceiling (/ (min width height) 150))]) ; The cieling is a bound that grows as the image gets bigger. It allows the line to become thicker as the image scales
      (image-redo! image (lambda (col row color)
                           (let ([pixel (- (- height row) (newfunc col))]) ; (- height row), as in radial-lines!, is necessary to account for the reversed direction of the vertical axis
                             (if (and (> bound pixel) (< (- 0 bound) pixel))
                                 0                            ;the irgb value of black
                                 color)))))))

;;; Procedure
;;;  accent-box!
;;; Purpose
;;;  produce either an ellipse or a rectangle on the right side of image
;;; Parameters
;;;  image, and image
;;;  type, a symbol
;;;  color, an irgb
;;;  width, the width of image
;;;  height, the height of image
;;; Produces
;;;  [nothing; called for side effects]
;;; Preconditions
;;;  type is either 'ellipse or 'rectangle
;;; Postconditions
;;;  image contains a shape of type type in color color
;;;  this shape is in the right portion of the image (exact ratios visible in function definition)

(define accent-box!
  (lambda (image type color width height)
    (case type
      ((rectangle) (image-select-rectangle! image REPLACE (* 3/4 width) (* 3/8 height) (* 1/6 width) (* 1/4 height)))
      ((ellipse) (image-select-ellipse! image REPLACE (* 3/4 width) (* 3/8 height) (* 1/6 width) (* 1/4 height))))
                 (context-set-fgcolor! color)
                 (image-fill-selection! image)))

;;; Procedure
;;;  gen-image
;;; Purpose
;;;  build an image on image
;;; Parameters
;;;  image-data, a vector
;;;  width, the width of image
;;;  height, the height of image
;;; Produces
;;;  image, an image
;;; Preconditions
;;;  the elements of image-data have types ('ellipse or 'rectangle, number, f:R->R, integer, irgb)
;;; Postconditions
;;;  image is produced appropriately (the exact qualities are too lengthy to enumerate here)

(define gen-image
  (lambda (image image-data width height)
    (let* ([accent-type (vector-ref image-data 0)]
           [prim-shift (vector-ref image-data 1)]
           [graph-func (vector-ref image-data 2)]
           [radial-count (vector-ref image-data 3)]
           [base (vector-ref image-data 4)]
           [color-scheme (gen-color-scheme base prim-shift)]
           [prim (vector-ref color-scheme 1)]
           [modbase (vector-ref color-scheme 2)]
           [accent (vector-ref color-scheme 3)])
      (background! image base prim modbase width height)
      (radial-lines! image radial-count prim width height)
      (graph-function! image graph-func width height)
      (accent-box! image accent-type accent width height)
      (image-select-nothing! image))))

;;; Procedure
;;;  image-series
;;; Purpose
;;;   generate an image based on an integer
;;; Parameters
;;;  n, an integer
;;; Produces
;;;  image, an image
;;; Preconditions
;;;  although n may be any integer, all possible images can be generated using ns in the range [0,2309]
;;; Postconditions
;;;  (image-series of n x y) = (image-series n x y)
;;;  image is as described in statements.txt

(define image-series
  (lambda (n width height)
    (let ([canvas (image-new width height)])
      (gen-image canvas (gen-image-data n) width height)
      canvas)))