From 6e4400d82549113acced5cd2db55ec92681ebfa7 Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Tue, 25 Feb 2025 15:41:47 -0500
Subject: [PATCH] feat: (non-l)erping
---
mandelbrot.ss | 61 ++++++++++++++++++++++++++++++++++-----------------
1 file changed, 41 insertions(+), 20 deletions(-)
diff --git a/mandelbrot.ss b/mandelbrot.ss
index 33cfe90..2e96a4f 100644
--- a/mandelbrot.ss
+++ b/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))