A Radial Series Code

The following code is discussed in depth in the Radial Series Code post.

;--------------------------------------------------------------------------------------------------------
;MATHEMATICAL PROCEDURES
;--------------------------------------------------------------------------------------------------------

;convert degrees to radians
(define deg->rad
  (lambda (degrees)
    (/ (* pi degrees) 180)))

;convert radians to degrees
(define rad->deg
  (lambda (radians)
    (/ (* 180 radians) pi)))

;find interior angle of polygon in degrees
(define interior
  (lambda (sides)
    (/ (* (- sides 2) 180) sides)))

;find distince between corner and center of polygon
(define distance
  (lambda (sides side-length)
    (let ((half-side (/ side-length 2))
          (half-interior (/ (interior sides) 2)))
      (/ half-side (cos (deg->rad half-interior))))))

;find center angle in degrees (angle formed where line of two adjacent corners would meet at polygon center)
(define center-angle
  (lambda (sides)
    (- 180 (interior sides))))

;calculate x-coordinate of polygon corner (must be repeated with different angle values to calculate x-coordinates of each corner)
(define calculate-x
  (lambda (angle sides side-length)
    (inexact->exact (* (cos (deg->rad angle)) (distance sides side-length)))))

;calculate y-coordinate of polygon corner (must be repeated with different angle values to calculate y-coordinates of each corner)
(define calculate-y
  (lambda (angle sides side-length)
    (inexact->exact (* (sin (deg->rad angle)) (distance sides side-length)))))

;--------------------------------------------------------------------------------------------------------
;POLYGON HELPER PROCEDURES
;--------------------------------------------------------------------------------------------------------

;create list of x-coordinates of polygon corners
(define x-coords
  (lambda (center-x sides side-length rotate-angle)
      (map (l-s + center-x)
           (map (lambda (angle) (calculate-x angle sides side-length))
                (map (l-s + rotate-angle) (map (l-s * (center-angle sides)) (iota sides)))))))

;create list of y-coordinates of polygon corners
(define y-coords
  (lambda (center-y sides side-length rotate-angle)
      (map (l-s + center-y)
           (map (lambda (angle) (calculate-y angle sides side-length))
                (map (l-s + rotate-angle) (map (l-s * (center-angle sides)) (iota sides)))))))

;append list of y-coordinates to end of list of x-coordinates
(define merge-list
  (lambda (xlist ylist)
    (append (cons (round (car xlist)) null) (cons (round (car ylist)) null))))

;create list of coordinates of polygon corners, alternating between x-coordinate and corresponding y-coordinate
(define merge
  (lambda (xlist ylist mlist)
    (if (null? xlist)
        mlist
        (merge (cdr xlist) (cdr ylist) (append (merge-list xlist ylist) mlist)))))

;create list of polygon corner locations using (position-new x y)
(define point-list
  (lambda (mlist)
    (if (null? mlist)
        null
        (cons (position-new (inexact->exact (car mlist)) (inexact->exact (cadr mlist))) (point-list (cddr mlist))))))

;--------------------------------------------------------------------------------------------------------
;VARIATION HELPER PROCEDURES
;--------------------------------------------------------------------------------------------------------

;Convert a positive 1-, 2-, 3-, or 4-digit number to a 4-character string
(define convert
  (lambda (n)
    (let ((str (number->string n)))
      (cond ((= (string-length str) 1) (string-append "000" str))
            ((= (string-length str) 2) (string-append "00" str))
            ((= (string-length str) 3) (string-append "0" str))
            (else str)))))

;Determine the first digit of a 4-digit number
(define first
  (lambda (n)
    (string->number (list->string (list #\0 (string-ref (convert n) 0))))))

;Determine the second digit of a 4-digit number
(define second
  (lambda (n)
    (string->number (list->string (list #\0 (string-ref (convert n) 1))))))

;Determine the third digit of a 4-digit number
(define third
  (lambda (n)
    (string->number (list->string (list #\0 (string-ref (convert n) 2))))))

;Determine the fourth digit of a 4-digit number
(define fourth
  (lambda (n)
    (string->number (list->string (list #\0 (string-ref (convert n) 3))))))

;--------------------------------------------------------------------------------------------------------
;POLYGON PROCEDURES
;--------------------------------------------------------------------------------------------------------

;;; Procedure:
;;;   select-polygon!
;;; Parameters:
;;;   image, an image
;;;   center-x, a real number
;;;   center-y, a real number
;;;   sides, an integer
;;;   side-length, a real number
;;;   rotate-angle, a real number
;;; Purpose:
;;;   create a selection within "image"
;;; Produces:
;;;   nothing; selects an area within "image"
;;; Preconditions:
;;;   sides >= 3
;;;   side-length >= 1
;;; Postconditions:
;;;   part of "image" is selected
;;;   the selection is centered at ("center-x", "center-y")
;;;   the selection has "sides" number of sides
;;;   each side is "side-length" pixels in measure
;;;   the selection is rotated "rotate-angle" degrees from its default orientation
;;;      at the default orientation, one interior angle is bisected by the line y = "center-y"
;;; Notes:
;;;   "select-polygon!" functions as intended with non-integer and non-exact values of center-x, center-y, side-length, and rotate-angle
(define select-polygon!
  (lambda (image center-x center-y sides side-length rotate-angle)
      (image-select-polygon! image REPLACE (point-list (merge (x-coords center-x sides side-length rotate-angle) (y-coords center-y sides side-length rotate-angle) null)))))

;Fill a polygon selected using select-polygon!
;;; Original foreground color is returned
;;; Nothing remains selected after procedure is complete
(define make-filled-polygon!
  (lambda (image center-x center-y sides side-length rotate-angle color1)
    (let ((defaultfg (context-get-fgcolor)))
      (select-polygon! image center-x center-y sides side-length rotate-angle)
      (context-set-fgcolor! color1)
      (image-fill-selection! image)
      (image-select-nothing! image)
      (context-set-fgcolor! defaultfg))))

;Outline a polygon selected using select-polygon!
;;; Original foreground color is returned
;;; Nothing remains selected after procedure is complete
(define make-outlined-polygon!
  (lambda (image center-x center-y sides side-length rotate-angle color2)
    (let ((defaultfg (context-get-fgcolor)))
    (select-polygon! image center-x center-y sides side-length rotate-angle)
    (context-set-fgcolor! color2)
    (image-stroke-selection! image)
    (image-select-nothing! image)
    (context-set-fgcolor! defaultfg))))

;Fill and outline a polygon using make-filled-polygon! and make-outlined-polygon!
;;; Fill with color1
;;; Outline with color2
(define make-filled-outlined-polygon!
  (lambda (image center-x center-y sides side-length rotate-angle color1 color2)
    (make-filled-polygon! image center-x center-y sides side-length rotate-angle color1)
    (make-outlined-polygon! image center-x center-y sides side-length rotate-angle color2)))

;Create a polygon of specified type
;;; 1: filled polygon
;;; 2: outlined polygon
;;; 3: filled and outlined polygon
(define make-polygon!
  (lambda (image center-x center-y sides side-length rotate-angle color1 color2 type)
    (cond ((equal? type 1) (make-filled-polygon! image center-x center-y sides side-length rotate-angle color1))
          ((equal? type 2) (make-outlined-polygon! image center-x center-y sides side-length rotate-angle color2))
          ((equal? type 3) (make-filled-outlined-polygon! image center-x center-y sides side-length rotate-angle color1 color2)))))

;--------------------------------------------------------------------------------------------------------
;RECURSIVE PROCEDURE
;--------------------------------------------------------------------------------------------------------

;Recurses to create multiple polygons with desired differences in characteristics
(define recurse
  (lambda (image center-x center-y sides side-length rotate-angle color1 color2 type copies
                 center-ratio length-ratio rotate-amount)
    (if (> side-length 2)
        (when (> copies 0)
          (make-polygon! image center-x center-y sides side-length rotate-angle color1 color2 type)
          (recurse image (* center-ratio center-x) (* center-ratio center-y) sides (* length-ratio side-length) (+ rotate-amount rotate-angle) (rgb-lighter color1) (rgb-darker color2) type (- copies 1)
                   center-ratio length-ratio rotate-amount)))))

;--------------------------------------------------------------------------------------------------------
;FINAL PROCEDURE
;--------------------------------------------------------------------------------------------------------

;;; Procedure:
;;;   image-series
;;; Parameters:
;;;   n, a positive integer
;;;   width, a positive integer
;;;   height, a positive integer
;;; Purpose:
;;;   create an image
;;; Produces:
;;;   image, an image
;;; Preconditions:
;;;   "n" is either 1, 2, 3, or 4 digits
;;; Postconditions:
;;;   "image" is "width" pixels wide
;;;   "image" is "height" pixels tall
;;;   when given the same value "n", calling "image-series" with different but equally proportioned values of "width" and "height" creates a scaled image
;;;   distinct images are created for each value of "n" for 0 <= n <= 999
;;; Notes:
;;;   See technique statement for specific details of variations created given differing values of "n"
(define image-series
  (lambda (n width height)
    (let* ((colors (list (rgb-new 150 0 0) (rgb-new 255 100 0) (rgb-new 225 200 0) (rgb-new 0 125 0) (rgb-new 0 125 125) (rgb-new 0 0 150) (rgb-new 75 0 200) (rgb-new 200 25 75) (rgb-new 50 25 10) RGB-BLACK))
           (color (list-ref colors (fourth n))))
      (context-set-bgcolor! color)
      (context-set-brush! "Circle Fuzzy (03)")
      (let*((image (image-new width height)))
        (if (< (first n) 1)
            (cond ((<  (second n) 5) (recurse image (/ width 3) (/ height 3) (+ 3 (modulo (second n) 5)) width 0 color color 1 17 1 0.9 (* -0.1 (third n) (center-angle (+ 3 (modulo (second n) 5))))))
                  ((<  (second n) 9) (recurse image (/ width 3) (/ height 3) (+ 3 (modulo (second n) 5)) width 0 color color 1 17 0.95 0.9 (* -0.1 (third n) (center-angle (+ 3 (modulo (second n) 5)))))))
            (cond ((<  (second n) 5) (recurse image (/ width 3) (/ height 3) (+ 3 (modulo (second n) 5)) width 0 color color 3 17 1 0.9 (* -0.1 (third n) (center-angle (+ 3 (modulo (second n) 5))))))
                  ((<  (second n) 9) (recurse image (/ width 3) (/ height 3) (+ 3 (modulo (second n) 5)) width 0 color color 3 17 0.95 0.9 (* -0.1 (third n) (center-angle (+ 3 (modulo (second n) 5))))))))
        (image-show image)))))

;--------------------------------------------------------------------------------------------------------
;TEST CODE
;--------------------------------------------------------------------------------------------------------

;(image-series 34 500 500)
;(image-series 159 500 500)
;(image-series 335 500 500)

;(image-series 146 50 50)
;(image-series 146 100 100)
;(image-series 146 200 200)

;========================================================================================================
;APPENDIX
;========================================================================================================
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;MATHEMATICAL PROCEDURES
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;deg->rad
;;; convert degrees to radians
;---------------------
;rad->deg
;;; convert radians to degrees
;---------------------
;interior
;;; find interior angle of polygon in degrees
;---------------------
;distance
;;; find distince between corner and center of polygon
;---------------------
;center-angle
;;; find center angle in degrees (angle formed where line of two adjacent corners would meet at polygon center)
;---------------------
;calculate-x
;;; calculate x-coordinate of polygon corner (must be repeated with different angle values to calculate x-coordinates of each corner)
;---------------------
;calculate-y
;;; calculate y-coordinate of polygon corner (must be repeated with different angle values to calculate y-coordinates of each corner)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;POLYGON HELPER PROCEDURES
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;x-coords
;;; create list of x-coordinates of polygon corners
;---------------------
;y-coords
;;; create list of y-coordinates of polygon corners
;---------------------
;merge-list
;;; append list of y-coordinates to end of list of x-coordinates
;---------------------
;merge
;;; create list of coordinates of polygon corners, alternating between x-coordinate and corresponding y-coordinate
;---------------------
;point-list
;;; create list of polygon corner locations using (position-new x y)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;VARIATION HELPER PROCEDURES
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;convert
;;; convert a positive 1-, 2-, 3-, or 4-digit number to a 4-character string
;---------------------
;first
;;; determine the first digit of a 4-digit number
;---------------------
;second
;;; determine the second digit of a 4-digit number
;---------------------
;third
;;; determine the third digit of a 4-digit number
;---------------------
;fourth
;;; determine the fourth digit of a 4-digit number
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;POLYGON PROCEDURES
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; Procedure:
;;;   select-polygon!
;;; Parameters:
;;;   image, an image
;;;   center-x, a real number
;;;   center-y, a real number
;;;   sides, an integer
;;;   side-length, a real number
;;;   rotate-angle, a real number
;;; Purpose:
;;;   create a selection within "image"
;;; Produces:
;;;   nothing; selects an area within "image"
;;; Preconditions:
;;;   sides >= 3
;;;   side-length >= 1
;;; Postconditions:
;;;   part of "image" is selected
;;;   the selection is centered at ("center-x", "center-y")
;;;   the selection has "sides" number of sides
;;;   each side is "side-length" pixels in measure
;;;   the selection is rotated "rotate-angle" degrees from its default orientation
;;;      at the default orientation, one interior angle is bisected by the line y = "center-y"
;;; Notes:
;;;   "select-polygon!" functions as intended with non-integer and non-exact values of center-x, center-y, side-length, and rotate-angle
;---------------------
;make-filled-polygon!
;;; Fill a polygon selected using select-polygon!
;;; Original foreground color is returned
;;; Nothing remains selected after procedure is complete
;---------------------
;make-outlined-polygon!
;;; Outline a polygon selected using select-polygon!
;;; Original foreground color is returned
;;; Nothing remains selected after procedure is complete
;---------------------
;make-filled-outlined-polygon!
;;; Fill and outline a polygon using make-filled-polygon! and make-outlined-polygon!
;;; Fill with color1
;;; Outline with color2
;---------------------
;make-polygon!
;;; Create a polygon of specified type
;;; 1: filled polygon
;;; 2: outlined polygon
;;; 3: filled and outlined polygon
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;RECURSIVE PROCEDURE
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-
;recurse
;;; Recurses to create multiple polygons with desired differences in characteristics
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;FINAL PROCEDURE
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; Procedure:
;;;   image-series
;;; Parameters:
;;;   n, a positive integer
;;;   width, a positive integer
;;;   height, a positive integer
;;; Purpose:
;;;   create an image
;;; Produces:
;;;   image, an image
;;; Preconditions:
;;;   "n" is either 1, 2, 3, or 4 digits
;;; Postconditions:
;;;   "image" is "width" pixels wide
;;;   "image" is "height" pixels tall
;;;   when given the same value "n", calling "image-series" with different but equally proportioned values of "width" and "height" creates a scaled image
;;;   distinct images are created for each value of "n" for 0 <= n <= 999
;;; Notes:
;;;   See technique statement for specific details of variations created given differing values of "n"