(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))