;;; File:
;;;   mandlebrot.scm
;;; Version:
;;;   0.1 of 2 December 2009
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Code for experimenting with the Mandlebrot set.

; Build the complex number x+yi
(define complex
  (lambda (x y)
    (+ x (* y 0+i))))

; Determine how many steps it takes for c to "escape" from the Mandlebrot
; set.  Returns n if c does not escape within n-1 steps.
(define mandlebrot-escape
  (lambda (c n)
    (let kernel ((i 0)
                 (z c))
      (cond
        ((>= i n)
         n)
        ((<= 4 (+ (square (real-part z)) (square (imag-part z))))
         i)
        (else
         (kernel (+ i 1)
                 (+ (* z z) c)))))))

; Draw a Mandlebrot set in a width-by-height image choosing the colors
; from a vector of colors.  Use no more than n steps for determining
; whether or not each point is in the Mandlebrot set.
(define mandlebrot
  (lambda (width height n colors scale hoff voff)
    (let* ((numcolors (vector-length colors))
           (hscale (/ 3.0 (min width height)))
           (vscale (/ 3.0 (min width height)))
           (hshift (* 2.0 (/ width (min width height))))
           (vshift (* 1.5 (/ height (min width height))))
           (multiplier (/ 1.0 scale)))
      (image-show 
       (image-compute
        (lambda (col row)
          ; Convert to (x,y) with the origin slightly right of
          ; the middle (test with scale=1, hoff=voff=0).
          (let ((x (- (* col hscale) hshift))
                (y (- (* row vscale) vshift)))
            ; Convert again using the scale and offsets
            (let ((real (- (* x multiplier) hoff))
                  (imag (- (* y multiplier) voff)))
              (let ((esc (mandlebrot-escape (complex real imag) n)))
                (if (= esc n)
                    RGB-BLACK
                    (vector-ref colors (mod esc numcolors)))))))
        width height)))))

;----------------------------------------------------------------------
; Some vectors of colors

(define basic-colors
  (vector RGB-WHITE RGB-LIGHTGREY RGB-DARKGREY RGB-GREY RGB-RED 
          RGB-PINK RGB-ORANGE 
          RGB-YELLOW RGB-GREEN RGB-BLUE RGB-INDIGO RGB-VIOLET))

(define alternate-colors
  (vector (rgb-new 255 255 255)
          (rgb-new 224 224 224)
          (rgb-new 192 192 192)
          (rgb-new 224 224 255)
          (rgb-new 192 192 255)
          (rgb-new 160 160 255)
          (rgb-new 128 128 255)
          (rgb-new  96  96 255)
          (rgb-new  64  64 255)
          (rgb-new  32  32 255)
          (rgb-new   0   0 255)
          (rgb-new 255   0   0)
          (rgb-new 192   0   0)
          (rgb-new 160   0   0)
          (rgb-new 128   0   0)
          (rgb-new  96   0   0)
          (rgb-new 255 128   0)
          (rgb-new 192 128   0)
          (rgb-new 128 128   0)
          (rgb-new 192 192   0)
          (rgb-new 255 255   0)
          (rgb-new 192 255   0)
          (rgb-new 128 255   0)
          (rgb-new  64 255   0)
          (rgb-new   0 255   0)
          ))

(define too-many-colors
  (list->vector 
   (append
    (map (lambda (i) (rgb-new (* i 16) (* i 16) (* i 16))) (reverse (iota 17)))
    (map (lambda (i) (rgb-new (* (- 16 i) 16) 0 0)) (iota 11))
    (map (lambda (i) (rgb-new 0 0 (* (- 16 i) 16))) (iota 11))
    (map (lambda (i) (rgb-new 0 (* (- 16 i) 16) 0)) (iota 11)))))

(define blues
  (list->vector
   (append (list RGB-WHITE RGB-GREY)
           (map (lambda (i) (rgb-new 0 0 (* (- 64 i) 4))) (iota 65)))))

(define reds
  (list->vector
   (append (map (lambda (i) (rgb-new 255 (* (- 64 i) 4) (* (- 64 i) 4))) (iota 65)))))

(define huge
  (list->vector
   (append
    (map (lambda (i) (rgb-new 255 (* (- 64 i) 4) (* (- 64 i) 4))) (iota 65))
    (map (lambda (i) (rgb-new 0 0 (* (- 64 i) 4))) (iota 65)))))