From 184e5d6d1e464674207159f544cacf1eb85dff0d Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Tue, 25 Feb 2025 13:24:49 -0500
Subject: [PATCH] feat: single-threaded anti-aliasing
---
mandelbrot.ss | 65 ++++++++++++++++++++++++++++++++++++++++-----------
1 file changed, 51 insertions(+), 14 deletions(-)
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)