mandelbrot.rkt

#lang racket

(require racket/draw)

(define (mandelbrot1 z c)
  (+ (* z z) c))

(define (escaped? z)
  (<= 2 (magnitude z)))

(define (mandelbrot* z0 c limit)
  (cond
    [(zero? limit) 0]
    [(escaped? z0) limit]
    [else
     (mandelbrot* (mandelbrot1 z0 c) c (sub1 limit))]))

(define (mandelbrot c)
  (mandelbrot* 0 c 256))

(define x0 -2)
(define x1 0.47)
(define y0 -1.12)
(define y1 1.12)

(define-syntax-rule (make-lerp p i0 i1 o0 o1)
  (let ([ri (- i1 i0)]
        [ro (- o1 o0)])
    (define-syntax-rule (i->v v) (/ (- v i0) ri))
    (define-syntax-rule (v->o v) (+ o0 (* ro v)))
    (lambda (v) (p (v->o (i->v v))))))

(define cx make-rectangular)

(define (grays v)
  (values 255 v v v))

(define (make-gradient start end)
  (define s-color (send the-color-database find-color start))
  (define e-color (send the-color-database find-color end))
  (define-syntax-rule (ll m)
    (make-lerp exact-floor 0 255 (send s-color m) (send e-color m)))
  (define r (ll red))
  (define g (ll green))
  (define b (ll blue))
  (lambda (v) (values 255 (r v) (g v) (b v))))

(define (bytes->argb-bytes b cmap)
  (define n (* 4 (bytes-length b)))
  (define out (make-bytes n))
  (for ([i (in-range 0 n 4)]
        [v (in-bytes b)])
    (define-values (a r g b) (cmap v))
    (bytes-set! out (+ 0 i) a)
    (bytes-set! out (+ 1 i) r)
    (bytes-set! out (+ 2 i) g)
    (bytes-set! out (+ 3 i) b))
  out)

(define (make-mandelbrot-bytes w h x0 x1 y0 y1)
  (define xp (make-lerp values 0 w x0 x1))
  (define yp (make-lerp values 0 h y1 y0))
  (define b (make-bytes (* w h)))
  (for* ([y h] [x w])
    (define i (+ (* y w) x))
    (bytes-set! b i (mandelbrot (cx (xp x) (yp y)))))
  b)

(define (bytes->bitmap w h b cmap)
  (define bm (make-object bitmap% w h #f #t))
  (send bm set-argb-pixels 0 0 w h
        (bytes->argb-bytes b cmap))
  bm)

(define (gradient-bytes size)
  (define b (make-bytes (* size size)))
  (define l
    (make-lerp exact-floor
               0 (sqrt (+ (* size size) (* size size)))
               0 255))
  (for* ([y size] [x size])
    (define i (+ (* size y) x))
    (bytes-set! b i (l (sqrt (+ (* x x) (* y y))))))
  b)