feat: (non-l)erping

mandelbrot.ss

@@ -2,7 +2,7 @@
   (export make-ppm mandelbrot!
           steps
           make-rgb rgb-r rgb-g rgb-b
-          number->rgb)
+          number->rgb rgb-bin rgb-map rgb-lerp)
   (import (chezscheme))
 
 (define-record-type rgb (fields r g b))
@@ -11,23 +11,29 @@
   (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+
+(define (rgb-bin +)
   (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)]))
+    [(a . bs) (fold-left (rgb-bin +) a bs)]))
+
+(define (rgb-map c f)
+  (make-rgb (f (rgb-r c))
+            (f (rgb-g c))
+            (f (rgb-b c))))
 
 (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)))))
+      (make-rgb 0 0 0)
+      (let* ([sum (apply (rgb-bin +) rgbs)]
+             [len (length rgbs)]
+             [scale (lambda (c) (inexact->exact (floor (/ c len))))])
+        (rgb-map sum scale))))
+
+(define (rgb-lerp i min max)
+  ((rgb-bin +) min (rgb-map ((rgb-bin -) max min) (lambda (x) (* i x)))))
 
 ;; proc : (x y) -> rgb
 (define (make-ppm path width height proc)
@@ -102,7 +108,7 @@
 
 (define (cli-fail)
   (format (standard-error-port 'line (current-transcoder))
-          "usage: ./mandelbrot.ss path width height [color:hex*]\n")
+          "usage: ./mandelbrot.ss PATH WIDTH HEIGHT [COLOR:hex+|--lerp INTERIOR:hex START:hex END:hex]\n")
   (exit 1))
 
 (define args (command-line-arguments))
@@ -120,19 +126,34 @@
   (cli-fail))
 
 (define (color i)
-  (define c (floor (* 256 (/ (+ 1 i) steps))))
+  (define c
+    (if (negative? i)
+        0
+        (floor (* 256 (/ i steps)))))
   (make-rgb c c c))
 
 (when (< 3 (length args))
-  (let* ([stripes
-          (let* ([colors (cdddr args)]
-                 [nums (map (lambda (n) (string->number n 16)) colors)]
-                 [_ (unless (for-all (lambda (x) (and (integer? x) (<= 0 x))) nums)
-                      (cli-fail))]
-                 [colors (map number->rgb nums)])
-            (list->vector colors))]
+  (let* ([colors (cdddr args)]
+         [lerp? (equal? "--lerp" (car colors))]
+         [colors (if lerp? (cdr colors) colors)]
+         [nums (map (lambda (n) (string->number n 16)) colors)]
+         [_ (unless (for-all (lambda (x) (and (integer? x) (<= 0 x))) nums)
+              (cli-fail))]
+         [stripes (list->vector (map number->rgb nums))]
          [stripe-count (vector-length stripes)])
-    (set! color (lambda (i) (vector-ref stripes (mod i stripe-count))))))
+    (when (and lerp? (< stripe-count 3))
+      (cli-fail))
+
+    (set! color
+      (if lerp?
+          (lambda (i)
+            (if (negative? i)
+                (vector-ref stripes 0)
+                (rgb-map (rgb-lerp (expt (/ i steps) 1.3)
+                                   (vector-ref stripes 1)
+                                   (vector-ref stripes 2))
+                         floor)))
+          (lambda (i) (vector-ref stripes (mod i stripe-count)))))))
 
 (mandelbrot! path width height color -2.2 1.1 -1 1))