From 503a201eb2a9c05eb359f4a9cd86fd72cd207317 Mon Sep 17 00:00:00 2001 From: mehbark <terezi@pyrope.net> Date: Mon, 24 Feb 2025 22:40:08 -0500 Subject: [PATCH] v1 --- mandelbrot.ss | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 mandelbrot.ss diff --git a/mandelbrot.ss b/mandelbrot.ss new file mode 100644 index 0000000..1ae3be0 --- /dev/null +++ b/mandelbrot.ss @@ -0,0 +1,77 @@ +(library (mandelbrot) + (export make-ppm mandelbrot!) + (import (chezscheme)) + +;; proc : (x y) -> (u8 u8 u8) +(define (make-ppm path width height proc) + (call-with-port (open-file-output-port path (file-options no-fail)) + (lambda (p) + (define header (format "P6\n~a ~a\n255\n" width height)) + (put-bytevector p (string->utf8 header)) + (do ([x 0 (mod (+ 1 x) width)] + [y 0 (if (= (+ 1 x) width) (+ 1 y) y)]) + [(= y height)] + (let-values ([(r g b) (proc x y)]) + (put-u8 p r) + (put-u8 p g) + (put-u8 p b))))) + 'done) + +(define (lerp i min max) + (+ min (* i (- max min)))) + +(define steps 20) +(define power 4) + +(define (mandelbrot! path width height xmin xmax ymin ymax) + (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) (values 255 255 255)] + [(> (magnitude z) 2) + (let ([i (/ (+ 1 i) steps)]) + (values (floor (lerp i 0 256)) + (floor (lerp i 256 0)) + (floor (lerp i 128 256))))] + [else (loop (+ 1 i) (step z))])))))) + +(top-level-program + (import (chezscheme) + (mandelbrot)) + +(define (zoom path-fmt x y width steps) + (for-each + (lambda (i) + (let ([idx (+ 1 i)] + [i (+ 1 i)]) + (mandelbrot! + (format path-fmt idx) + width width + (/ (- x 0.5) i) (/ (+ x 0.5) i) + (/ (- y 0.5) i) (/ (+ y 0.5) i)))) + (iota steps))) + +(define (cli-fail) + (format (standard-error-port 'line (current-transcoder)) + "usage: ./mandelbrot.ss path width height\n")) + +(define args (command-line-arguments)) + +(unless (= 3 (length args)) + (cli-fail)) + +(define-values (path width height) (apply values args)) +(set! width (string->number width)) +(set! height (string->number height)) + +(unless (and (integer? width) (integer? height) (positive? width) (positive? height)) + (cli-fail)) + +(mandelbrot! path width height -1.35 1.05 -1.2 1.2)) +