feat: single-threaded anti-aliasing

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)