diff --git a/mandelbrot.ss b/mandelbrot.ss index da3bfd9..33cfe90 100644 --- a/mandelbrot.ss +++ b/mandelbrot.ss @@ -5,12 +5,29 @@ number->rgb) (import (chezscheme)) - (define-record-type rgb (fields r g b)) - (define (number->rgb n) - (assert (and (integer? n) (<= 0 n))) - (make-rgb (bitwise-and #xff (bitwise-arithmetic-shift-right n 16)) - (bitwise-and #xff (bitwise-arithmetic-shift-right n 8)) - (bitwise-and #xff (bitwise-arithmetic-shift-right n 0)))) +(define-record-type rgb (fields r g b)) +(define (number->rgb n) + (assert (and (integer? n) (<= 0 n))) + (make-rgb (bitwise-and #xff (bitwise-arithmetic-shift-right n 16)) + (bitwise-and #xff (bitwise-arithmetic-shift-right n 8)) + (bitwise-and #xff (bitwise-arithmetic-shift-right n 0)))) +(define rgb+ + (case-lambda + [() (make-rgb 0 0 0)] + [(a) a] + [(a b) (make-rgb (+ (rgb-r a) (rgb-r b)) + (+ (rgb-g a) (rgb-g b)) + (+ (rgb-b a) (rgb-b b)))] + [rgbs (fold-left rgb+ (rgb+) rgbs)])) + +(define (rgb-mean . rgbs) + (if (null? rgbs) + (rgb+) + (let ([sum (apply rgb+ rgbs)] + [len (length rgbs)]) + (make-rgb (fx/ (rgb-r sum) len) + (fx/ (rgb-g sum) len) + (fx/ (rgb-b sum) len))))) ;; proc : (x y) -> rgb (define (make-ppm path width height proc) @@ -27,25 +44,45 @@ (put-u8 p (rgb-b color)))))) 'done) + (define (lerp i min max) (+ min (* i (- max min)))) (define steps 100) (define power 2) +(define samples-per-pixel 4) +(define tau (* 4 (acos 0))) + +(define (rotate-about origin p angle) + (+ (* (- p origin) + (make-rectangular (cos angle) (sin angle))) + origin)) + +;; let's rotate the sample? (define (mandelbrot! path width height color xmin xmax ymin ymax) + (define pixel-width (exact->inexact (/ (- xmax xmin) width))) + (define pixel-height (exact->inexact (/ (- ymax ymin) height))) + (define sample-rotation (/ tau samples-per-pixel)) + (define (sample-vals center) + (let ([top (+ center (make-rectangular 0 (- (/ pixel-height 2))))]) + (map (lambda (i) (rotate-about center top (* i sample-rotation))) + (iota samples-per-pixel)))) (make-ppm path width height (lambda (x y) (define ix (lerp (/ x width) xmin xmax)) (define iy (lerp (/ y height) ymin ymax)) - (define c (exact->inexact (make-rectangular ix iy))) - (define (step z) (+ (expt z power) c)) - (let loop ([i 0] - [z (step 0)]) - (cond - [(= i steps) (color -1)] - [(> (magnitude z) 2) (color i)] - [else (loop (+ 1 i) (step z))])))))) + (define center (exact->inexact (make-rectangular ix iy))) + (define (sample p) + (define (step z) (+ (expt z power) p)) + (let loop ([i 0] + [z (step 0)]) + (cond + [(= i steps) (color -1)] + [(> (magnitude z) 2) (color i)] + [else (loop (+ 1 i) (step z))]))) + (define samples (map sample (sample-vals center))) + (apply rgb-mean samples))))) (top-level-program (import (chezscheme)