;;; File:
;;;   project-ideas-lab.scm
;;; Authors:
;;;   Janet Davis
;;;   Samuel A. Rebelsky
;;;   Jerod Weinman
;;;   YOUR NAME HERE
;;; Summary:
;;;   Procedures for the lab on analyzing procedures

; +-------------+---------------------------------------------------------------
; | Color Trees |
; +-------------+

;;; Procedures:
;;;   image-render-color-tree!
;;; Parameters:
;;;   image, an image
;;;   ctree, a tree of colors
;;;   left, a real number
;;;   top, a real number
;;;   width, a real number
;;;   height, a real number
;;; Purpose:
;;;   Render the tree into the portion of the image bounded at
;;;   the left by left, at the top by top, and with the specified
;;;   width and height.
;;; Produces:
;;;   [Nothing; Called for the side effect.]
;;; Preconditions:
;;;   image is a valid image
;;;   ctree is a valid color tree
;;;   0 <= left < (image-width image)
;;;   0 <= top < (image-height image)
;;;   width < 0
;;;   height < 0
;;;   0 <= (+ left width) < (image-width image)
;;;   0 <= (+ top height) < (image-height image)
;;; Postconditions:
;;;   The tree has now been rendered.
(define image-render-color-tree!
  (lambda (image ctree left top width height)
    (let kernel ([ctree ctree]
                 [hsplit? #t]
                 [left (exact->inexact left)]
                 [top (exact->inexact top)]
                 [width (exact->inexact width)]
                 [height (exact->inexact height)])
      (cond
        ; If it's too small, just stop.
        [(or (< width 1) (< height 1))]
        ; If it's a pair, and we're to split horizontally, do so
        [(and (pair? ctree) hsplit?)
         (kernel (car ctree) (not hsplit?) 
                 left top 
                 (/ width 2) height)
         (kernel (cdr ctree) (not hsplit?)
                 (+ left (/ width 2)) top
                 (/ width 2) height)]
        ; If it's a pair, and we're to split vertically, do so
        [(pair? ctree) ; NOT hsplit?
         (kernel (car ctree) (not hsplit?) 
                 left top 
                 width (/ height 2))
         (kernel (cdr ctree) (not hsplit?)
                 left (+ top (/ height 2))
                 width (/ height 2))]
        ; Otherwise, it's just a single color, so render in the
        ; given space.
        [else
         (image-select-rectangle! image REPLACE
                                  left top (round width) (round height))
         (context-set-fgcolor! ctree)
         (image-fill-selection! image)
         (context-update-displays!)
         (image-select-nothing! image)]))))

;;; Procedure:
;;;   ctree->image
;;; Parameters:
;;;   ctree, a color-tree
;;;   width, a positive integer
;;;   height, a positive integer
;;; Purpose:
;;;   Create a new width-by-height image from ctree, by rendering it  
;;;   using one of the color-tree rendering procedures.
;;; Produces:
;;;   image, a new image
;;; Preconditions:
;;;   [No additional]
;;; Postconditions:
;;;   image is an image
;;;   image contains a rendering of ctree.
(define ctree->image
  (lambda (ctree width height)
    (let ([image (image-new width height)])
      (image-render-color-tree! image ctree 0 0 width height)
      image)))

;;; Procedure:
;;;   number->color-tree
;;; Parameters:
;;;   n, an exact integer
;;; Purpose:
;;;   Create an "interesting" color tree whose content depends only
;;;   on n.  Ideally, different values of n would give different 
;;;   color trees.
;;; Produces:
;;;   ctree, a color tree
;;; Preconditions:
;;;   n >= 0
;;; Postconditions:
;;;   If x != y, then (number->color-tree x) is unlikely to be the same as
;;;   (number->color-tree y)
(define number->color-tree
  ; These are the colors used to build the tree
  (let* ([colors (vector (rgb-new 255 0 0) (rgb-new 204 0 0) 
                         (rgb-new 153 0 0) (rgb-new 255 0 102) 
                         (rgb-new 204 0 102) (rgb-new 153 0 102)
                         (rgb-new 255 0 204) (rgb-new 204 0 204) 
                         (rgb-new 153 0 204))]
         [num-colors (vector-length colors)])
    (lambda (n)
      (let ([action (remainder n 10)])
        (cond
          ; For small numbers, we simply grab them from the color tree.
          ((< n num-colors)
           (vector-ref colors n))
          ((< action 2)
           (cons (number->color-tree (inexact->exact (round (* 0.4 n))))
                 (number->color-tree (inexact->exact (round (* 0.6 n))))))
          ((< action 4)
           (cons (number->color-tree (inexact->exact (round (* 0.6 n))))
                 (number->color-tree (inexact->exact (round (* 0.4 n))))))
          ((< action 6)
           (cons (number->color-tree (inexact->exact (round (* 0.25 n))))
                 (number->color-tree (inexact->exact (round (* 0.75 n))))))
          ((< action 8)
           (cons (number->color-tree (inexact->exact (round (* 0.75 n))))
                 (number->color-tree (inexact->exact (round (* 0.25 n))))))
          ((< action 9)
           (cons (vector-ref colors (remainder n num-colors))
                 (number->color-tree (inexact->exact (round (* 0.5 n))))))
          (else
           (cons (number->color-tree (inexact->exact (round (* 0.5 n))))
                 (vector-ref colors (remainder n num-colors)))))))))

(define series-1
  (lambda (n width height)
    (let* ([ctree (number->color-tree n)]
           [canvas (image-new width height)])
      (image-show canvas)
      (image-render-color-tree! canvas ctree 0 0 width height)
      canvas)))

; +---------+-------------------------------------------------------------------
; | Turtles |
; +---------+

;;; Procedure:
;;;   turtle-polygon!
;;; Parameters:
;;;   turtle, a turtle
;;;   side-length, a positive number
;;;   sides, an integer
;;; Purpose:
;;;   Creates a polygon of the specified number of sides.
;;; Produces:
;;;   [Nothing; called for the side effect.]
;;; Preconditions:
;;;   side >= 3
(define turtle-polygon!
  (lambda (turtle side-length sides)
    (let ([angle (- 180 (/ (* 180 (- sides 2)) sides))])
      (repeat sides
              (lambda (turtle)
                (turtle-forward! turtle side-length)
                (turtle-turn! turtle angle))
              turtle))))

;;; Procedure:
;;;   turtle-spin-polygon!
;;; Parameters:
;;;   turtle, a turtle
;;;   side-length, a positive real
;;;   sides, an integer
;;;   angle, a real number
;;;   copies, a positive integer
;;; Purpose:
;;;   Draw multiple copies of polygon, spinning a little between polygons
;;; Produces:
;;;   [Nothing; Called for the side-effect.]
(define turtle-spin-polygon!
  (lambda (turtle side-length sides angle copies)
    (repeat copies
            (lambda ()
              (turtle-polygon! turtle side-length sides)
              (turtle-turn! turtle angle)))))

; +----------+------------------------------------------------------------------
; | Fractals |
; +----------+

;;; 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 recurse
      ; 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 
                             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 
                             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 
                             color
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )))))