v1

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